diff --git a/src/arome/ext/apl_arome.F90 b/src/arome/ext/apl_arome.F90
index fc8e5a96dbb4b40e45947971cb6ea4450da5f8e6..0467649b260f778b817c8fb054c0884619d10074 100644
--- a/src/arome/ext/apl_arome.F90
+++ b/src/arome/ext/apl_arome.F90
@@ -392,6 +392,8 @@ REAL(KIND=JPRB) :: ZZRV_UP_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZTKES_(YDCPG
REAL(KIND=JPRB) :: ZDZZ_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZZZ_F_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZDZZ_F_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
REAL(KIND=JPRB) :: ZCIT_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZMFM_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZEXNREFM_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
REAL(KIND=JPRB) :: ZSIGM_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZNEBMNH_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZEVAP_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
+! additions for future ice cloud fraction and precipitation fraction
+REAL(KIND=JPRB) :: ZICEFR_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZPRCFR_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
! additions for MF scheme (Pergaud et al)
REAL(KIND=JPRB) :: ZSIGMF_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZRC_MF_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZRI_MF_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
REAL(KIND=JPRB) :: ZCF_MF_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZAERD_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZCVTENDT_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
@@ -399,6 +401,8 @@ REAL(KIND=JPRB) :: ZCVTENDRV_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZCVTENDRC_(Y
REAL(KIND=JPRB) :: ZMFS_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZTHLS_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZRTS_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
REAL(KIND=JPRB) :: ZMFUS_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZMFVS_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG), ZDEPTH_HEIGHT_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
+REAL(KIND=JPRB) :: ZDTHRAD_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
+
REAL(KIND=JPRB), TARGET :: ZFLXZTHVMF_(YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG)
REAL(KIND=JPRB), POINTER :: ZARG_FLXZTHVMF_(:,:)
@@ -653,6 +657,7 @@ LOGICAL :: LLRAD
LOGICAL :: LLSWAP_THS, LLSWAP_RS, LLSWAP_SVS, LLSWAP_SVM, LLSWAP_LIMAS ! logical to swap or not pointers in and out
LOGICAL :: LLHN(YDCPG_OPTS%KLON,YDCPG_OPTS%KFLEVG)
LOGICAL :: LNUDGLHNREAD
+LOGICAL :: LLIMAINIT
! Characters
CHARACTER(LEN=11) :: CLNAME
@@ -1059,6 +1064,17 @@ ZINVDT=1/YDCPG_OPTS%ZDTPHY
ZINVG=1._JPRB/RG
+!set concentration for LIMA
+LLIMAINIT=.FALSE.
+IF (YDCPG_OPTS%KSTEP==0) THEN
+ LLIMAINIT=.TRUE.
+ ZP1EZDIAG(:,:,1)=0._JPRB
+ ZP1EZDIAG(:,:,2)=0._JPRB
+ ZP1EZDIAG(:,:,3)=0._JPRB
+ ZP1EZDIAG(:,:,4)=0._JPRB
+ ZP1EZDIAG(:,:,5)=0._JPRB
+ENDIF
+
! initialisation de ZDTMSE
IF (LLXFUMSE) THEN
ZDTMSE=0.01_JPRB
@@ -1115,6 +1131,8 @@ IF (INIT0 >= 0) THEN
ZMFM_(:,:)=ZVALUE
ZSIGM_(:,:)=ZVALUE
ZNEBMNH_(:,:)=ZVALUE
+ ZICEFR_(:,:)=ZVALUE
+ ZPRCFR_(:,:)=ZVALUE
ZICLDFR_(:,:)=ZVALUE
ZWCLDFR_(:,:)=ZVALUE
ZSSIO_(:,:)=ZVALUE
@@ -1137,6 +1155,7 @@ IF (INIT0 >= 0) THEN
ZRC_MF_(:,:)=ZVALUE
ZRI_MF_(:,:)=ZVALUE
ZCF_MF_(:,:)=ZVALUE
+ ZDTHRAD_(:,:)=ZVALUE
ZSVSWAP_(:,:,:)=ZVALUE
ZSVSAVE_(:,:,:)=ZVALUE
@@ -1469,6 +1488,17 @@ IF (LMICRO.OR.LTURB.OR.LLMSE.OR.LKFBCONV) THEN
ENDDO
ENDDO
+ !initialisation de ZZI_THRAD
+ IF (YDCPG_OPTS%KSTEP==0) THEN
+ DO JLEV = 1, YDCPG_OPTS%KFLEVG
+ ZDTHRAD_(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,JLEV)=0._JPRB
+ ENDDO
+ ELSE
+ DO JLEV = 1, YDCPG_OPTS%KFLEVG
+ ZDTHRAD_(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,JLEV)=ZP1EZDIAG(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,JLEV,5)
+ ENDDO
+ ENDIF
+
ENDIF
! daand: radflex
@@ -1564,16 +1594,27 @@ IF (LMICRO) THEN
IF (CMICRO == 'LIMA') THEN
+ IF (LTURB) THEN
+ DO JLON=YDCPG_BNDS%KIDIA,YDCPG_BNDS%KFDIA
+ DO JLEV=1,YDCPG_OPTS%KFLEVG
+ ZWNU_(JLON,JLEV) = ZWM__(JLON,JLEV) + 0.66*SQRT(ZTKEM__(JLON,JLEV))
+ ENDDO
+ ENDDO
+ ZPTRWNU_ => ZWNU_(1:YDCPG_BNDS%KFDIA,1:YDCPG_OPTS%KFLEVG)
+ ELSE
+ ZPTRWNU_ => ZWM__(1:YDCPG_BNDS%KFDIA,1:YDCPG_OPTS%KFLEVG)
+ ENDIF
+
CALL SWAP_LIMAS
! for now a copy is needed (see below, inside). I don't like than :-( REK
ZLIMAS_(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,1:YDCPG_OPTS%KFLEVG,1:NLIMA)=ZLIMASIN_(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,1:YDCPG_OPTS%KFLEVG,1:NLIMA)
- CALL ARO_ADJUST_LIMA (YDCPG_OPTS%KFLEVG, IKU, IKL, YDCPG_BNDS%KFDIA, YDCPG_OPTS%KFLEVG, NRR, &
- & NLIMA, YDCPG_OPTS%KSTEP+1, LOSUBG_COND, LOSIGMAS, LOCND2, ZDT, VSIGQSAT, ZZZ_F_, ZRHODJM__(:, 1:YDCPG_OPTS%KFLEVG), &
+ CALL ARO_ADJUST_LIMA (YDCPG_OPTS%KFLEVG, IKU, IKL, YDCPG_BNDS%KFDIA, YDCPG_OPTS%KFLEVG, YDCPG_BNDS%KFDIA, NRR, &
+ & NLIMA, YDCPG_OPTS%KSTEP+1, LOSUBG_COND, LOSIGMAS, LOCND2, CCONDENS, CLAMBDA3, ZDT, VSIGQSAT, ZZZ_F_, ZRHODJM__(:, 1:YDCPG_OPTS%KFLEVG), &
& ZRHODREFM__(:, 1:YDCPG_OPTS%KFLEVG), ZEXNREFM_, ZPABSM__(:, 1:YDCPG_OPTS%KFLEVG), ZTHM__(:, 1:YDCPG_OPTS%KFLEVG), &
- & ZRM_, ZLIMAM_, ZSIGM_, ZMFM_, ZRC_MF_, ZRI_MF_, ZCF_MF_, ZTHS__(:, 1:YDCPG_OPTS%KFLEVG), ZRS_, &
- & ZLIMAS_, ZSRCS__(:, 1:YDCPG_OPTS%KFLEVG), ZNEBMNH_, YDDDH, YDMODEL%YRML_DIAG%YRLDDH, YDMODEL%YRML_DIAG%YRMDDH &
- & )
+ & ZRM_, ZLIMAM_, ZSIGM_, ZPTRWNU_, ZDTHRAD_, ZMFM_, ZRC_MF_, ZRI_MF_, ZCF_MF_, ZTHS__(:, 1:YDCPG_OPTS%KFLEVG), ZRS_, &
+ & ZLIMAS_, ZSRCS__(:, 1:YDCPG_OPTS%KFLEVG), ZNEBMNH_, ZICEFR_, ZPRCFR_, YDDDH, YDMODEL%YRML_DIAG%YRLDDH, YDMODEL%YRML_DIAG%YRMDDH, &
+ & LLIMAINIT )
ELSE
! CALL ARO_ADJUST (KLON,KIDIA,KFDIA,KLEV,NRR,& !this is the target version
@@ -2200,6 +2241,14 @@ ENDIF
ENDDO
ENDIF
+ !initialisation de ZZI_THRAD
+ DO JLEV = 1, YDCPG_OPTS%KFLEVG
+ DO JLON = YDCPG_BNDS%KIDIA, YDCPG_BNDS%KFDIA
+ ZDTHRAD_(JLON,JLEV)=ZTENT(JLON,JLEV)/ZEXNREFM_(JLON,JLEV)
+ END DO
+ ZP1EZDIAG(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,JLEV,5)=ZDTHRAD_(YDCPG_BNDS%KIDIA:YDCPG_BNDS%KFDIA,JLEV)
+ ENDDO
+
DO JLON = YDCPG_BNDS%KIDIA, YDCPG_BNDS%KFDIA
! update sunshine duration [s]
!YDMF_PHYS_SURF%GSD_VD%PSUND(JLON)=YDMF_PHYS_SURF%GSD_VD%PSUND(JLON)+ZSDUR(JLON)*TSTEP
@@ -3158,12 +3207,12 @@ IF (LMICRO) THEN
ELSE
ZPTRWNU_ => ZWM__(1:YDCPG_BNDS%KFDIA,1:YDCPG_OPTS%KFLEVG)
ENDIF
- CALL ARO_LIMA(YDCPG_OPTS%KFLEVG, IKU, IKL, YDCPG_BNDS%KFDIA, YDCPG_OPTS%KFLEVG, NRR, NLIMA, YDCPG_OPTS%KSTEP+1, &
+ CALL ARO_LIMA(YDCPG_OPTS%KFLEVG, IKU, IKL, YDCPG_BNDS%KFDIA, YDCPG_OPTS%KFLEVG,YDCPG_BNDS%KFDIA,NRR, NLIMA, YDCPG_OPTS%KSTEP+1, &
& NSPLITR, NSPLITG, ZDT, ZDZZ_, ZRHODJM__(:, 1:YDCPG_OPTS%KFLEVG), ZRHODREFM__(:, 1:YDCPG_OPTS%KFLEVG), &
- & ZEXNREFM_, ZPABSM__(:, 1:YDCPG_OPTS%KFLEVG), ZPTRWNU_, ZTHM__(:, 1:YDCPG_OPTS%KFLEVG), ZRM_, &
+ & ZEXNREFM_, ZPABSM__(:, 1:YDCPG_OPTS%KFLEVG), ZPTRWNU_, ZDTHRAD_, ZTHM__(:, 1:YDCPG_OPTS%KFLEVG), ZRM_, &
& ZLIMAM_, ZTHS__(:, 1:YDCPG_OPTS%KFLEVG), ZRS_, ZLIMAS_, ZEVAP_, ZINPRR_NOTINCR_, &
- & ZINPRS_NOTINCR_, ZINPRG_NOTINCR_, ZINPRH_NOTINCR_, ZPFPR_, YDDDH, YDMODEL%YRML_DIAG%YRLDDH, YDMODEL%YRML_DIAG%YRMDDH&
- & )
+ & ZINPRS_NOTINCR_, ZINPRG_NOTINCR_, ZINPRH_NOTINCR_, ZPFPR_, ZNEBMNH_, ZICEFR_, ZPRCFR_, YDDDH, YDMODEL%YRML_DIAG%YRLDDH, &
+ & YDMODEL%YRML_DIAG%YRMDDH)
ELSE
!CALL ARO_RAIN_ICE (NPROMICRO,KLEV,IKU,IKL,KLON,KLEV,KFDIA,NRR,KSTEP+1,& !this is the target version
CALL ARO_RAIN_ICE (NPROMICRO,YDCPG_OPTS%KFLEVG,IKU,IKL,YDCPG_BNDS%KFDIA,YDCPG_OPTS%KFLEVG,YDCPG_BNDS%KFDIA,NRR,YDCPG_OPTS%KSTEP+1, &
diff --git a/src/arome/ext/aro_adjust_lima.F90 b/src/arome/ext/aro_adjust_lima.F90
index 169373f4974ae90ae14ebd0df4f5f19508cf2737..b7854d832bc629ca86ec37bb54e7266f26dafa66 100644
--- a/src/arome/ext/aro_adjust_lima.F90
+++ b/src/arome/ext/aro_adjust_lima.F90
@@ -1,12 +1,13 @@
! ######spl
- SUBROUTINE ARO_ADJUST_LIMA(KKA,KKU,KKL,KLON,KLEV, KRR, KSV, KTCOUNT, &
- OSUBG_COND, OSIGMAS, OCND2, &
+ SUBROUTINE ARO_ADJUST_LIMA(KKA,KKU,KKL,KLON,KLEV,KFDIA, KRR, KSV, KTCOUNT, &
+ OSUBG_COND, OSIGMAS, OCND2, HCONDENS, HLAMBDA3, &
PTSTEP, PSIGQSAT, &
PZZF, PRHODJ, PRHODREF, PEXNREF,&
PPABSM, PTHT, PRT, PSVT, PSIGS, &
+ PW_NU, PDTHRAD, &
PMFCONV, PRC_MF, PRI_MF, PCF_MF, &
- PTHS, PRS, PSVS, PSRCS, PCLDFR, &
- YDDDH, YDLDDH, YDMDDH)
+ PTHS, PRS, PSVS, PSRCS, PCLDFR, PICEFR, PPRCFR, &
+ YDDDH, YDLDDH, YDMDDH, LLIMAINIT )
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##########################################################################
@@ -81,18 +82,23 @@ USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR
-USE MODD_BUDGET
+USE MODD_BUDGET, ONLY: TBUDGETDATA, NBUDGET_SV1, TBUCONF
!
USE MODD_PARAM_LIMA
USE MODD_NSV
!
-USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
+USE MODE_SET_CONC_LIMA
+USE MODE_SET_CONC_LIMA_LBC
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!USE MODE_BUDGET, ONLY: BUDGET_DDH
!
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -105,6 +111,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KLON !NPROMA under CPG
INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
+INTEGER, INTENT(IN) :: KFDIA !
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of moist variables
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
@@ -113,6 +120,8 @@ LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
LOGICAL, INTENT(IN) :: OCND2
+CHARACTER*80, INTENT(IN) :: HCONDENS
+CHARACTER*4, INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
@@ -128,6 +137,10 @@ REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRT ! Moist variables at time t
REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVT ! Moist variables at time t
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PSIGS ! Sigma_s at time t
+!
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PW_NU ! w for CCN activation
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDTHRAD ! rad theta tendency for CCN activation
+!
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRC_MF, PRI_MF, PCF_MF
!
@@ -141,11 +154,15 @@ REAL, DIMENSION(KLON,1,KLEV), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PPRCFR! Cloud fraction
!
!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+TYPE(TYP_DDH), INTENT(INOUT), TARGET :: YDDDH
+TYPE(TLDDH), INTENT(IN), TARGET :: YDLDDH
+TYPE(TMDDH), INTENT(IN), TARGET :: YDMDDH
+!
+LOGICAL, INTENT(IN) :: LLIMAINIT
!
!* 0.2 Declarations of local variables :
@@ -173,6 +190,8 @@ REAL :: ZMASSPOS ! total mass for one water category
! after removing the negative values
REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
!
+TYPE(TBUDGETDATA), DIMENSION(NBUDGET_SV1+NSV_LIMA-1) :: YLBUDGET
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
!
!------------------------------------------------------------------------------
!
@@ -189,7 +208,7 @@ HRAD='NONE'
HTURBDIM='1DIM'
KMI=1
-
+CALL FILL_DIMPHYEX(YLDIMPHYEX, KLON, 1, KLEV, 0, KFDIA)
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
@@ -204,18 +223,32 @@ ZT(:,:,:)= PTHT(:,:,:)*PEXNREF(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
-!
+
+!set concentration for LIMA
+PRS = PRS * PTSTEP
+PSVS = PSVS * PTSTEP
+IF (LLIMAINIT) THEN
+ CALL SET_CONC_LIMA (1,'ICE3',PRHODREF,PRT,PSVT)
+ CALL SET_CONC_LIMA (1,'ICE3',PRHODREF,PRS,PSVS)
+ELSE
+ CALL SET_CONC_LIMA_LBC (1,'ICE3',PRHODREF,PRT,PSVT)
+ CALL SET_CONC_LIMA_LBC (1,'ICE3',PRHODREF,PRS,PSVS)
+END IF
+PRS = PRS / PTSTEP
+PSVS = PSVS / PTSTEP
+
+!print *, "aro_adjust_lima 2"
!
!* 3. REMOVE NEGATIVE VALUES
! ----------------------
!
!* 3.1 Non local correction for precipitating species (Rood 87)
!
- DO JRR = 3,KRR
- SELECT CASE (JRR)
- CASE(3,5,6,7) ! rain, snow, graupel and hail
+DO JRR = 3,KRR
+ SELECT CASE (JRR)
+ CASE(3,5,6,7) ! rain, snow, graupel and hail
- IF ( MINVAL( PRS(:,:,:,JRR)) < 0.0 ) THEN
+ IF ( MINVAL( PRS(:,:,:,JRR)) < 0.0 ) THEN
! For AROME, we cannot use MAX_ll so that according to JPP's advises
! we only correct negative values but not the total mass
! compute the total water mass computation
@@ -224,7 +257,7 @@ ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
!
! remove the negative values
!
- PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+ PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
!
! compute the new total mass
!
@@ -235,34 +268,34 @@ ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
! ZRATIO = ZMASSTOT / ZMASSPOS
! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
- END IF
- END SELECT
- END DO
+ END IF
+ END SELECT
+END DO
!
!* 3.2 Correct negative values
!
! Correction where rc<0
- IF (LWARM_LIMA) THEN
+IF (NMOM_C.GE.1) THEN
! WHERE (PRS(:,:,:,2) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NC) < 0.)
- WHERE (PRS(:,:,:,2) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,2) = 0.0
- PSVS(:,:,:,NSV_LIMA_NC) = 0.0
- END WHERE
- END IF
+ WHERE (PRS(:,:,:,2) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ END WHERE
+END IF
! Correction where rr<0
- IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
+IF (NMOM_R.GE.1) THEN
! WHERE (PRS(:,:,:,3) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NR) < 0.)
- WHERE (PRS(:,:,:,3) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,3) = 0.0
- PSVS(:,:,:,NSV_LIMA_NR) = 0.0
- END WHERE
- END IF
+ WHERE (PRS(:,:,:,3) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,3) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+END IF
! Correction of IFN concentrations where ri<0 or Ni<0
! IF (LCOLD_LIMA) THEN
! DO JMOD = 1, NMOD_IFN
@@ -275,18 +308,18 @@ ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
! ENDDO
! END IF
! Correction where ri<0
- IF (LCOLD_LIMA) THEN
+IF (NMOM_I.GE.1) THEN
! WHERE (PRS(:,:,:,4) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NI) < 0.)
- WHERE (PRS(:,:,:,4) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,4) = 0.0
- PSVS(:,:,:,NSV_LIMA_NI) = 0.0
- END WHERE
- END IF
+ WHERE (PRS(:,:,:,4) < 0.)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,4) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ END WHERE
+END IF
!
- PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
+PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
!
!
!* 3.3 STORE THE BUDGET TERMS
@@ -301,7 +334,12 @@ ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
!IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH')
!IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NEGA_BU_RTH')
-
+DO JRR = 1, NBUDGET_SV1+NSV_LIMA-1
+ YLBUDGET(JRR)%NBUDGET=JRR
+ YLBUDGET(JRR)%YDDDH=>YDDDH
+ YLBUDGET(JRR)%YDLDDH=>YDLDDH
+ YLBUDGET(JRR)%YDMDDH=>YDMDDH
+ENDDO
!
!-------------------------------------------------------------------------------
!
@@ -314,13 +352,13 @@ ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
!
ZZZ = PZZF
- CALL LIMA_ADJUST(KRR=KRR, KMI=KMI, HFMFILE='DUMMY', HLUOUT='DUMMY', HRAD='DUMMY', &
- HTURBDIM=HTURBDIM, OCLOSE_OUT=.FALSE., OSUBG_COND=.FALSE., PTSTEP=2*PTSTEP, &
- PRHODREF=PRHODREF, PRHODJ=PRHODJ, PEXNREF=PEXNREF, PPABSM=PPABSM, PSIGS=PSIGS, PPABST=PPABSM, &
- PRT=PRT, PRS=PRS, PSVT=PSVT, PSVS=PSVS, &
- PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
-
+ CALL LIMA_ADJUST_SPLIT(D=YLDIMPHYEX, CST=CST, BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
+ KRR=KRR, KMI=KMI, HCONDENS=HCONDENS, HLAMBDA3=HLAMBDA3, &
+ OSUBG_COND=OSUBG_COND, OSIGMAS=OSIGMAS, PTSTEP=2*PTSTEP, PSIGQSAT=PSIGQSAT, &
+ PRHODREF=PRHODREF, PRHODJ=PRHODJ, PEXNREF=PEXNREF, PSIGS=PSIGS, PMFCONV=PMFCONV, &
+ PPABST=PPABSM, PPABSTT=PPABSM, PZZ=ZZZ, PDTHRAD=PDTHRAD, PW_NU=PW_NU, &
+ PRT=PRT, PRS=PRS, PSVT=PSVT, PSVS=PSVS, &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, PICEFR=PICEFR, PRC_MF=PRC_MF, PRI_MF=PRI_MF, PCF_MF=PCF_MF )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/arome/ext/aro_adjust_lima.h b/src/arome/ext/aro_adjust_lima.h
new file mode 100644
index 0000000000000000000000000000000000000000..1686f98b2e16439bc664fa27bfe8a97ca12a5274
--- /dev/null
+++ b/src/arome/ext/aro_adjust_lima.h
@@ -0,0 +1,56 @@
+INTERFACE
+SUBROUTINE ARO_ADJUST_LIMA(KKA,KKU,KKL,KLON,KLEV,KFDIA, KRR, KSV, KTCOUNT,&
+ & OSUBG_COND, OSIGMAS,OCND2, HCONDENS, HLAMBDA3,&
+ & PTSTEP, PSIGQSAT,&
+ & PZZF, PRHODJ, PRHODREF, PEXNREF,&
+ & PPABSM, PTHT, PRT, PSVT, PSIGS,&
+ & PW_NU, PDTHRAD,&
+ & PMFCONV, PRC_MF, PRI_MF, PCF_MF,&
+ & PTHS, PRS, PSVS, PSRCS, PCLDFR, PICEFR, PPRCFR, &
+ & YDDDH,YDLDDH,YDMDDH, LLIMAINIT)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
+INTEGER(KIND=JPIM), INTENT(IN) :: KKA
+INTEGER(KIND=JPIM), INTENT(IN) :: KKU
+INTEGER(KIND=JPIM), INTENT(IN) :: KKL
+INTEGER(KIND=JPIM), INTENT(IN) :: KLON
+INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM), INTENT(IN) :: KRR
+INTEGER(KIND=JPIM), INTENT(IN) :: KSV
+INTEGER(KIND=JPIM), INTENT(IN) :: KTCOUNT
+LOGICAL, INTENT(IN) :: OSUBG_COND
+LOGICAL, INTENT(IN) :: OSIGMAS
+LOGICAL, INTENT(IN) :: OCND2
+CHARACTER*80, INTENT(IN) :: HCONDENS
+CHARACTER*4, INTENT(IN) :: HLAMBDA3
+REAL(KIND=JPRB), INTENT(IN) :: PTSTEP
+REAL(KIND=JPRB), INTENT(IN) :: PSIGQSAT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PZZF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODJ
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODREF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PSIGS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PW_NU
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDTHRAD
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PMFCONV
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRC_MF,PRI_MF,PCF_MF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PTHS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(OUT) :: PSRCS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PCLDFR
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PICEFR
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PPRCFR
+TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
+TYPE(TLDDH), INTENT(IN) :: YDLDDH
+TYPE(TMDDH), INTENT(IN) :: YDMDDH
+LOGICAL, INTENT(IN) :: LLIMAINIT
+END SUBROUTINE ARO_ADJUST_LIMA
+END INTERFACE
diff --git a/src/arome/ext/aro_lima.F90 b/src/arome/ext/aro_lima.F90
index 4b10ba776c133c4c6a7c2b292f4e14bcad303be8..edef5e82779c4dfc8784d9ed5ca29077fd226722 100644
--- a/src/arome/ext/aro_lima.F90
+++ b/src/arome/ext/aro_lima.F90
@@ -1,10 +1,11 @@
! ######spl
- SUBROUTINE ARO_LIMA(KKA,KKU,KKL,KLON,KLEV, KRR, KSV, KTCOUNT, KSPLITR, KSPLITG, &
+ SUBROUTINE ARO_LIMA(KKA,KKU,KKL,KLON,KLEV,KFDIA,KRR, KSV, KTCOUNT, KSPLITR, KSPLITG, &
PTSTEP, PDZZ, PRHODJ, PRHODREF, PEXNREF,&
- PPABSM, PW_NU, PTHT, PRT, PSVT, &
+ PPABSM, PW_NU, PDTHRAD, PTHT, PRT, PSVT, &
PTHS, PRS, PSVS, PEVAP, &
PINPRR,PINPRS, &
PINPRG,PINPRH,PFPR, &
+ PCLDFR,PICEFR,PPRCFR, &
YDDDH, YDLDDH, YDMDDH )
USE PARKIND1, ONLY : JPRB
@@ -38,6 +39,8 @@
! ------------
!
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
@@ -49,6 +52,7 @@ USE MODD_NSV
!
USE MODD_BUDGET
USE MODE_BUDGET, ONLY: BUDGET_DDH
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!
USE MODI_LIMA
!
@@ -72,6 +76,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KLON !NPROMA under CPG
INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
+INTEGER, INTENT(IN) :: KFDIA !
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of LIMA variables
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
@@ -90,6 +95,7 @@ REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF ! Reference Exner functi
!
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PW_NU ! w for CCN activation
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDTHRAD ! radiative Theta tendency for CCN act.
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT):: PSVT ! LIMA variables at time t
@@ -108,9 +114,13 @@ REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PFPR ! upper-air precip
!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PCLDFR ! liquid cloud fraction
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PICEFR ! ice cloud fraction
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PPRCFR ! precipitation fraction
+!
+TYPE(TYP_DDH), INTENT(INOUT), TARGET :: YDDDH
+TYPE(TLDDH), INTENT(IN), TARGET :: YDLDDH
+TYPE(TMDDH), INTENT(IN), TARGET :: YDMDDH
!
!
!* 0.2 Declarations of local variables :
@@ -131,7 +141,7 @@ REAL, DIMENSION(KLON,1,KLEV):: &
& ZRAINFR, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC
REAL, DIMENSION(KLON,1):: ZINPRC ! surf cloud sedimentation
! for the correction of negative rv
-REAL, DIMENSION(KLON,1):: ZINPRI ! surf cloud ice sedimentation
+REAL, DIMENSION(KLON,1):: ZINPRI, ZINDEP ! surf cloud ice sedimentation
REAL :: ZMASSTOT ! total mass for one water category
! including the negative values
REAL :: ZMASSPOS ! total mass for one water category
@@ -140,6 +150,8 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
LOGICAL :: LL_RRR_BUDGET
!
+TYPE(TBUDGETDATA), DIMENSION(NBUDGET_SV1+NSV_LIMA-1) :: YLBUDGET
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
!
!------------------------------------------------------------------------------
!
@@ -149,6 +161,9 @@ LOGICAL :: LL_RRR_BUDGET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ARO_LIMA',0,ZHOOK_HANDLE)
+!Dimensions
+CALL FILL_DIMPHYEX(YLDIMPHYEX, KLON, 1, KLEV, 0, KFDIA)
+
HCLOUD='LIMA'
KMI=1
ZINPRC=0.
@@ -197,7 +212,7 @@ END DO
!* 3.2 Correct negative values
!
! Correction where rc<0
- IF (LWARM_LIMA) THEN
+ IF (NMOM_C.GE.2) THEN
WHERE (PRS(:,:,:,2) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NC) < 1.E-15)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
@@ -207,7 +222,7 @@ END DO
END WHERE
END IF
! Correction where rr<0
- IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
+ IF (NMOM_R.GE.2) THEN
WHERE (PRS(:,:,:,3) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NR) < 1.E-15)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
@@ -228,7 +243,7 @@ END DO
! ENDDO
! END IF
! Correction where ri<0
- IF (LCOLD_LIMA) THEN
+ IF (NMOM_I.GE.2) THEN
WHERE (PRS(:,:,:,4) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NI) < 1.E-15)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
@@ -244,16 +259,16 @@ END DO
!* 3.3 STORE THE BUDGET TERMS
! ----------------------
-LL_RRR_BUDGET = (LBUDGET_RV).OR.(LBUDGET_RC).OR.(LBUDGET_RR).OR.(LBUDGET_RI) &
- & .OR.(LBUDGET_RS).OR.(LBUDGET_RG).OR.(LBUDGET_RH)
+LL_RRR_BUDGET = (TBUCONF%LBUDGET_RV).OR.(TBUCONF%LBUDGET_RC).OR.(TBUCONF%LBUDGET_RR).OR.(TBUCONF%LBUDGET_RI) &
+ & .OR.(TBUCONF%LBUDGET_RS).OR.(TBUCONF%LBUDGET_RG).OR.(TBUCONF%LBUDGET_RH)
IF (LL_RRR_BUDGET) THEN
DO JRR=1,KRR
CALL BUDGET_DDH (PRS(:,:,:,JRR) * PRHODJ(:,:,:), JRR+5,'NEGA_BU_RRR',YDDDH,YDLDDH, YDMDDH)
END DO
END IF
-IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,'NEGA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_SV) THEN
+IF (TBUCONF%LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,'NEGA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+IF (TBUCONF%LBUDGET_SV) THEN
CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NC)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NR)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NI)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
@@ -271,7 +286,12 @@ IF (LBUDGET_SV) THEN
END IF
END IF
-
+DO JRR=1, NBUDGET_SV1+NSV_LIMA-1
+ YLBUDGET(JRR)%NBUDGET=JRR
+ YLBUDGET(JRR)%YDDDH=>YDDDH
+ YLBUDGET(JRR)%YDLDDH=>YDLDDH
+ YLBUDGET(JRR)%YDMDDH=>YDMDDH
+ENDDO
!
!
!-------------------------------------------------------------------------------
@@ -284,40 +304,15 @@ END IF
!
!
!
-IF (LPTSPLIT) THEN
- CALL LIMA (PTSTEP=2*PTSTEP, HFMFILE='DUMMY', OCLOSE_OUT=.FALSE., &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PZZ=PDZZ, &
- PRHODJ=PRHODJ, PPABST=PPABSM, &
- NCCN=NMOD_CCN, NIFN=NMOD_IFN, NIMM=NMOD_IMM, &
- PTHM=PTHT, PTHT=PTHT, PRT=PRT, PSVT=PSVT, PW_NU=PW_NU, &
- PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
- PINPRC=ZINPRC, PINPRR=PINPRR, PINPRI=ZINPRI, PINPRS=PINPRS, PINPRG=PINPRG, PINPRH=PINPRH, &
- PEVAP3D=PEVAP, KSPLITR=KSPLITR, KSPLITG=KSPLITG, YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
-ELSE
- IF (LWARM_LIMA) CALL LIMA_WARM(OACTIT=LACTIT_LIMA, OSEDC=LSEDC_LIMA, ORAIN=LRAIN_LIMA, KSPLITR=KSPLITR, PTSTEP=2*PTSTEP, KMI=KMI, &
- HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PW_NU=PW_NU, PPABSM=PPABSM, PPABST=PPABSM, &
- PTHM=PTHT, PRCM=PRT(:,:,:,2), &
- PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
- PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
- PINPRC=ZINPRC,PINPRR=PINPRR, PINPRR3D=ZDUM3DR, PEVAP3D=PEVAP,YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
- !
- IF (LCOLD_LIMA) CALL LIMA_COLD(OSEDI=LSEDI_LIMA, OHHONI=LHHONI_LIMA, KSPLITG=KSPLITG, PTSTEP=2*PTSTEP, KMI=KMI, &
- HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PPABST=PPABSM, PW_NU=PW_NU, &
- PTHM=PTHT, PPABSM=PPABSM, &
- PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
- PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
- PINPRS=PINPRS, PINPRG=PINPRG, PINPRH=PINPRH, YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH)
- !
- IF (LWARM_LIMA .AND. LCOLD_LIMA) CALL LIMA_MIXED(OSEDI=LSEDI_LIMA, OHHONI=LHHONI_LIMA, KSPLITG=KSPLITG, PTSTEP=2*PTSTEP, KMI=KMI, &
- HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PPABST=PPABSM, PW_NU=PW_NU, &
- PTHM=PTHT, PPABSM=PPABSM, &
- PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
- PTHS=PTHS, PRS=PRS, PSVS=PSVS,YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
-
-ENDIF
+CALL LIMA (D=YLDIMPHYEX, CST=CST, BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
+ PTSTEP=2*PTSTEP, &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PDZZ=PDZZ, &
+ PRHODJ=PRHODJ, PPABST=PPABSM, &
+ NCCN=NMOD_CCN, NIFN=NMOD_IFN, NIMM=NMOD_IMM, &
+ PDTHRAD=PDTHRAD, PTHT=PTHT, PRT=PRT, PSVT=PSVT, PW_NU=PW_NU, &
+ PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
+ PINPRC=ZINPRC, PINDEP=ZINDEP, PINPRR=PINPRR, PINPRI=ZINPRI, PINPRS=PINPRS, PINPRG=PINPRG, PINPRH=PINPRH, &
+ PEVAP3D=PEVAP, PCLDFR=PCLDFR, PICEFR=PICEFR, PPRCFR=PPRCFR, PFPR=PFPR )
!add ZINPRC in PINPRR
PINPRR=PINPRR+ZINPRC
!-------------------------------------------------------------------------------
diff --git a/src/arome/ext/aro_lima.h b/src/arome/ext/aro_lima.h
new file mode 100644
index 0000000000000000000000000000000000000000..82f32109aa6ee135e9dde8f7d75e4612e38179a6
--- /dev/null
+++ b/src/arome/ext/aro_lima.h
@@ -0,0 +1,52 @@
+INTERFACE
+SUBROUTINE ARO_LIMA(KKA,KKU,KKL,KLON,KLEV, KFDIA, KRR, KSV, KTCOUNT, KSPLITR, KSPLITG, &
+ & PTSTEP, PDZZ, PRHODJ, PRHODREF, PEXNREF,&
+ & PPABSM, PW_NU, PDTHRAD, PTHT, PRT, PSVT, &
+ & PTHS, PRS, PSVS, PEVAP,&
+ & PINPRR,PINPRS,&
+ & PINPRG,PINPRH,PFPR,&
+ & PCLDFR,PICEFR,PPRCFR,&
+ & YDDDH,YDLDDH,YDMDDH)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
+INTEGER(KIND=JPIM), INTENT(IN) :: KKA
+INTEGER(KIND=JPIM), INTENT(IN) :: KKU
+INTEGER(KIND=JPIM), INTENT(IN) :: KKL
+INTEGER(KIND=JPIM), INTENT(IN) :: KLON
+INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM), INTENT(IN) :: KRR
+INTEGER(KIND=JPIM), INTENT(IN) :: KSV
+INTEGER(KIND=JPIM), INTENT(IN) :: KTCOUNT
+INTEGER(KIND=JPIM), INTENT(IN) :: KSPLITR
+INTEGER(KIND=JPIM), INTENT(IN) :: KSPLITG
+REAL(KIND=JPRB), INTENT(IN) :: PTSTEP
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDZZ
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODJ
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODREF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PW_NU
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDTHRAD
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT):: PRT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT):: PSVT
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PTHS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVS
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PEVAP
+REAL(KIND=JPRB), DIMENSION(KLON,1), INTENT(INOUT) :: PINPRR
+REAL(KIND=JPRB), DIMENSION(KLON,1), INTENT(INOUT) :: PINPRS
+REAL(KIND=JPRB), DIMENSION(KLON,1), INTENT(INOUT) :: PINPRG
+REAL(KIND=JPRB), DIMENSION(KLON,1), INTENT(INOUT) :: PINPRH
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PFPR
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PCLDFR
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PICEFR
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PPRCFR
+TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
+TYPE(TLDDH), INTENT(IN) :: YDLDDH
+TYPE(TMDDH), INTENT(IN) :: YDMDDH
+END SUBROUTINE ARO_LIMA
+END INTERFACE
diff --git a/src/arome/ext/aroini_budget.F90 b/src/arome/ext/aroini_budget.F90
index bcb320205ea8ae01daef4f8937c0b80b2e2c1b18..d820e8b975411b0e3467f964992c3564b47c280f 100644
--- a/src/arome/ext/aroini_budget.F90
+++ b/src/arome/ext/aroini_budget.F90
@@ -86,7 +86,7 @@ LBUDGET_RI = LBU_ENABLE
LBUDGET_RS = LBU_ENABLE
LBUDGET_RG = LBU_ENABLE
LBUDGET_RH = LBU_ENABLE
-LBUDGET_SV = LBU_ENABLE
+LBUDGET_SV = .FALSE.
!
IF (LHOOK) CALL DR_HOOK('AROINI_BUDGET',1,ZHOOK_HANDLE)
!
diff --git a/src/arome/ext/aroini_micro_lima.F90 b/src/arome/ext/aroini_micro_lima.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9aeebbcdc8a5b55112afb2cbe2097d41c51e6ff8
--- /dev/null
+++ b/src/arome/ext/aroini_micro_lima.F90
@@ -0,0 +1,291 @@
+! ######spl
+SUBROUTINE AROINI_MICRO_LIMA(KULOUT,KULNAM,PTSTEP,LDWARM,CMICRO,KSPLITR,KSPLITG,CCSEDIM,LDCRIAUTI,&
+ PCRIAUTI,PT0CRIAUTI,PCRIAUTC)
+
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!**** *INI_MICRO* - Initialize common meso_NH MODD_ used in microphysics for AROME
+
+! Purpose.
+! --------
+! Initialize
+! MODD_RAIN_ICE_DESCR, MODD_RAIN_ICE_PARAM and MODD_PARAM_ICE
+! parameters used in AROME microphysics
+
+!** Interface.
+! ----------
+! *CALL* *INI_MICRO (KULOUT,KSTEP,KSPLITR)
+
+! Explicit arguments :
+! --------------------
+! KULOUT : Logical unit for the output
+! PTSTEP : Time step
+! KSPLITR : Number of small time step interation for rain sedimentation
+! LDWARM : value assigned to LWARM_LIMA
+
+! Implicit arguments :
+! --------------------
+!
+
+! Method.
+! -------
+! See documentation
+
+! Externals.
+! ----------
+
+! Reference.
+! ----------
+! Documentation AROME
+
+! Author.
+! -------
+! B. Vie
+
+! Modifications.
+! --------------
+! Original : 17-10-09
+! ------------------------------------------------------------------
+
+USE MODD_NSV
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAM_LIMA_WARM
+
+USE MODI_INI_LIMA
+USE MODI_INIT_AEROSOL_PROPERTIES
+
+USE MODD_LUNIT, ONLY : ILUOUT
+
+IMPLICIT NONE
+! -----------------------------------------------------------------------
+! DUMMY INTEGER SCALARS
+INTEGER, INTENT (IN) :: KULOUT
+INTEGER, INTENT (IN) :: KULNAM
+REAL, INTENT (IN) :: PTSTEP
+LOGICAL, INTENT (IN) :: LDWARM
+CHARACTER(4), INTENT (IN) :: CMICRO
+CHARACTER(4), INTENT (IN) :: CCSEDIM
+INTEGER, INTENT (OUT) :: KSPLITR
+INTEGER, INTENT (OUT) :: KSPLITG
+LOGICAL, INTENT (IN) :: LDCRIAUTI
+REAL, INTENT (IN) :: PCRIAUTI
+REAL, INTENT (IN) :: PT0CRIAUTI
+REAL, INTENT (IN) :: PCRIAUTC
+!-----------------------------------------------------------------------
+! LOCAL VARIABLES
+REAL :: ZCRI0, ZTCRI0
+INTEGER :: ISV
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+! -----------------------------------------------------------------------
+!
+#include "namlima.nam.h"
+#include "posnam.intfb.h"
+!
+! -----------------------------------------------------------------------
+
+ILUOUT = KULOUT
+
+
+! -----------------------------------------------------------------------
+! lecture Valeurs par défaut pour les paramètres de la namelist LIMA
+!
+LPTSPLIT = .FALSE.
+LFEEDBACKT = .TRUE.
+NMAXITER = 5
+XMRSTEP = 0.
+XTSTEP_TS = 0.
+!
+NMOM_C = 2
+NMOM_R = 2
+NMOM_I = 2
+NMOM_S = 1
+NMOM_G = 1
+NMOM_H = 0
+!
+LNUCL = .TRUE.
+LSEDI = .TRUE.
+LSNOW_T = .FALSE.
+LHHONI = .FALSE.
+LMEYERS = .FALSE.
+LCIBU = .FALSE.
+LRDSF = .FALSE.
+LMURAKAMI = .FALSE.
+NMOD_IFN = 1
+XIFN_CONC(1) = 1000
+LIFN_HOM = .TRUE.
+CIFN_SPECIES = 'PHILLIPS'
+CINT_MIXING = ''
+NMOD_IMM = 0
+NIND_SPECIE = 1
+CPRISTINE_ICE_LIMA = 'PLAT'
+CHEVRIMED_ICE_LIMA = 'GRAU'
+XALPHAI = 0.
+XNUI = 0.
+XALPHAS = 0.
+XNUS = 0.
+XALPHAG = 0.
+XNUG = 0.
+XFACTNUC_DEP = 1.
+XFACTNUC_CON = 1.
+NPHILLIPS = 8
+!
+LACTI = .TRUE.
+LSEDC = .TRUE.
+LDEPOC = .TRUE.
+LACTIT = .FALSE.
+LACTTKE = .TRUE.
+LADJ = .TRUE.
+LSPRO = .FALSE.
+LKHKO = .FALSE.
+LKESSLERAC = .FALSE.
+NMOD_CCN = 1
+XCCN_CONC(1) = 350.
+LCCN_HOM = .TRUE.
+CCCN_MODES = ''
+HINI_CCN = 'XXX'
+HTYPE_CCN = 'X'
+XALPHAC = 3.
+XNUC = 1.
+XALPHAR = 1.
+XNUR = 2.
+XFSOLUB_CCN = 1.
+XACTEMP_CCN = 280.
+XAERDIFF = 0.
+XAERHEIGHT = 2000.
+LSCAV = .FALSE.
+LAERO_MASS = .FALSE.
+! -----------------------------------------------------------------------
+! lecture de la namelist LIMA
+ CALL POSNAM(KULNAM,'NAMLIMA')
+ READ(KULNAM,NAMLIMA)
+! -----------------------------------------------------------------------
+! initialisation des NSV
+ ISV = 1
+
+ NSV_LIMA_BEG = ISV
+! Nc
+ IF (NMOM_C.GE.2) THEN
+ NSV_LIMA_NC = ISV
+ ISV = ISV+1
+ END IF
+! Nr
+ IF (NMOM_R.GE.2) THEN
+ NSV_LIMA_NR = ISV
+ ISV = ISV+1
+ END IF
+! CCN
+ IF (NMOD_CCN .GT. 0) THEN
+ NSV_LIMA_CCN_FREE = ISV
+ ISV = ISV + NMOD_CCN
+ NSV_LIMA_CCN_ACTI = ISV
+ ISV = ISV + NMOD_CCN
+ END IF
+! Scavenging
+ IF (LSCAV .AND. LAERO_MASS) THEN
+ NSV_LIMA_SCAVMASS = ISV
+ ISV = ISV+1
+ END IF ! LSCAV
+!
+! Ni
+ IF (NMOM_I.GE.2) THEN
+ NSV_LIMA_NI = ISV
+ ISV = ISV+1
+ END IF ! LCOLD_LIMA
+! Ns
+ IF (NMOM_S.GE.2) THEN
+ NSV_LIMA_NS = ISV
+ ISV = ISV+1
+ END IF ! LCOLD_LIMA
+! Ng
+ IF (NMOM_G.GE.2) THEN
+ NSV_LIMA_NG = ISV
+ ISV = ISV+1
+ END IF ! LCOLD_LIMA
+! Nh
+ IF (NMOM_H.GE.2) THEN
+ NSV_LIMA_NH = ISV
+ ISV = ISV+1
+ END IF ! LCOLD_LIMA
+! IFN
+ IF (NMOD_IFN .GT. 0) THEN
+ NSV_LIMA_IFN_FREE = ISV
+ ISV = ISV + NMOD_IFN
+ NSV_LIMA_IFN_NUCL = ISV
+ ISV = ISV + NMOD_IFN
+ END IF
+! IMM
+ IF (NMOD_IMM .GT. 0) THEN
+ NSV_LIMA_IMM_NUCL = ISV
+ ISV = ISV + MAX(1,NMOD_IMM)
+ END IF
+! Homogeneous freezing of CCN
+ IF (NMOM_I.GE.1 .AND. LHHONI) THEN
+ NSV_LIMA_HOM_HAZE = ISV
+ ISV = ISV + 1
+ END IF
+! End and total variables
+ ISV = ISV - 1
+ NSV_LIMA_END = ISV
+ NSV_LIMA = NSV_LIMA_END - NSV_LIMA_BEG + 1
+
+NSV=NSV_LIMA
+
+! -----------------------------------------------------------------------
+! initialisation de LIMA
+CALL INIT_AEROSOL_PROPERTIES
+! PDZMIN = 20 comme dans l'appel à INI_RAIN_ICE !
+CALL INI_LIMA(PTSTEP, 20., KSPLITR, KSPLITG)
+
+!!$WRITE(UNIT=KULOUT,FMT='(''LIMA SCHEME TUNING VARIABLES :'')')
+!!$WRITE(UNIT=KULOUT,FMT='('' LCOLD_LIMA = '',L5)') LCOLD_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LNUCL_LIMA = '',L5)') LNUCL_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LSEDI_LIMA = '',L5)') LSEDI_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LSNOW_LIMA = '',L5)') LSNOW_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LHAIL_LIMA = '',L5)') LHAIL_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LHHONI_LIMA = '',L5)') LHHONI_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LMEYERS_LIMA = '',L5)') LMEYERS_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LIFN_HOM = '',L5)') LIFN_HOM
+!!$WRITE(UNIT=KULOUT,FMT='('' LWARM_LIMA = '',L5)') LWARM_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LACTI_LIMA = '',L5)') LACTI_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LRAIN_LIMA = '',L5)') LRAIN_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LSEDC_LIMA = '',L5)') LSEDC_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LACTIT_LIMA = '',L5)') LACTIT_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' LCCN_HOM = '',L5)') LCCN_HOM
+!!$WRITE(UNIT=KULOUT,FMT='('' LSCAV = '',L5)') LSCAV
+!!$WRITE(UNIT=KULOUT,FMT='('' LAERO_MASS = '',L5)') LAERO_MASS
+!!$WRITE(UNIT=KULOUT,FMT='('' CIFN_SPECIES = '',A8,''CINT_MIXING = '',A8)')&
+!!$&CIFN_SPECIES,CINT_MIXING
+!!$WRITE(UNIT=KULOUT,FMT='('' CPRISTINE_ICE_LIMA = '',A4,''CHEVRIMED_ICE_LIMA = '',A4)')&
+!!$&CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA
+!!$WRITE(UNIT=KULOUT,FMT='('' CCCN_MODES = '',A8)')CCCN_MODES
+!!$WRITE(UNIT=KULOUT,FMT='('' HINI_CCN = '',A3,''HTYPE_CCN = '',A1)')&
+!!$&HINI_CCN,HTYPE_CCN
+!!$WRITE(UNIT=KULOUT,FMT='('' NMOD_IFN = '',I5)') NMOD_IFN
+!!$WRITE(UNIT=KULOUT,FMT='('' NMOD_IMM = '',I5)') NMOD_IMM
+!!$WRITE(UNIT=KULOUT,FMT='('' NIND_SPECIE = '',I5)') NIND_SPECIE
+!!$WRITE(UNIT=KULOUT,FMT='('' NPHILLIPS = '',I5)') NPHILLIPS
+!!$WRITE(UNIT=KULOUT,FMT='('' NMOD_CCN = '',I5)') NMOD_CCN
+!!$WRITE(UNIT=KULOUT,FMT='('' XIFN_CONC = '',f6.2)') XIFN_CONC
+!!$WRITE(UNIT=KULOUT,FMT='('' XALPHAI = '',f6.2)') XALPHAI
+!!$WRITE(UNIT=KULOUT,FMT='('' XNUI = '',f6.2)') XNUI
+!!$WRITE(UNIT=KULOUT,FMT='('' XALPHAS = '',f6.2)') XALPHAS
+!!$WRITE(UNIT=KULOUT,FMT='('' XNUS = '',f6.2)') XNUS
+!!$WRITE(UNIT=KULOUT,FMT='('' XALPHAG = '',f6.2)') XALPHAG
+!!$WRITE(UNIT=KULOUT,FMT='('' XNUG = '',f6.2)') XNUG
+!!$WRITE(UNIT=KULOUT,FMT='('' XCCN_CONC = '',f6.2)') XCCN_CONC
+!!$WRITE(UNIT=KULOUT,FMT='('' XALPHAC = '',f6.2)') XALPHAC
+!!$WRITE(UNIT=KULOUT,FMT='('' XNUC = '',f6.2)') XNUC
+!!$WRITE(UNIT=KULOUT,FMT='('' XALPHAR = '',f6.2)') XALPHAR
+!!$WRITE(UNIT=KULOUT,FMT='('' XNUR = '',f6.2)') XNUR
+!!$WRITE(UNIT=KULOUT,FMT='('' XFSOLUB_CCN = '',f6.2)') XFSOLUB_CCN
+!!$WRITE(UNIT=KULOUT,FMT='('' XACTEMP_CCN = '',f6.2)') XACTEMP_CCN
+!!$WRITE(UNIT=KULOUT,FMT='('' XAERDIFF = '',f6.2)') XAERDIFF
+!!$WRITE(UNIT=KULOUT,FMT='('' XAERHEIGHT = '',f6.2)') XAERHEIGHT
+
+
+
+RETURN
+END SUBROUTINE AROINI_MICRO_LIMA
diff --git a/src/arome/ext/aroini_micro_lima.h b/src/arome/ext/aroini_micro_lima.h
new file mode 100644
index 0000000000000000000000000000000000000000..66a01c117f5fe8f3c5662f152bfd61b662faa618
--- /dev/null
+++ b/src/arome/ext/aroini_micro_lima.h
@@ -0,0 +1,18 @@
+INTERFACE
+SUBROUTINE AROINI_MICRO_LIMA(KULOUT,KULNAM,PTSTEP,LDWARM,CMICRO,KSPLITR,KSPLITG,CCSEDIM,LDCRIAUTI,&
+ PCRIAUTI,PT0CRIAUTI,PCRIAUTC)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+INTEGER(KIND=JPIM), INTENT (IN) :: KULOUT
+INTEGER(KIND=JPIM), INTENT (IN) :: KULNAM
+REAL(KIND=JPRB), INTENT (IN) :: PTSTEP
+LOGICAL, INTENT (IN) :: LDWARM
+CHARACTER (LEN=4), INTENT (IN) :: CMICRO
+CHARACTER(4), INTENT (IN) :: CCSEDIM
+INTEGER(KIND=JPIM), INTENT (OUT) :: KSPLITR
+INTEGER(KIND=JPIM), INTENT (OUT) :: KSPLITG
+LOGICAL, INTENT (IN) :: LDCRIAUTI
+REAL(KIND=JPRB), INTENT (IN) :: PCRIAUTI
+REAL(KIND=JPRB), INTENT (IN) :: PT0CRIAUTI
+REAL(KIND=JPRB), INTENT (IN) :: PCRIAUTC
+END SUBROUTINE AROINI_MICRO_LIMA
+END INTERFACE
diff --git a/src/arome/ext/namlima.nam.h b/src/arome/ext/namlima.nam.h
new file mode 100644
index 0000000000000000000000000000000000000000..3b332acd40fa83102903b276c807f6f2c8c7d8ed
--- /dev/null
+++ b/src/arome/ext/namlima.nam.h
@@ -0,0 +1,16 @@
+NAMELIST/NAMLIMA/LNUCL, LSEDI, LHHONI, LMEYERS, &
+ NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, &
+ CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
+ XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, LMURAKAMI, &
+ LACTI, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LADJ, LKHKO, LKESSLERAC, NMOM_C, NMOM_R, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
+ XALPHAC, XNUC, XALPHAR, XNUR, &
+ XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
+ LSCAV, LAERO_MASS, LDEPOC, XVDEPOC, LACTTKE, &
+ LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index 95e773e987fa70619196587c5494177ceb27da86..2e00e3c0612ce24c313e7b1b3201b4ec5509f190 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -204,3 +204,17 @@ mpa/micro/interface/aro_subudget.h
mpa/micro/interface/aroend_budget.h
mpa/micro/module/modd_refaro.F90
mpa/micro/externals/invert_vlev.F90
+phyex/micro/lima_warm.F90
+phyex/micro/lima_warm_sedimentation.F90
+phyex/micro/lima_warm_nucl.F90
+phyex/micro/lima_warm_coal.F90
+phyex/micro/lima_warm_evap.F90
+phyex/micro/lima_cold.F90
+phyex/micro/lima_cold_sedimentation.F90
+phyex/micro/lima_cold_hom_nucl.F90
+phyex/micro/lima_cold_slow_processes.F90
+phyex/micro/lima_mixed.F90
+phyex/micro/lima_mixed_slow_processes.F90
+phyex/micro/lima_mixed_fast_processes.F90
+phyex/micro/lima_adjust.F90
+phyex/micro/lima_phillips.F90
diff --git a/src/arome/micro/hypgeo.F90 b/src/arome/micro/hypgeo.F90
deleted file mode 100644
index 9976b499002059b4015ca15997e79a5b955f9d4e..0000000000000000000000000000000000000000
--- a/src/arome/micro/hypgeo.F90
+++ /dev/null
@@ -1,120 +0,0 @@
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source: /home/cvsroot/MESONH_RCS/CODEMNH/hypgeo.f90,v $ $Revision: 1.6 $
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-!####################
-MODULE MODI_HYPGEO
-!####################
-!
-INTERFACE
-!
-FUNCTION HYPGEO(PA,PB,PC,PF,PX) RESULT(PHYPGEO)
-REAL, INTENT(IN) :: PA,PB,PC,PF
-REAL, INTENT(IN) :: PX
-REAL :: PHYPGEO
-END FUNCTION HYPGEO
-!
-END INTERFACE
-!
-END MODULE MODI_HYPGEO
-! #############################################
- FUNCTION HYPGEO(PA,PB,PC,PF,PX) RESULT(PHYPGEO)
-! #############################################
-!
-!
-!!**** *HYPGEO* - hypergeometric function
-!!
-!!
-!! PURPOSE
-!! -------
-! The purpose of this function is to compute the hypergeometric
-!! function of its argument.
-!!
-!!
-!! A*B (A+1)A*(B+1)B X^2
-!! HYPGEO(A,B,C,X)= 1 + ----- * X + ------------- * --- + ... +
-!! C (C+1)C 2
-!!
-!! (A+n)...A*(B+n)...B X^n
-!! --------------------- * ----- + ... ...
-!! (C+n)...C n!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! HYPSER
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 272
-!!
-!!
-!! AUTHOR
-!! ------
-!! Jean-Martial Cohard *LA/OMP*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 31/12/96
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-!
-USE MODI_GAMMA
-USE MODI_HYPSER
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-REAL, INTENT(IN) :: PA,PB,PC,PF
-REAL, INTENT(IN) :: PX
-REAL :: PHYPGEO
-!
-!* 0.2 declarations of local variables
-!
-!
-INTEGER :: JN
-INTEGER :: ITMAX=100
-REAL :: ZEPS,ZTEMP
-REAL :: ZFPMIN=1.E-30
-REAL :: ZXH
-REAL :: ZX0,ZX1,ZZA,ZZB,ZZC,ZZD,Y(2)
-!
-!------------------------------------------------------------------------------
-!
-!
-ZEPS = 2.E-2
-ZXH = PF * PX**2.0
-IF (ZXH.LT.(1-ZEPS)) THEN
- CALL HYPSER(PA,PB,PC,-ZXH,PHYPGEO)
-ELSE IF (ZXH.GT.(1.+ZEPS)) THEN
- ZXH = 1./ZXH
- CALL HYPSER(PA,PA-PC+1.,PA-PB+1.,-ZXH,PHYPGEO)
- PHYPGEO = PHYPGEO*ZXH**(PA)* &
- (GAMMA(PC)*GAMMA(PB-PA)/(GAMMA(PB)*GAMMA(PC-PA)))
- CALL HYPSER(PB,PB-PC+1.,PB-PA+1.,-ZXH,ZTEMP)
- PHYPGEO = PHYPGEO+ZTEMP*ZXH**(PB)* &
- (GAMMA(PC)*GAMMA(PA-PB)/(GAMMA(PA)*GAMMA(PC-PB)))
-ELSE
- ZX0 = (1.-ZEPS)
- ZX1 = 1./(1.+ZEPS)
- CALL HYPSER(PA,PA-PC+1.,PA-PB+1.,-ZX1,PHYPGEO)
- PHYPGEO = PHYPGEO*ZX1**(PA)* &
- (GAMMA(PC)*GAMMA(PB-PA)/(GAMMA(PB)*GAMMA(PC-PA)))
- CALL HYPSER(PB,PB-PC+1.,PB-PA+1.,-ZX1,ZTEMP)
- PHYPGEO = PHYPGEO+ZTEMP*ZX1**(PB)* &
- (GAMMA(PC)*GAMMA(PA-PB)/(GAMMA(PA)*GAMMA(PC-PB)))
- CALL HYPSER(PA,PB,PC,-ZX0,ZTEMP)
- PHYPGEO = ZTEMP + (ZXH-ZX0)*(PHYPGEO-ZTEMP)/(2.*ZEPS)
-ENDIF
-END
diff --git a/src/arome/micro/hypser.F90 b/src/arome/micro/hypser.F90
deleted file mode 100644
index 28a15f8eb143135fe6bc96b3936292be2d6a7b71..0000000000000000000000000000000000000000
--- a/src/arome/micro/hypser.F90
+++ /dev/null
@@ -1,118 +0,0 @@
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source: /home/cvsroot/MESONH_RCS/CODEMNH/hypser.f90,v $ $Revision: 1.7 $
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-!####################
-MODULE MODI_HYPSER
-!####################
-!
-INTERFACE
-!
-SUBROUTINE HYPSER(PA,PB,PC,PX,PHYP)
-REAL, INTENT(IN) :: PA,PB,PC
-REAL, INTENT(IN) :: PX
-REAL, INTENT(INOUT) :: PHYP
-END SUBROUTINE HYPSER
-!
-END INTERFACE
-!
-END MODULE MODI_HYPSER
-! #############################################
- SUBROUTINE HYPSER(PA,PB,PC,PX,PHYP)
-! #############################################
-!
-!
-!!**** *HYPSER* - hypergeometric function
-!!
-!!
-!! PURPOSE
-!! -------
-! The purpose of this function is to compute the hypergeometric
-!! function of its argument.
-!!
-!!
-!! A*B (A+1)A*(B+1)B X^2
-!! HYPSER(A,B,C,X)= 1 + ----- * X + ------------- * --- + ... +
-!! C (C+1)C 2
-!!
-!! (A+n)...A*(B+n)...B X^n
-!! --------------------- * ----- + ... ...
-!! (C+n)...C n!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! HYPSER
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 272
-!!
-!!
-!! AUTHOR
-!! ------
-!! Jean-Martial Cohard *LA/OMP*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 31/12/96
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-REAL, INTENT(IN) :: PA,PB,PC
-REAL, INTENT(IN) :: PX
-REAL, INTENT(INOUT) :: PHYP
-!
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JN,JFLAG
-REAL :: ZXH,ZZA,ZZB,ZZC,ZFAC,ZTEMP
-REAL :: ZPREC
-!
-!------------------------------------------------------------------------------
-!
-ZPREC = 1.0E-04
-ZXH = PX
-ZFAC = 1.0
-ZTEMP = ZFAC
-ZZA = PA
-ZZB = PB
-ZZC = PC
-JFLAG = 0
-SERIE: DO JN = 1,5000
- ZFAC = ZFAC * ZZA * ZZB / ZZC
- ZFAC = ZFAC * ZXH / FLOAT(JN)
- PHYP = ZTEMP + ZFAC
- IF (ABS(PHYP-ZTEMP).LE.ZPREC) THEN
- JFLAG = 1
- EXIT SERIE
- END IF
- ZTEMP = PHYP
- ZZA = ZZA + 1.
- ZZB = ZZB + 1.
- ZZC = ZZC + 1.
-END DO SERIE
-IF (JFLAG == 0) THEN
- PRINT *,'CONVERGENCE FAILURE IN HYPSER'
-!callabortstop
-CALL ABORT
- STOP
-END IF
-!
-END
diff --git a/src/arome/micro/ini_lima.F90 b/src/arome/micro/ini_lima.F90
deleted file mode 100644
index e6a94ef38da0ac05e7ebb3c6ec4986457cdd4057..0000000000000000000000000000000000000000
--- a/src/arome/micro/ini_lima.F90
+++ /dev/null
@@ -1,156 +0,0 @@
-! ####################
- MODULE MODI_INI_LIMA
-! ####################
-!
-INTERFACE
- SUBROUTINE INI_LIMA (KULOUT, PTSTEP, PDZMIN, KSPLITR, KSPLITG)
-!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
-INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
- ! integration for graupel
- ! sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA
-!
-END INTERFACE
-!
-END MODULE MODI_INI_LIMA
-! ######################################################
- SUBROUTINE INI_LIMA (KULOUT, PTSTEP, PDZMIN, KSPLITR, KSPLITG)
-! ######################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to initialize the constants used in the
-!! microphysical scheme LIMA.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-
-USE MODD_PARAM_LIMA
-USE MODD_PARAMETERS
-USE MODD_LUNIT
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
-INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
- ! integration for graupel or hail
- ! sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-!* 0.2 Declarations of local variables :
-!
-REAL :: ZT ! Work variable
-REAL :: ZVTRMAX
-!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. INIT OUTPUT LISTING, COMPUTE KSPLITR AND KSPLITG
-! ------------------------------------------------
-!
-!
-! Init output listing
-CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
-!
-!
-! KSPLITR
-ZVTRMAX = 30. ! Maximum rain drop fall speed
-!
-KSPLITR = 1
-SPLITR : DO
- ZT = PTSTEP / FLOAT(KSPLITR)
- IF ( ZT * ZVTRMAX / PDZMIN < 1.0) EXIT SPLITR
- KSPLITR = KSPLITR + 1
-END DO SPLITR
-!
-!
-! KSPLITG
-ZVTRMAX = 30.
-IF( LHAIL_LIMA ) THEN
- ZVTRMAX = 60. ! Hail case
-END IF
-!
-KSPLITG = 1
-SPLITG : DO
- ZT = 2.* PTSTEP / FLOAT(KSPLITG)
- IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLITG
- KSPLITG = KSPLITG + 1
-END DO SPLITG
-!
-!
-!
-IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
- ! MODD_RAIN_C2R2_PARAM are computed only once.
-!
-!
-! Set bounds for mixing ratios and concentrations
-ALLOCATE( XRTMIN(7) )
-XRTMIN(1) = 1.0E-20 ! rv
-XRTMIN(2) = 1.0E-20 ! rc
-!XRTMIN(3) = 1.0E-20 ! rr
-XRTMIN(3) = 1.0E-17 ! rr
-XRTMIN(4) = 1.0E-20 ! ri
-XRTMIN(5) = 1.0E-15 ! rs
-XRTMIN(6) = 1.0E-15 ! rg
-XRTMIN(7) = 1.0E-15 ! rh
-ALLOCATE( XCTMIN(7) )
-XCTMIN(1) = 1.0 ! Not used
-XCTMIN(2) = 1.0E+4 ! Nc
-!XCTMIN(3) = 1.0E+1 ! Nr
-XCTMIN(3) = 1.0E-3 ! Nr
-XCTMIN(4) = 1.0E-3 ! Ni
-XCTMIN(5) = 1.0E-3 ! Not used
-XCTMIN(6) = 1.0E-3 ! Not used
-XCTMIN(7) = 1.0E-3 ! Not used
-!
-!
-! Air density fall speed correction
-XCEXVT = 0.4
-!
-!------------------------------------------------------------------------------
-!
-!
-!
-!* 2. DEFINE SPECIES CHARACTERISTICS AND PROCESSES CONSTANTS
-! ------------------------------------------------------
-!
-!
-CALL INI_LIMA_WARM(KULOUT, PTSTEP, PDZMIN)
-!
-CALL INI_LIMA_COLD_MIXED(KULOUT, PTSTEP, PDZMIN)
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE INI_LIMA
diff --git a/src/arome/micro/ini_lima_cold_mixed.F90 b/src/arome/micro/ini_lima_cold_mixed.F90
deleted file mode 100644
index ba7e13302bb01192a51c354235b9e9d6e45648d4..0000000000000000000000000000000000000000
--- a/src/arome/micro/ini_lima_cold_mixed.F90
+++ /dev/null
@@ -1,1309 +0,0 @@
-! ###############################
- MODULE MODI_INI_LIMA_COLD_MIXED
-! ###############################
-!
-INTERFACE
- SUBROUTINE INI_LIMA_COLD_MIXED (KULOUT, PTSTEP, PDZMIN)
-!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA_COLD_MIXED
-!
-END INTERFACE
-!
-END MODULE MODI_INI_LIMA_COLD_MIXED
-! ###############################################
- SUBROUTINE INI_LIMA_COLD_MIXED (KULOUT, PTSTEP, PDZMIN)
-! ###############################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to initialize the constants used in the
-!! microphysical scheme LIMA for the cold and mixed phase variables
-!! and processes.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-USE MODD_PARAM_LIMA_COLD
-USE MODD_PARAM_LIMA_MIXED
-USE MODD_PARAMETERS
-USE MODD_LUNIT
-!
-USE MODI_LIMA_FUNCTIONS
-USE MODI_GAMMA
-USE MODI_GAMMA_INC
-USE MODE_RRCOLSS, ONLY: RRCOLSS
-USE MODE_RZCOLX, ONLY: RZCOLX
-USE MODE_RSCOLRG, ONLY: RSCOLRG
-USE MODE_READ_XKER_RACCS, ONLY: READ_XKER_RACCS
-USE MODE_READ_XKER_SDRYG, ONLY: READ_XKER_SDRYG
-USE MODE_READ_XKER_RDRYG, ONLY: READ_XKER_RDRYG
-USE MODE_READ_XKER_SWETH, ONLY: READ_XKER_SWETH
-USE MODE_READ_XKER_GWETH, ONLY: READ_XKER_GWETH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IKB ! Coordinates of the first physical
- ! points along z
-INTEGER :: J1,J2 ! Internal loop indexes
-!
-REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments
-REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law
-!
-REAL :: ZT ! Work variable
-REAL :: ZVTRMAX ! Raindrop maximal fall velocity
-REAL :: ZRHO00 ! Surface reference air density
-REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
- ! functions and kernels
-REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
- ! integration of the riming rate of the aggregates
-REAL :: ZEGS, ZEGR, ZEHS, ZEHG! Bulk collection efficiencies
-!
-INTEGER :: IND ! Number of interval to integrate the kernels
-REAL :: ZESR ! Mean efficiency of rain-aggregate collection
-REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
-!
-!
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
- ! listing
-REAL :: ZCONC_MAX ! Maximal concentration for snow
-REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
-!
-INTEGER :: KND
-INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
-REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH
-REAL :: PNUR,PNUS,PNUG,PNUH
-REAL :: PBR,PBS,PBG,PBH
-REAL :: PCR,PCS,PCG,PCH
-REAL :: PDR,PDS,PFVELOS,PDG,PDH
-REAL :: PESR,PEGS,PEGR,PEHS,PEHG
-REAL :: PFDINFTY
-REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN
-REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
-REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
-REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
-REAL :: PWETLBDAH_MAX,PWETLBDAH_MIN
-INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH
-!
-REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. CHARACTERISTICS OF THE SPECIES
-! ------------------------------
-!
-!
-!* 1.2 Ice crystal characteristics
-!
-SELECT CASE (CPRISTINE_ICE_LIMA)
- CASE('PLAT')
- XAI = 0.82 ! Plates
- XBI = 2.5 ! Plates
- XC_I = 747. ! Plates
- XDI = 1.0 ! Plates
- XC1I = 1./XPI ! Plates
- CASE('COLU')
- XAI = 2.14E-3 ! Columns
- XBI = 1.7 ! Columns
- XC_I = 1.96E5 ! Columns
- XDI = 1.585 ! Columns
- XC1I = 0.8 ! Columns
- CASE('BURO')
- XAI = 44.0 ! Bullet rosettes
- XBI = 3.0 ! Bullet rosettes
- XC_I = 4.E5 ! Bullet rosettes
- XDI = 1.663 ! Bullet rosettes
- XC1I = 0.5 ! Bullet rosettes
-END SELECT
-!
-! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
-!
-XF0I = 1.00
-! Correction BVIE XF2I from Pruppacher 1997 eq 13-88
-!XF2I = 0.103
-XF2I = 0.14
-XF0IS = 0.86
-XF1IS = 0.28
-!
-!* 1.3 Snowflakes/aggregates characteristics
-!
-XAS = 0.02
-XBS = 1.9
-XCS = 5.
-XDS = 0.27
-!
-XCCS = 5.0
-XCXS = 1.0
-!
-XF0S = 0.86
-XF1S = 0.28
-!
-XC1S = 1./XPI
-!
-!* 1.4 Graupel characteristics
-!
-XAG = 19.6 ! Lump graupel case
-XBG = 2.8 ! Lump graupel case
-XCG = 122. ! Lump graupel case
-XDG = 0.66 ! Lump graupel case
-!
-XCCG = 5.E5
-XCXG = -0.5
-! XCCG = 4.E4 ! Test of Ziegler (1988)
-! XCXG = -1.0 ! Test of Ziegler (1988)
-!
-XF0G = 0.86
-XF1G = 0.28
-!
-XC1G = 1./2.
-!
-!* 2.5 Hailstone characteristics
-!
-!
-XAH = 470.
-XBH = 3.0
-XCH = 201.
-XDH = 0.64
-!
-!XCCH = 5.E-4
-!XCXH = 2.0
-!!!!!!!!!!!!
- XCCH = 4.E4 ! Test of Ziegler (1988)
- XCXH = -1.0 ! Test of Ziegler (1988)
-!!! XCCH = 5.E5 ! Graupel_like
-!!! XCXH = -0.5 ! Graupel_like
-!!!!!!!!!!!!
-!
-XF0H = 0.86
-XF1H = 0.28
-!
-XC1H = 1./2.
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
-! ----------------------------------------
-!
-!
-!* 2.1 Ice, snow, graupel and hail distribution
-!
-!
-XALPHAI = 3.0 ! Gamma law for the ice crystal volume
-XNUI = 3.0 ! Gamma law with little dispersion
-!
-XALPHAS = 1.0 ! Exponential law
-XNUS = 1.0 ! Exponential law
-!
-XALPHAG = 1.0 ! Exponential law
-XNUG = 1.0 ! Exponential law
-!
-XALPHAH = 1.0 ! Gamma law
-XNUH = 8.0 ! Gamma law with little dispersion
-!
-!* 2.2 Constants for shape parameter
-!
-XLBEXI = 1.0/XBI
-XLBI = XAI*MOMG(XALPHAI,XNUI,XBI)
-!
-XLBEXS = 1.0/(XCXS-XBS)
-XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
-!
-XLBEXG = 1.0/(XCXG-XBG)
-XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
-!
-XLBEXH = 1.0/(XCXH-XBH)
-XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" Shape Parameters")')
- WRITE(UNIT=KULOUT,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
- WRITE(UNIT=KULOUT,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
- WRITE(UNIT=KULOUT,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
- WRITE(UNIT=KULOUT,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
-END IF
-!
-XLBDAS_MAX = 100000.0
-XLBDAG_MAX = 100000.0
-!
-ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
-XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. CONSTANTS FOR THE SEDIMENTATION
-! -------------------------------
-!
-!
-!* 3.1 Exponent of the fall-speed air density correction
-!
-IKB = 1 + JPVEXT
-! Correction
-! ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
-ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C
-!
-!* 3.2 Constants for sedimentation
-!
-!! XEXRSEDI = (XBI+XDI)/XBI
-!! XEXCSEDI = 1.0-XEXRSEDI
-!! XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * &
-!! XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * &
-!! ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
-!! (ZRHO00)**XCEXVT
-!! !
-!! ! Computations made for Columns
-!! !
-!! XEXRSEDI = 1.9324
-!! XEXCSEDI =-0.9324
-!! XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* &
-!! MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
-!! XEXCSEDI =-0.9324*3.0
-!! WRITE (KULOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI=',XFSEDI
-!
-!
-XFSEDRI = XC_I*GAMMA_X0D(XNUI+(XDI+XBI)/XALPHAI)/GAMMA_X0D(XNUI+XBI/XALPHAI)* &
- (ZRHO00)**XCEXVT
-XFSEDCI = XC_I*GAMMA_X0D(XNUI+XDI/XALPHAI)/GAMMA_X0D(XNUI)* &
- (ZRHO00)**XCEXVT
-!
-XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
-XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
- (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
-!
-XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
-XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
- (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
-!
-XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH)
-XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* &
- (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. CONSTANTS FOR HETEROGENEOUS NUCLEATION
-! --------------------------------------
-!
-!
-! ***************
-!* 4.1 LIMA_NUCLEATION
-! ***************
-!* 4.1.1 Constants for the computation of the number concentration
-! of active IN
-!
-XRHO_CFDC = 0.76
-!
-XGAMMA = 2.
-!
-IF (NPHILLIPS == 13) THEN
- XAREA1(1) = 2.0E-6 !DM1
- XAREA1(2) = XAREA1(1) !DM2
- XAREA1(3) = 1.0E-7 !BC
- XAREA1(4) = 8.9E-7 !BIO
-ELSE IF (NPHILLIPS == 8) THEN
- XAREA1(1) = 2.0E-6 !DM1
- XAREA1(2) = XAREA1(1) !DM2
- XAREA1(3) = 2.7E-7 !BC
- XAREA1(4) = 9.1E-7 !BIO
-ELSE
- print *, "NPHILLIPS n'est pas égal à 8 ou 13"
- STOP
-END IF
-!
-!* 4.1.2 Constants for the computation of H_X (the fraction-redu-
-! cing IN activity at low S_i and warm T) for X={DM1,DM2,BC,BIO}
-!
-!
-IF (NPHILLIPS == 13) THEN
- XDT0(1) = 5. +273.15 !DM1
- XDT0(2) = 5. +273.15 !DM2
- XDT0(3) = 10. +273.15 !BC
- XDT0(4) = 5. +273.15 !BIOO
-!
- XT0(1) = -40. +273.15 !DM1
- XT0(2) = XT0(1) !DM2
- XT0(3) = -50. +273.15 !BC
- XT0(4) = -20. +273.15 !BIO
-!
- XSW0 = 0.97
-!
- XDSI0(1) = 0.1 !DM1
- XDSI0(2) = 0.1 !DM2
- XDSI0(3) = 0.1 !BC
- XDSI0(4) = 0.2 !BIO
-!
- XH(1) = 0.15 !DM1
- XH(2) = 0.15 !DM2
- XH(3) = 0. !BC
- XH(4) = 0. !O
-!
- XTX1(1) = -30. +273.15 !DM1
- XTX1(2) = XTX1(1) !DM2
- XTX1(3) = -25. +273.15 !BC
- XTX1(4) = -5. +273.15 !BIO
-!
- XTX2(1) = -10. +273.15 !DM1
- XTX2(2) = XTX2(1) !DM2
- XTX2(3) = -15. +273.15 !BC
- XTX2(4) = -2. +273.15 !BIO
-ELSE IF (NPHILLIPS == 8) THEN
- XDT0(1) = 5. +273.15 !DM1
- XDT0(2) = 5. +273.15 !DM2
- XDT0(3) = 5. +273.15 !BC
- XDT0(4) = 5. +273.15 !O
-!
- XT0(1) = -40. +273.15 !DM1
- XT0(2) = XT0(1) !DM2
- XT0(3) = -50. +273.15 !BC
- XT0(4) = -50. +273.15 !BIO
-!
- XSW0 = 0.97
-!
- XDSI0(1) = 0.1 !DM1
- XDSI0(2) = 0.1 !DM2
- XDSI0(3) = 0.1 !BC
- XDSI0(4) = 0.1 !BIO
-!
- XH(1) = 0.15 !DM1
- XH(2) = 0.15 !DM2
- XH(3) = 0. !BC
- XH(4) = 0. !O
-!
- XTX1(1) = -5. +273.15 !DM1
- XTX1(2) = XTX1(1) !DM2
- XTX1(3) = -5. +273.15 !BC
- XTX1(4) = -5. +273.15 !BIO
-!
- XTX2(1) = -2. +273.15 !DM1
- XTX2(2) = XTX2(1) !DM2
- XTX2(3) = -2. +273.15 !BC
- XTX2(4) = -2. +273.15 !BIO
-END IF
-!
-!* 4.1.3 Constants for the computation of the Gauss Hermitte
-! quadrature method used for the integration of the total
-! crystal number over T>-35°C
-!
-NDIAM = 70
-!
-ALLOCATE(XABSCISS(NDIAM))
-ALLOCATE(XWEIGHT (NDIAM))
-!
-CALL GAUHER(XABSCISS, XWEIGHT, NDIAM)
-!
-! *****************
-!* 4.2 MEYERS NUCLEATION
-! *****************
-!
-ZFACT_NUCL = 1.0 ! Plates, Columns and Bullet rosettes
-!
-!* 5.2.1 Constants for nucleation from ice nuclei
-!
-XNUC_DEP = XFACTNUC_DEP*1000.*ZFACT_NUCL
-XEXSI_DEP = 12.96E-2
-XEX_DEP = -0.639
-!
-XNUC_CON = XFACTNUC_CON*1000.*ZFACT_NUCL
-XEXTT_CON = -0.262
-XEX_CON = -2.8
-!
-XMNU0 = 6.88E-13
-!
-IF (LMEYERS_LIMA) THEN
- WRITE(UNIT=KULOUT,FMT='(" Heterogeneous nucleation")')
- WRITE(UNIT=KULOUT,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
- XNUC_DEP,XEXSI_DEP,XEX_DEP
- WRITE(UNIT=KULOUT,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
- XNUC_CON,XEXTT_CON,XEX_CON
- WRITE(UNIT=KULOUT,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
-! -------------------------------------
-!
-!
-!* 5.1.2 Constants for homogeneous nucleation from haze particules
-!
-XRHOI_HONH = 925.0
-XCEXP_DIFVAP_HONH = 1.94
-XCOEF_DIFVAP_HONH = (2.0*XPI)*0.211E-4*XP00/XTT**XCEXP_DIFVAP_HONH
-XCRITSAT1_HONH = 2.583
-XCRITSAT2_HONH = 207.83
-XTMIN_HONH = 180.0
-XTMAX_HONH = 240.0
-XDLNJODT1_HONH = 4.37
-XDLNJODT2_HONH = 0.03
-XC1_HONH = 100.0
-XC2_HONH = 22.6
-XC3_HONH = 0.1
-XRCOEF_HONH = (XPI/6.0)*XRHOI_HONH
-!
-!
-!* 5.1.3 Constants for homogeneous nucleation from cloud droplets
-!
-XTEXP1_HONC = -606.3952*LOG(10.0)
-XTEXP2_HONC = -52.6611*LOG(10.0)
-XTEXP3_HONC = -1.7439*LOG(10.0)
-XTEXP4_HONC = -0.0265*LOG(10.0)
-XTEXP5_HONC = -1.536E-4*LOG(10.0)
-IF (XALPHAC == 3.0) THEN
- XC_HONC = XPI/6.0
- XR_HONC = XPI/6.0
-ELSE
- WRITE(UNIT=KULOUT,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=KULOUT,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
- WRITE(UNIT=KULOUT,FMT='(" No algorithm yet developped in this case !")')
- STOP
-END IF
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=KULOUT,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
- WRITE(UNIT=KULOUT,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
- WRITE(UNIT=KULOUT,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
- WRITE(UNIT=KULOUT,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
- WRITE(UNIT=KULOUT,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
- WRITE(UNIT=KULOUT,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
-END IF
-!
-!
-!* 5.2 Constants for vapor deposition on ice
-!
-XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
-!
-X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
-X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
-!
-! Harrington parameterization for ice to snow conversion
-!
-XDICNVS_LIM = 125.E-6 ! size in microns
-XLBDAICNVS_LIM = (50.0**(1.0/(XALPHAI)))/XDICNVS_LIM ! ZLBDAI Limitation
-XC0DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF0IS* &
- (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI)
-XC1DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF1IS*SQRT(XC_I)* &
- (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI+(XDI+1.0)/2.0)
-XR0DEPIS = XC0DEPIS *(XAI*XDICNVS_LIM**XBI)
-XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI)
-!
-! Harrington parameterization for snow to ice conversion
-!
-XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999)
-!
-XDSCNVI_LIM = 125.E-6 ! size in microns
-XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation
-XC0DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF0IS* &
- (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS)
-XC1DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF1IS*SQRT(XCS)* &
- (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS+(XDS+1.0)/2.0)
-XR0DEPSI = XC0DEPSI *(XAS*XDSCNVI_LIM**XBS)
-XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS)
-!
-! Vapor deposition on snow and graupel and hail
-!
-X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
-X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
-XEX0DEPS = XCXS-1.0
-XEX1DEPS = XCXS-0.5*(XDS+3.0)
-!
-X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
-X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
-XEX0DEPG = XCXG-1.0
-XEX1DEPG = XCXG-0.5*(XDG+3.0)
-!
-X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.)
-X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
-XEX0DEPH = XCXH-1.0
-XEX1DEPH = XCXH-0.5*(XDH+3.0)
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES
-! ---------------------------------------
-!
-!
-!* 6.0 Precalculation of the gamma function momentum
-!
-ZGAMI(1) = GAMMA_X0D(XNUI)
-ZGAMI(2) = MOMG(XALPHAI,XNUI,3.)
-ZGAMI(3) = MOMG(XALPHAI,XNUI,6.)
-ZGAMI(4) = ZGAMI(3)-ZGAMI(2)**2 ! useful for Sig_I
-ZGAMI(5) = MOMG(XALPHAI,XNUI,9.)
-ZGAMI(6) = MOMG(XALPHAI,XNUI,3.+XBI)
-ZGAMI(7) = MOMG(XALPHAI,XNUI,XBI)
-ZGAMI(8) = MOMG(XALPHAI,XNUI,3.)/MOMG(XALPHAI,XNUI,2.)
-!
-ZGAMS(1) = GAMMA_X0D(XNUS)
-ZGAMS(2) = MOMG(XALPHAS,XNUS,3.)
-!
-!
-!* 6.1 Csts for the coalescence processes
-!
-ZFAC_ZRNIC = 0.1
-XKER_ZRNIC_A1 = 2.59E15*ZFAC_ZRNIC**2! From Long a1=9.44E9 cm-3
- ! so XKERA1= 9.44E9*1E6*(PI/6)**2
-XKER_ZRNIC_A2 = 3.03E3*ZFAC_ZRNIC ! From Long a2=5.78E3
- ! so XKERA2= 5.78E3* (PI/6)
-!
-!
-!* 6.2 Csts for the pristine ice selfcollection process
-!
-XSELFI = XKER_ZRNIC_A1*ZGAMI(3)
-XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
-!
-!
-!* 6.3 Constants for pristine ice autoconversion
-!
-XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" pristine ice autoconversion")')
- WRITE(UNIT=KULOUT,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
-END IF
-!
-XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
-XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
-XLAUTS = 2.7E-2
-XLAUTS_THRESHOLD = 0.4
-XITAUTS= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
-XITAUTS_THRESHOLD = 7.5
-!
-!
-!* 6.4 Constants for snow aggregation
-!
-XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
-XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2)
-XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
-XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
-XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" snow aggregation")')
- WRITE(UNIT=KULOUT,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
-! --------------------------------------------------------
-!
-!
-!* 7.1 Constants for the riming of the aggregates
-!
-XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
-XCOLCS = 1.0
-XEXCRIMSS= XCXS-XDS-2.0
-XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
-XEXCRIMSG= XEXCRIMSS
-XCRIMSG = XCRIMSS
-XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
-XEXSRIMCG= XCXS-XBS
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" riming of the aggregates")')
- WRITE(UNIT=KULOUT,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
- WRITE(UNIT=KULOUT,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
-END IF
-!
-NGAMINC = 80
-XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
-XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
-ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/FLOAT(NGAMINC-1))
-!
-ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-!
-DO J1=1,NGAMINC
- ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
- XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
- XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
-END DO
-!
-XRIMINTP1 = XALPHAS / LOG(ZRATE)
-XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
-!
-!* 7.1.1 Defining the constants for the Hallett-Mossop
-! secondary ice nucleation process
-!
-XHMTMIN = XTT - 8.0
-XHMTMAX = XTT - 3.0
-XHM1 = 9.3E-3 ! Obsolete parameterization
-XHM2 = 1.5E-3/LOG(10.0) ! from Ferrier (1995)
-XHM_YIELD = 5.E-3 ! A splinter is produced after the riming of 200 droplets
-XHM_COLLCS= 1.0 ! Collision efficiency snow/droplet (with Dc>25 microns)
-XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS)
-!
-! Notice: One magnitude of lambda discretized over 10 points for the droplets
-!
-XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
-XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
-ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/FLOAT(NGAMINC-1))
-!
-ALLOCATE( XGAMINC_HMC(NGAMINC) )
-!
-DO J1=1,NGAMINC
- ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
- XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND)
-END DO
-!
-XHMSINTP1 = XALPHAC / LOG(ZRATE)
-XHMSINTP2 = 1.0 + XHMSINTP1*LOG( 12.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
-XHMLINTP1 = XALPHAC / LOG(ZRATE)
-XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
-!
-!
-!* 7.2 Constants for the accretion of raindrops onto aggregates
-!
-XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT)
-!
-XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
-XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.)
-XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
-!
-XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT)
-!
-XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
-XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
-XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
-!
-!* 7.2.1 Defining the ranges for the computation of the kernels
-!
-! Notice: One magnitude of lambda discretized over 10 points for rain
-! Notice: One magnitude of lambda discretized over 10 points for snow
-!
-NACCLBDAS = 40
-XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
-XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/FLOAT(NACCLBDAS-1)
-XACCINTP1S = 1.0 / ZRATE
-XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
-NACCLBDAR = 40
-XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
-XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/FLOAT(NACCLBDAR-1)
-XACCINTP1R = 1.0 / ZRATE
-XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
-!
-!* 7.2.2 Computations of the tabulated normalized kernels
-!
-IND = 50 ! Interval number, collection efficiency and infinite diameter
-ZESR = 1.0 ! factor used to integrate the dimensional distributions when
-ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
-!
-ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
-!
-CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
- PFDINFTY )
-IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
- (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
- (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
- (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
- (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
- (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
- (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
- (PFDINFTY/=ZFDINFTY) ) THEN
- CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XBR, XCS, XDS, PFVELOS, XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
- CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XBR, XCS, XDS, PFVELOS, XCR, XDR, 0., &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- ZFDINFTY, XKER_RACCS )
- CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XBS, XCS, XDS, PFVELOS, XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KULOUT,FMT='("KACCLBDAS=",I3)') NACCLBDAS
- WRITE(UNIT=KULOUT,FMT='("KACCLBDAR=",I3)') NACCLBDAR
- WRITE(UNIT=KULOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=KULOUT,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=KULOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=KULOUT,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=KULOUT,FMT='("PESR=",E13.6)') ZESR
- WRITE(UNIT=KULOUT,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=KULOUT,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=KULOUT,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=KULOUT,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=KULOUT,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=KULOUT,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=KULOUT,FMT='("PACCLBDAS_MAX=",E13.6)') &
- XACCLBDAS_MAX
- WRITE(UNIT=KULOUT,FMT='("PACCLBDAR_MAX=",E13.6)') &
- XACCLBDAR_MAX
- WRITE(UNIT=KULOUT,FMT='("PACCLBDAS_MIN=",E13.6)') &
- XACCLBDAS_MIN
- WRITE(UNIT=KULOUT,FMT='("PACCLBDAR_MIN=",E13.6)') &
- XACCLBDAR_MIN
- WRITE(UNIT=KULOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=KULOUT,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCSS(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=KULOUT,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCS (J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
- DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
- WRITE(UNIT=KULOUT,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SACCRG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- ELSE
- CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
- PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_RACCSS")')
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_RACCS ")')
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_SACCRG")')
-END IF
-!
-!
-!* 7.3 Constant for the conversion-melting rate
-!
-XFSCVMG = 2.0
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" conversion-melting of the aggregates")')
- WRITE(UNIT=KULOUT,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
-! --------------------------------------------------------
-!
-!
-!* 8.1 Constants for the rain contact freezing
-!
-XCOLIR = 1.0
-!
-! values of these coeficients differ from the single-momemt rain_ice case
-!
-XEXRCFRI = -XDR-5.0
-XRCFRI = ((XPI**2)/24.0)*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) &
- *MOMG(XALPHAR,XNUR,XDR+5.0)
-XEXICFRR = -XDR-2.0
-XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
- *MOMG(XALPHAR,XNUR,XDR+2.0)
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" rain contact freezing")')
- WRITE(UNIT=KULOUT,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
-END IF
-!
-!
-!* 8.2 Constants for the dry growth of the graupeln
-!
-!* 8.2.1 Constants for the cloud droplet collection by the graupeln
-! and for the Hallett-Mossop process
-!
-XCOLCG = 0.6 ! Estimated from Cober and List (1993)
-XFCDRYG = (XPI/4.0)*XCOLCG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
-!
-XHM_COLLCG= 0.9 ! Collision efficiency graupel/droplet (with Dc>25 microns)
-XHM_FACTG = XHM_YIELD*(XHM_COLLCG/XCOLCG)
-!
-!* 8.2.2 Constants for the cloud ice collection by the graupeln
-!
-XCOLIG = 0.25 ! Collection efficiency of I+G
-XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
-XCOLIG = 0.01 ! Collection efficiency of I+G
-XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
-WRITE (KULOUT, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
-WRITE (KULOUT, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
-XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" cloud ice collection by the graupeln")')
- WRITE(UNIT=KULOUT,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
- WRITE(UNIT=KULOUT,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
-END IF
-!
-!* 8.2.3 Constants for the aggregate collection by the graupeln
-!
-XCOLSG = 0.25 ! Collection efficiency of S+G
-XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
-XCOLSG = 0.01 ! Collection efficiency of S+G
-XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
-WRITE (KULOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
-WRITE (KULOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
-XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
-!
-XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
-XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
-XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" aggregate collection by the graupeln")')
- WRITE(UNIT=KULOUT,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
- WRITE(UNIT=KULOUT,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
-END IF
-!
-!* 8.2.4 Constants for the raindrop collection by the graupeln
-!
-XFRDRYG = ((XPI**2)/24.0)*XCCG*XRHOLW*(ZRHO00**XCEXVT)
-!
-XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.)
-XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.)
-XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
-!
-! Notice: One magnitude of lambda discretized over 10 points
-!
-NDRYLBDAR = 40
-XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
-XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
-ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/FLOAT(NDRYLBDAR-1)
-XDRYINTP1R = 1.0 / ZRATE
-XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
-NDRYLBDAS = 80
-XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
-XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
-ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/FLOAT(NDRYLBDAS-1)
-XDRYINTP1S = 1.0 / ZRATE
-XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
-NDRYLBDAG = 40
-XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/FLOAT(NDRYLBDAG-1)
-XDRYINTP1G = 1.0 / ZRATE
-XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
-!
-!* 8.2.5 Computations of the tabulated normalized kernels
-!
-IND = 50 ! Interval number, collection efficiency and infinite diameter
-ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
-ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
-!
-ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
-!
-CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY )
-IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
- (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
- (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
- (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
- (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PFVELOS/=PFVELOS) .OR. &
- (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
- (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
- (PFDINFTY/=ZFDINFTY) ) THEN
- CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XBS, XCG, XDG, 0., XCS, XDS, PFVELOS, &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- ZFDINFTY, XKER_SDRYG )
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KULOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=KULOUT,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
- WRITE(UNIT=KULOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=KULOUT,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=KULOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=KULOUT,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=KULOUT,FMT='("PEGS=",E13.6)') ZEGS
- WRITE(UNIT=KULOUT,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=KULOUT,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=KULOUT,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=KULOUT,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=KULOUT,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAS_MAX=",E13.6)') &
- XDRYLBDAS_MAX
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAS_MIN=",E13.6)') &
- XDRYLBDAS_MIN
- WRITE(UNIT=KULOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
- WRITE(UNIT=KULOUT,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- ELSE
- CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,XKER_SDRYG )
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_SDRYG")')
-END IF
-!
-!
-IND = 50 ! Number of interval used to integrate the dimensional
-ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
-ZFDINFTY = 20.0
-!
-ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
-!
-CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY )
-IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
- (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
- (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
- (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
- (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
- (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
- (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
- (PFDINFTY/=ZFDINFTY) ) THEN
- CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
- ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., &
- XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
- ZFDINFTY, XKER_RDRYG )
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KULOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=KULOUT,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
- WRITE(UNIT=KULOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=KULOUT,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=KULOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=KULOUT,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=KULOUT,FMT='("PEGR=",E13.6)') ZEGR
- WRITE(UNIT=KULOUT,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=KULOUT,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=KULOUT,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=KULOUT,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=KULOUT,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAR_MAX=",E13.6)') &
- XDRYLBDAR_MAX
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=KULOUT,FMT='("PDRYLBDAR_MIN=",E13.6)') &
- XDRYLBDAR_MIN
- WRITE(UNIT=KULOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
- WRITE(UNIT=KULOUT,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- ELSE
- CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,XKER_RDRYG )
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_RDRYG")')
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES
-! --------------------------------------------------------
-!
-!* 9.2 Constants for the wet growth of the hailstones
-!
-!
-!* 9.2.1 Constant for the cloud droplet and cloud ice collection
-! by the hailstones
-!
-XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0)
-!
-!* 9.2.2 Constants for the aggregate collection by the hailstones
-!
-XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
-!
-XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS)
-XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
-XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.)
-!
-!* 9.2.3 Constants for the graupel collection by the hailstones
-!
-XFGWETH = (XPI/4.0)*XCCH*XCCG*XAG*(ZRHO00**XCEXVT)
-!
-XLBGWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAG,XNUG,XBG)
-XLBGWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAG,XNUG,XBG+1.)
-XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.)
-!
-! Notice: One magnitude of lambda discretized over 10 points
-!
-NWETLBDAS = 80
-XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
-XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
-ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/FLOAT(NWETLBDAS-1)
-XWETINTP1S = 1.0 / ZRATE
-XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
-NWETLBDAG = 40
-XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
-XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
-ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/FLOAT(NWETLBDAG-1)
-XWETINTP1G = 1.0 / ZRATE
-XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
-NWETLBDAH = 40
-XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
-XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
-ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/FLOAT(NWETLBDAH-1)
-XWETINTP1H = 1.0 / ZRATE
-XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
-!
-!* 9.2.4 Computations of the tabulated normalized kernels
-!
-IND = 50 ! Interval number, collection efficiency and infinite diameter
-ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
-ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
-!
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
-!
-CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY )
-IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
- (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
- (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
- (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
- (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PFVELOS/=PFVELOS) .OR. &
- (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
- (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
- (PFDINFTY/=ZFDINFTY) ) THEN
- CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
- ZEHS, XBS, XCH, XDH, 0., XCS, XDS, PFVELOS, &
- XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
- ZFDINFTY, XKER_SWETH )
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KULOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=KULOUT,FMT='("KWETLBDAS=",I3)') NWETLBDAS
- WRITE(UNIT=KULOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=KULOUT,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=KULOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=KULOUT,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=KULOUT,FMT='("PEHS=",E13.6)') ZEHS
- WRITE(UNIT=KULOUT,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=KULOUT,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=KULOUT,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=KULOUT,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=KULOUT,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAS_MAX=",E13.6)') &
- XWETLBDAS_MAX
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAS_MIN=",E13.6)') &
- XWETLBDAS_MIN
- WRITE(UNIT=KULOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
- WRITE(UNIT=KULOUT,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- ELSE
- CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,XKER_SWETH )
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_SWETH")')
-END IF
-!
-!
-IND = 50 ! Number of interval used to integrate the dimensional
-ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
-ZFDINFTY = 20.0
-!
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
-!
-CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY )
-IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
- (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
- (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
- (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
- (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
- (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
- (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
- (PFDINFTY/=ZFDINFTY) ) THEN
- CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
- ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., &
- XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
- ZFDINFTY, XKER_GWETH )
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
- WRITE(UNIT=KULOUT,FMT='("*****************************************")')
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KULOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=KULOUT,FMT='("KWETLBDAG=",I3)') NWETLBDAG
- WRITE(UNIT=KULOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=KULOUT,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=KULOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=KULOUT,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=KULOUT,FMT='("PEHG=",E13.6)') ZEHG
- WRITE(UNIT=KULOUT,FMT='("PBG=",E13.6)') XBG
- WRITE(UNIT=KULOUT,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=KULOUT,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=KULOUT,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=KULOUT,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAG_MAX=",E13.6)') &
- XWETLBDAG_MAX
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=KULOUT,FMT='("PWETLBDAG_MIN=",E13.6)') &
- XWETLBDAG_MIN
- WRITE(UNIT=KULOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=KULOUT,FMT='("!")')
- WRITE(UNIT=KULOUT,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
- WRITE(UNIT=KULOUT,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_GWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=KULOUT,FMT='("END IF")')
- ELSE
- CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,XKER_GWETH )
- WRITE(UNIT=KULOUT,FMT='(" Read XKER_GWETH")')
-END IF
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 10. SET-UP RADIATIVE PARAMETERS
-! ---------------------------
-!
-!
-! R_eff_i = XFREFFI * (rho*r_i/N_i)**(1/3)
-!
-XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 11. SOME PRINTS FOR CONTROL
-! -----------------------
-!
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" Summary of the ice particule characteristics")')
- WRITE(UNIT=KULOUT,FMT='(" PRISTINE ICE")')
- WRITE(UNIT=KULOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAI,XBI
- WRITE(UNIT=KULOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XC_I,XDI
- WRITE(UNIT=KULOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAI,XNUI
- WRITE(UNIT=KULOUT,FMT='(" SNOW")')
- WRITE(UNIT=KULOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAS,XBS
- WRITE(UNIT=KULOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCS,XDS
- WRITE(UNIT=KULOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCS,XCXS
- WRITE(UNIT=KULOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAS,XNUS
- WRITE(UNIT=KULOUT,FMT='(" GRAUPEL")')
- WRITE(UNIT=KULOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAG,XBG
- WRITE(UNIT=KULOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCG,XDG
- WRITE(UNIT=KULOUT,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCG,XCXG
- WRITE(UNIT=KULOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAG,XNUG
-END IF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE INI_LIMA_COLD_MIXED
diff --git a/src/arome/micro/init_aerosol_properties.F90 b/src/arome/micro/init_aerosol_properties.F90
deleted file mode 100644
index 06cec3bfa4d198b4f2d7a9f792293ffbff43f4ee..0000000000000000000000000000000000000000
--- a/src/arome/micro/init_aerosol_properties.F90
+++ /dev/null
@@ -1,370 +0,0 @@
-! ####################
- MODULE MODI_INIT_AEROSOL_PROPERTIES
-INTERFACE
- SUBROUTINE INIT_AEROSOL_PROPERTIES
- END SUBROUTINE INIT_AEROSOL_PROPERTIES
-END INTERFACE
-END MODULE MODI_INIT_AEROSOL_PROPERTIES
-! ####################
-!
-! #############################################################
- SUBROUTINE INIT_AEROSOL_PROPERTIES
-! #############################################################
-
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! Define the aerosol properties
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LUNIT, ONLY : ILUOUT, CLUOUT0
-USE MODD_PARAM_LIMA, ONLY : LWARM_LIMA, LACTI_LIMA, NMOD_CCN, HINI_CCN, HTYPE_CCN, &
- XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
- XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
- XLIMIT_FACTOR, CCCN_MODES, LSCAV, &
- XACTEMP_CCN, XFSOLUB_CCN, &
- LCOLD_LIMA, LNUCL_LIMA, NMOD_IFN, NSPECIE, CIFN_SPECIES, &
- XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
- CINT_MIXING, NMOD_IMM, NINDICE_CCN_IMM, NIMM, &
- NPHILLIPS
-!
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-REAL :: XKHEN0
-REAL :: XLOGSIG0
-REAL :: XALPHA1
-REAL :: XMUHEN0
-REAL :: XALPHA2
-REAL :: XBETAHEN0
-REAL :: XR_MEAN0
-REAL :: XALPHA3
-REAL :: XALPHA4
-REAL :: XALPHA5
-REAL :: XACTEMP0
-REAL :: XALPHA6
-!
-REAL, DIMENSION(6) :: XKHEN_TMP = (/1.56, 1.56, 1.56, 1.56, 1.56, 1.56 /)
-REAL, DIMENSION(6) :: XMUHEN_TMP = (/0.80, 0.80, 0.80, 0.80, 0.80, 0.80 /)
-REAL, DIMENSION(6) :: XBETAHEN_TMP= (/136., 136., 136., 136., 136., 136. /)
-!
-REAL, DIMENSION(3) :: RCCN
-REAL, DIMENSION(3) :: LOGSIGCCN
-REAL, DIMENSION(3) :: RHOCCN
-!
-INTEGER :: I,J,JMOD
-!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
-
-!
-!-------------------------------------------------------------------------------
-!
-CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
-!
-!!!!!!!!!!!!!!!!
-! CCN properties
-!!!!!!!!!!!!!!!!
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
-!
- IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
-!
- SELECT CASE (CCCN_MODES)
- CASE ('JUNGFRAU')
- RCCN(:) = (/ 0.02E-6 , 0.058E-6 , 0.763E-6 /)
- LOGSIGCCN(:) = (/ 0.28 , 0.57 , 0.34 /)
- RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
- CASE ('COPT')
- RCCN(:) = (/ 0.125E-6 , 0.4E-6 , 1.0E-6 /)
- LOGSIGCCN(:) = (/ 0.69 , 0.41 , 0.47 /)
- RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
- CASE ('MACC')
- RCCN(:) = (/ 0.4E-6 , 0.25E-6 , 0.1E-6 /)
- LOGSIGCCN(:) = (/ 0.64 , 0.47 , 0.47 /)
- RHOCCN(:) = (/ 2160. , 2000. , 1750. /)
- CASE ('MACC_JPP')
-! sea-salt, sulfate, hydrophilic (GADS data)
- RCCN(:) = (/ 0.209E-6 , 0.0695E-6 , 0.0212E-6 /)
- LOGSIGCCN(:) = (/ 0.708 , 0.708 , 0.806 /)
- RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
- CASE ('SIRTA')
- RCCN(:) = (/ 0.153E-6 , 0.058E-6 , 0.763E-6 /)
- LOGSIGCCN(:) = (/ 0.846 , 0.57 , 0.34 /)
- RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
- CASE ('CPS00')
- RCCN(:) = (/ 0.0218E-6 , 0.058E-6 , 0.763E-6 /)
- LOGSIGCCN(:) = (/ 1.16 , 0.57 , 0.34 /)
- RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
- CASE ('MOCAGE') ! ordre : sulfates, sels marins, BC+O
- RCCN(:) = (/ 0.01E-6 , 0.05E-6 , 0.008E-6 /)
- LOGSIGCCN(:) = (/ 0.788 , 0.993 , 0.916 /)
- RHOCCN(:) = (/ 1000. , 2200. , 1000. /)
- CASE DEFAULT
-! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
- RCCN(:) = (/ 0.0035E-6 , 0.125E-6 , 0.26E-6 /)
- LOGSIGCCN(:) = (/ 0.645 , 0.253 , 0.425 /)
- RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
- ENDSELECT
-!
- DO I=1, MIN(NMOD_CCN,3)
- XR_MEAN_CCN(I) = RCCN(I)
- XLOGSIG_CCN(I) = LOGSIGCCN(I)
- XRHO_CCN(I) = RHOCCN(I)
- END DO
-!
- IF (NMOD_CCN .EQ. 4) THEN
-! default values as coarse sea salt mode
- XR_MEAN_CCN(4) = 1.75E-6
- XLOGSIG_CCN(4) = 0.708
- XRHO_CCN(4) = 2200.
- END IF
-!
-!
-! Compute CCN spectra parameters from CCN characteristics
-!
-!* INPUT : XBETAHEN_TEST is in 'percent' and XBETAHEN_MULTI in 'no units',
-! XK... and XMU... are invariant
-!
- IF (.NOT.(ALLOCATED(XKHEN_MULTI))) ALLOCATE(XKHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XMUHEN_MULTI))) ALLOCATE(XMUHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XBETAHEN_MULTI))) ALLOCATE(XBETAHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
-!
- IF (HINI_CCN == 'CCN'.AND. (.NOT. LSCAV) ) THEN
-! Numerical initialization without dependence on AP physical properties
-100 DO JMOD = 1, NMOD_CCN
- XKHEN_MULTI(JMOD) = XKHEN_TMP(JMOD)
- XMUHEN_MULTI(JMOD) = XMUHEN_TMP(JMOD)
- XBETAHEN_MULTI(JMOD) = XBETAHEN_TMP(JMOD)*(100.)**2
-! no units relative to smax
- XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.)&
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
- /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)) ) ! N/C
- END DO
- ELSE IF (HINI_CCN == 'CCN'.AND. LSCAV ) THEN
-! Attention !
- WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
- ¬ depending on the aerosol properties, however you need it for &
- &scavenging. &
- &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
- go to 100
- ELSE IF (HINI_CCN == 'AER') THEN
-!
-! Initialisation depending on aerosol physical properties
-!
-! First, computing k, mu, beta, and XLIMIT_FACTOR as in CPS2000 (eqs 9a-9c)
-!
-! XLIMIT_FACTOR replaces C, because C depends on the CCN number concentration
-! which is therefore determined at each grid point and time step as
-! Nccn / XLIMIT_FACTOR
-!
- DO JMOD = 1, NMOD_CCN
-!
- SELECT CASE (HTYPE_CCN(JMOD))
- CASE ('M') ! CCN marins
- XKHEN0 = 3.251
- XLOGSIG0 = 0.4835
- XALPHA1 = -1.297
- XMUHEN0 = 2.589
- XALPHA2 = -1.511
- XBETAHEN0 = 621.689
- XR_MEAN0 = 0.133E-6
- XALPHA3 = 3.002
- XALPHA4 = 1.081
- XALPHA5 = 1.0
- XACTEMP0 = 290.16
- XALPHA6 = 2.995
- CASE ('C') ! CCN continentaux
- XKHEN0 = 1.403
- XLOGSIG0 = 1.16
- XALPHA1 = -1.172
- XMUHEN0 = 0.834
- XALPHA2 = -1.350
- XBETAHEN0 = 25.499
- XR_MEAN0 = 0.0218E-6
- XALPHA3 = 3.057
- XALPHA4 = 4.092
- XALPHA5 = 1.011
- XACTEMP0 = 290.16
- XALPHA6 = 3.076
- CASE DEFAULT
- WRITE(UNIT=ILUOUT0,FMT='("You must specify HTYPE_CNN(JMOD)=C or M &
- &in EXSEG1.nam for each CCN mode")')
- CALL ABORT
- ENDSELECT
-!
- XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
- XMUHEN_MULTI(JMOD) = XMUHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA2
- XBETAHEN_MULTI(JMOD)=XBETAHEN0*(XR_MEAN_CCN(JMOD)/XR_MEAN0)**XALPHA3 &
- * EXP( XALPHA4*((XLOGSIG_CCN(JMOD)/XLOGSIG0)-1.) ) &
- * XFSOLUB_CCN**XALPHA5 &
- * (XACTEMP_CCN/XACTEMP0)**XALPHA6
- XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.) &
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
- /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)) )
- ENDDO
-!
-! These parameters are correct for a nucleation spectra
-! Nccn(Smax) = C Smax^k F(mu,k/2,1+k/2,-beta Smax^2)
-! with Smax expressed in % (Smax=1 for a supersaturation of 1%).
-!
-! All the computations in LIMA are done for an adimensional Smax (Smax=0.01 for
-! a 1% supersaturation). So beta and C (XLIMIT_FACTOR) are changed :
-! new_beta = beta * 100^2
-! new_C = C * 100^k (ie XLIMIT_FACTOR = XLIMIT_FACTOR / 100^k)
-!
- XBETAHEN_MULTI(:) = XBETAHEN_MULTI(:) * 10000
- XLIMIT_FACTOR(:) = XLIMIT_FACTOR(:) / (100**XKHEN_MULTI(:))
- END IF
-END IF ! NMOD_CCN > 0
-!
-!!!!!!!!!!!!!!!!
-! IFN properties
-!!!!!!!!!!!!!!!!
-!
-IF ( NMOD_IFN .GE. 1 ) THEN
- SELECT CASE (CIFN_SPECIES)
- CASE ('MOCAGE')
- NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
- XMDIAM_IFN = (/ 0.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
- XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
- XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
- CASE ('MACC_JPP')
-! sea-salt, sulfate, hydrophilic (GADS data)
-! 2 species, dust-metallic and hydrophobic (as BC)
-! (Phillips et al. 2013 and GADS data)
- NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
- XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.025E-6, 0.2E-6/)
- XSIGMA_IFN = (/2.0, 2.15, 2.0, 1.6 /)
- XRHO_IFN = (/2600., 2600., 1000., 1500./)
- CASE DEFAULT
- IF (NPHILLIPS == 8) THEN
-! 4 species, according to Phillips et al. 2008
- NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
- XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.2E-6, 0.2E-6/)
- XSIGMA_IFN = (/1.9, 1.6, 1.6, 1.6 /)
- XRHO_IFN = (/2300., 2300., 1860., 1500./)
- ELSE IF (NPHILLIPS == 13) THEN
-! 4 species, according to Phillips et al. 2013
- NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
- XMDIAM_IFN = (/0.8E-6, 3.0E-6, 90.E-9, 0.163E-6/)
- XSIGMA_IFN = (/1.9, 1.6, 1.6, 2.54 /)
- XRHO_IFN = (/2300., 2300., 1860., 1000./)
- END IF
- ENDSELECT
-!
-! internal mixing
-!
- IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
- XFRAC(:,:)=0.
- SELECT CASE (CINT_MIXING)
- CASE ('DM1')
- XFRAC(1,:)=1.
- CASE ('DM2')
- XFRAC(2,:)=1.
- CASE ('BC')
- XFRAC(3,:)=1.
- CASE ('O')
- XFRAC(4,:)=1.
- CASE ('MACC')
- XFRAC(1,1)=0.99
- XFRAC(2,1)=0.01
- XFRAC(3,1)=0.
- XFRAC(4,1)=0.
- XFRAC(1,2)=0.
- XFRAC(2,2)=0.
- XFRAC(3,2)=0.5
- XFRAC(4,2)=0.5
- CASE ('MACC_JPP')
- XFRAC(1,1)=1.0
- XFRAC(2,1)=0.0
- XFRAC(3,1)=0.0
- XFRAC(4,1)=0.0
- XFRAC(1,2)=0.0
- XFRAC(2,2)=0.0
- XFRAC(3,2)=0.5
- XFRAC(4,2)=0.5
- CASE ('MOCAGE')
- XFRAC(1,1)=1.
- XFRAC(2,1)=0.
- XFRAC(3,1)=0.
- XFRAC(4,1)=0.
- XFRAC(1,2)=0.
- XFRAC(2,2)=0.
- XFRAC(3,2)=0.7
- XFRAC(4,2)=0.3
- CASE DEFAULT
- XFRAC(1,:)=0.6
- XFRAC(2,:)=0.009
- XFRAC(3,:)=0.33
- XFRAC(4,:)=0.06
- ENDSELECT
-!
-! Phillips 08 alpha (table 1)
- IF (.NOT.(ALLOCATED(XFRAC_REF))) ALLOCATE(XFRAC_REF(4))
- IF (NPHILLIPS == 13) THEN
- XFRAC_REF(1)=0.66
- XFRAC_REF(2)=0.66
- XFRAC_REF(3)=0.31
- XFRAC_REF(4)=0.03
- ELSE IF (NPHILLIPS == 8) THEN
- XFRAC_REF(1)=0.66
- XFRAC_REF(2)=0.66
- XFRAC_REF(3)=0.28
- XFRAC_REF(4)=0.06
- END IF
-!
-! Immersion modes
-!
- IF (.NOT.(ALLOCATED(NIMM))) ALLOCATE(NIMM(NMOD_CCN))
- NIMM(:)=0
- IF (ALLOCATED(NINDICE_CCN_IMM)) DEALLOCATE(NINDICE_CCN_IMM)
- ALLOCATE(NINDICE_CCN_IMM(MAX(1,NMOD_IMM)))
- IF (NMOD_IMM .GE. 1) THEN
- DO J = 0, NMOD_IMM-1
- NIMM(NMOD_CCN-J)=1
- NINDICE_CCN_IMM(NMOD_IMM-J) = NMOD_CCN-J
- END DO
-! ELSE IF (NMOD_IMM == 0) THEN ! PNIS existe mais vaut 0, pour l'appel à resolved_cloud
-! NMOD_IMM = 1
-! NINDICE_CCN_IMM(1) = 0
- END IF
-!
-END IF ! NMOD_IFN > 0
-!
-END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/arome/micro/lima.F90 b/src/arome/micro/lima.F90
deleted file mode 100644
index a96c98099c5846f08e8e395d74c36031ad50bdcb..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima.F90
+++ /dev/null
@@ -1,1806 +0,0 @@
-! ######spl
-MODULE MODI_LIMA
-! ####################
-!
-INTERFACE
-!
-SUBROUTINE LIMA ( PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PTHM, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, &
- KSPLITR, KSPLITG, YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of output
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Layer thikness (m)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-INTEGER, INTENT(IN) :: NCCN ! for array size declarations
-INTEGER, INTENT(IN) :: NIFN ! for array size declarations
-INTEGER, INTENT(IN) :: NIMM ! for array size declarations
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations sources
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
-!
-INTEGER, INTENT(IN) :: KSPLITR
-INTEGER, INTENT(IN) :: KSPLITG
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA
-END INTERFACE
-END MODULE MODI_LIMA
-!
-!
-! ######spl
- SUBROUTINE LIMA ( PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PTHM, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, &
- KSPLITR, KSPLITG, YDDDH, YDLDDH, YDMDDH )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! Compute explicit microphysical sources using the 2-moment scheme LIMA
-!!
-!! REFERENCE
-!! ---------
-!! Vié et al. (GMD, 2016)
-!! Meso-NH scientific documentation
-!!
-!! AUTHOR
-!! ------
-!! B. Vié
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/??
-!!
-!!
-!!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_PARAM_ICE, ONLY : NMAXITER, LFEEDBACKT,XMRSTEP, XTSTEP_TS
-USE MODD_PARAM_LIMA, ONLY : LCOLD_LIMA, LRAIN_LIMA, LWARM_LIMA, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI_LIMA, &
- XRTMIN, LACTIT_LIMA, &
- LSEDC_LIMA, LSEDI_LIMA, XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM,ONLY : XLBC, XLBEXC
-USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_SCAVMASS, NSV_LIMA_NI, NSV_LIMA_IFN_FREE, &
- NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_CST, ONLY : XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT
-!
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_WARM_SEDIMENTATION
-USE MODI_LIMA_COLD_SEDIMENTATION
-USE MODI_LIMA_NUCLEATION_PROCS
-USE MODI_LIMA_INST_PROCS
-USE MODI_LIMA_TENDENCIES
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of output
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Layer thikness (m)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-INTEGER, INTENT(IN) :: NCCN ! for array size declarations
-INTEGER, INTENT(IN) :: NIFN ! for array size declarations
-INTEGER, INTENT(IN) :: NIMM ! for array size declarations
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations sources
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
-!
-INTEGER, INTENT(IN) :: KSPLITR
-INTEGER, INTENT(IN) :: KSPLITG
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-!
-! Prognostic variables and sources
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCT, ZCRT, ZCIT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTHS, ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCS, ZCRS, ZCIS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFT, ZCCNAT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFS, ZCCNAS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFT, ZIFNNT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFS, ZIFNNS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFS
-
-!
-! for each process & species, we need variables to store instant tendencies for hydrometeors
-! These are 1D packed variables
-REAL, DIMENSION(:), ALLOCATABLE :: &
-! mixing ratio & concentration changes by instantaneous processes (kg/kg and #/kg) :
- Z_RC_HENU, Z_CC_HENU, & ! cloud droplet nucleation (HENU) : rc, Nc, rv=-rc, th, CCNF, CCNA
- Z_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- Z_RI_HIND, Z_CI_HIND, & ! heterogeneous IFN nucleation (HIND) : rv=-ri, ri, Ni, th, IFNF, IFNN
- Z_RC_HINC, Z_CC_HINC, & ! heterogeneous coated IFN nucl. (HINC) : rc, Nc, ri=-rc, Ni=-Nc, th, CCNacti, CCNnucl
- Z_RI_HONH, Z_CI_HONH, & ! CCN homogeneous freezing (HONH) : ri, Ni, th, CCNF
- Z_TH_HONR, Z_RR_HONR, Z_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- Z_TH_IMLT, Z_RC_IMLT, Z_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
-! mixing ratio & concentration tendencies by continuous processes (kg/kg/s and #/kg/s) :
- Z_TH_HONC, Z_RC_HONC, Z_CC_HONC, & ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
- Z_CC_SELF, & ! self collection of droplets (SELF) : Nc
- Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, & ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
- Z_RC_ACCR, Z_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
- Z_CR_SCBU, & ! self collectio break up of drops (SCBU) : Nr
- Z_TH_EVAP, Z_RC_EVAP, Z_CC_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
- Z_RI_CNVI, Z_CI_CNVI, & ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
- Z_TH_DEPS, Z_RS_DEPS, & ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
- Z_RI_CNVS, Z_CI_CNVS, & ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
- Z_RI_AGGS, Z_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
- Z_TH_DEPG, Z_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
- Z_TH_BERFI, Z_RC_BERFI, & ! Bergeron (BERFI) : rc, ri=-rc, th
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_RG_RIM,& ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
- Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, & ! hallett mossop snow (HMS) : ri, Ni, rs
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
- Z_RS_CMEL, & ! conversion-melting (CMEL) : rs, rg=-rs
- Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, & ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
- Z_TH_WETG, Z_RC_WETG, Z_CC_WETG, Z_RR_WETG, Z_CR_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_RI_WETG, Z_CI_WETG, Z_RS_WETG, Z_RG_WETG, Z_RH_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_TH_DRYG, Z_RC_DRYG, Z_CC_DRYG, Z_RR_DRYG, Z_CR_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
- Z_RI_DRYG, Z_CI_DRYG, Z_RS_DRYG, Z_RG_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
- Z_RI_HMG, Z_CI_HMG, Z_RG_HMG, & ! hallett mossop graupel (HMG) : ri, Ni, rg
- Z_TH_GMLT, Z_RR_GMLT, Z_CR_GMLT, & ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
- Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
- Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
-!
-!
-! for each process & species, we need variables to store total mmr and conc change (kg/kg and #/kg and theta)
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
-! instantaneous processes :
- ZTOT_RC_HENU, ZTOT_CC_HENU, & ! cloud droplet nucleation (HENU) : rc, Nc, rv=-rc, th, CCNF, CCNA
- ZTOT_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- ZTOT_RI_HIND, ZTOT_CI_HIND, & ! heterogeneous IFN nucleation (HIND) : rv=-ri, ri, Ni, th, IFNF, IFNN
- ZTOT_RC_HINC, ZTOT_CC_HINC, & ! heterogeneous coated IFN nucl. (HINC) : rc, Nc, ri=-rc, Ni=-Nc, th, CCNacti, CCNnucl
- ZTOT_RI_HONH, ZTOT_CI_HONH, & ! CCN homogeneous freezing (HONH) : ri, Ni, th, CCNF
- ZTOT_TH_HONR, ZTOT_RR_HONR, ZTOT_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- ZTOT_TH_IMLT, ZTOT_RC_IMLT, ZTOT_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
-! continuous processes :
- ZTOT_TH_HONC, ZTOT_RC_HONC, ZTOT_CC_HONC, & ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
- ZTOT_CC_SELF, & ! self collection of droplets (SELF) : Nc
- ZTOT_RC_AUTO, ZTOT_CC_AUTO, ZTOT_CR_AUTO, & ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
- ZTOT_RC_ACCR, ZTOT_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
- ZTOT_CR_SCBU, & ! self collectio break up of drops (SCBU) : Nr
- ZTOT_TH_EVAP, ZTOT_RC_EVAP, ZTOT_CC_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
- ZTOT_RI_CNVI, ZTOT_CI_CNVI, & ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
- ZTOT_TH_DEPS, ZTOT_RS_DEPS, & ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
- ZTOT_RI_CNVS, ZTOT_CI_CNVS, & ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
- ZTOT_RI_AGGS, ZTOT_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
- ZTOT_TH_DEPG, ZTOT_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
- ZTOT_TH_BERFI, ZTOT_RC_BERFI, & ! Bergeron (BERFI) : rc, ri=-rc, th
- ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
- ZTOT_RI_HMS, ZTOT_CI_HMS, ZTOT_RS_HMS, & ! hallett mossop snow (HMS) : ri, Ni, rs
- ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
- ZTOT_RS_CMEL, & ! conversion-melting (CMEL) : rs, rg=-rs
- ZTOT_TH_CFRZ, ZTOT_RR_CFRZ, ZTOT_CR_CFRZ, ZTOT_RI_CFRZ, ZTOT_CI_CFRZ, & ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
- ZTOT_TH_WETG, ZTOT_RC_WETG, ZTOT_CC_WETG, ZTOT_RR_WETG, ZTOT_CR_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
- ZTOT_RI_WETG, ZTOT_CI_WETG, ZTOT_RS_WETG, ZTOT_RG_WETG, ZTOT_RH_WETG, & ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
- ZTOT_TH_DRYG, ZTOT_RC_DRYG, ZTOT_CC_DRYG, ZTOT_RR_DRYG, ZTOT_CR_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
- ZTOT_RI_DRYG, ZTOT_CI_DRYG, ZTOT_RS_DRYG, ZTOT_RG_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
- ZTOT_RI_HMG, ZTOT_CI_HMG, ZTOT_RG_HMG, & ! hallett mossop graupel (HMG) : ri, Ni, rg
- ZTOT_TH_GMLT, ZTOT_RR_GMLT, ZTOT_CR_GMLT, & ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
- ZTOT_RC_WETH, ZTOT_CC_WETH, ZTOT_RR_WETH, ZTOT_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- ZTOT_RI_WETH, ZTOT_CI_WETH, ZTOT_RS_WETH, ZTOT_RG_WETH, ZTOT_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- ZTOT_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
- ZTOT_RR_HMLT, ZTOT_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
-!
-!
-! concentration changes by instantaneous processes (#/kg) (instant + total):
-! Unused so far, necessary if we want detailed budgets of aerosols
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: &
-!!$ Z_CCNF_HENU, ZTOT_CCNF_HENU, & ! cloud droplet nucleation (HENU) : rc, Nc, rv=-rc, th, CCNF, CCNA=-CCNF
-!!$ Z_CCNA_HINC, ZTOT_CCNA_HINC, & ! heterogeneous coated IFN nucl. (HINC) : rc, Nc, ri=-rc, Ni=-Nc, th, CCNacti, CCNnucl=-CCNacti
-!!$ Z_CCNF_HONH, ZTOT_CCNF_HONH ! CCN homogeneous freezing (HONH) : ri, Ni, th, CCNF
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: &
-!!$ Z_IFNF_HIND, ZTOT_IFNF_HIND, & ! heterogeneous IFN nucleation (HIND) : rv=-ri, ri, Ni, th, IFNF, IFNN=-IFNF
-!!$ Z_IFNF_IMLT, ZTOT_IFNF_IMLT ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA=-IFNF
-!
-!
-!For mixing-ratio splitting
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
- Z0RCT, Z0CCT, & ! Cloud water m.r. at the beginig of the current loop
- Z0RRT, Z0CRT, & ! Rain water m.r. at the beginig of the current loop
- Z0RIT, Z0CIT, & ! Pristine ice m.r. at the beginig of the current loop
- Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- Z0RHT ! Hail m.r. at the beginig of the current loop
-! Unused, necessary if concentration splitting
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: Z0CCNFT, Z0CCNAT
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: Z0IFNFT, Z0IFNNT
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: Z0IMMNT
-!!$REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: Z0HOMFT
-!
-! Packed variables for total tendencies
-REAL, DIMENSION(:), ALLOCATABLE :: &
- ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, ZA_RI, ZA_CI, ZA_RS, ZA_RG, ZA_RH, & ! ZA = continuous tendencies (kg/kg/s = S variable)
- ZB_TH, ZB_RV, ZB_RC, ZB_CC, ZB_RR, ZB_CR, ZB_RI, ZB_CI, ZB_RS, ZB_RG, ZB_RH ! ZB = instant mixing ratio change (kg/kg = T variable)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZB_IFNN
-!
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- IITER, & ! Number of iterations done (with real tendencies computation)
- ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
-! ZMAXTIME, & ! Time on which we can apply the current tendencies
-! ZTIME_THRESHOLD, & ! Time to reach threshold
- ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- LLCOMPUTE ! Points where we must compute tendencies
-REAL, DIMENSION(:), ALLOCATABLE :: ZMAXTIME, ZTIME_THRESHOLD
-!
-!
-! Various parameters
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IIT !
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IJT !
-INTEGER :: IKB, IKTB, IKT!
-INTEGER :: IKE, IKTE !
-INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-!
-REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
-REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-!
-!
-! For total tendencies computation
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- ZW_RVS, &
- ZW_RCS, ZW_CCS, &
- ZW_RRS, ZW_CRS, &
- ZW_RIS, ZW_CIS, &
- ZW_RSS, &
- ZW_RGS, &
- ZW_RHS, &
- ZW_THS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZW_CCNFS, ZW_CCNAS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZW_IFNFS, ZW_IFNNS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZW_IMMNS
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZW_HOMFS
-!
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- PEXN, &
- PDZZ, &
- ZEXN, &
- ZT, &
- ZTM, &
- ZZ_LSFACT, &
- ZZ_LVFACT, &
- ZZT, &
- ZLSFACT, &
- ZLVFACT, &
- ZW1, &
- ZLBDC
-!
-INTEGER :: KRR, &
- KKA, & ! near ground array index
- KKU, & ! highest level array index
- KKL, & ! levels ordering (=1 for MNH, =-1 for AROME)
- II ! index for loops
-!
-LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: MASK ! Points where we must run the microphysics scheme
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZRT_SUM ! Total condensed water mr
-INTEGER :: IPACK
-INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
-REAL, DIMENSION(:), ALLOCATABLE :: &
- ZTHT1D, &
- ZRVT1D, &
- ZRCT1D, &
- ZRRT1D, &
- ZRIT1D, &
- ZRST1D, &
- ZRGT1D, &
- ZRHT1D, &
- ZCCT1D, &
- ZCRT1D, &
- ZCIT1D, &
- ZP1D, &
- ZRHODREF1D, &
- ZEXNREF1D, &
- ZEXN1D, &
- ZEVAP1D, &
- ZTIME1D, &
- IITER1D, &
- ZTIME_LASTCALL1D, &
- Z0RVT1D, &
- Z0RCT1D, &
- Z0RRT1D, &
- Z0RIT1D, &
- Z0RST1D, &
- Z0RGT1D, &
- Z0RHT1D
-LOGICAL, DIMENSION(:), ALLOCATABLE :: LLCOMPUTE1D
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFNN1D
-!-------------------------------------------------------------------------------
-!
-!* 0. Init
-! ----
-!
-ZTHS(:,:,:) = PTHS(:,:,:)
-ZTHT(:,:,:) = PTHS(:,:,:) * PTSTEP
-ZRVT(:,:,:) = 0.
-ZRVS(:,:,:) = 0.
-ZRCT(:,:,:) = 0.
-ZRCS(:,:,:) = 0.
-ZRRT(:,:,:) = 0.
-ZRRS(:,:,:) = 0.
-ZRIT(:,:,:) = 0.
-ZRIS(:,:,:) = 0.
-ZRST(:,:,:) = 0.
-ZRSS(:,:,:) = 0.
-ZRGT(:,:,:) = 0.
-ZRGS(:,:,:) = 0.
-ZRHT(:,:,:) = 0.
-ZRHS(:,:,:) = 0.
-ZRT_SUM(:,:,:) = 0.
-ZCCT(:,:,:) = 0.
-ZCCS(:,:,:) = 0.
-ZCRT(:,:,:) = 0.
-ZCRS(:,:,:) = 0.
-ZCIT(:,:,:) = 0.
-ZCIS(:,:,:) = 0.
-ZCCNFT(:,:,:,:) = 0.
-ZCCNAT(:,:,:,:) = 0.
-ZCCNFS(:,:,:,:) = 0.
-ZCCNAS(:,:,:,:) = 0.
-ZIFNFT(:,:,:,:) = 0.
-ZIFNNT(:,:,:,:) = 0.
-ZIFNFS(:,:,:,:) = 0.
-ZIFNNS(:,:,:,:) = 0.
-ZIMMNT(:,:,:,:) = 0.
-ZIMMNS(:,:,:,:) = 0.
-ZHOMFT(:,:,:) = 0.
-ZHOMFS(:,:,:) = 0.
-
-IF(LBU_ENABLE) THEN
- ZTOT_CR_BRKU(:,:,:) = 0.
- ZTOT_TH_HONR(:,:,:) = 0.
- ZTOT_RR_HONR(:,:,:) = 0.
- ZTOT_CR_HONR(:,:,:) = 0.
- ZTOT_TH_IMLT(:,:,:) = 0.
- ZTOT_RC_IMLT(:,:,:) = 0.
- ZTOT_CC_IMLT(:,:,:) = 0.
- ZTOT_TH_HONC(:,:,:) = 0.
- ZTOT_RC_HONC(:,:,:) = 0.
- ZTOT_CC_HONC(:,:,:) = 0.
- ZTOT_CC_SELF(:,:,:) = 0.
- ZTOT_RC_AUTO(:,:,:) = 0.
- ZTOT_CC_AUTO(:,:,:) = 0.
- ZTOT_CR_AUTO(:,:,:) = 0.
- ZTOT_RC_ACCR(:,:,:) = 0.
- ZTOT_CC_ACCR(:,:,:) = 0.
- ZTOT_CR_SCBU(:,:,:) = 0.
- ZTOT_TH_EVAP(:,:,:) = 0.
- ZTOT_RC_EVAP(:,:,:) = 0.
- ZTOT_CC_EVAP(:,:,:) = 0.
- ZTOT_RR_EVAP(:,:,:) = 0.
- ZTOT_CR_EVAP(:,:,:) = 0.
- ZTOT_RI_CNVI(:,:,:) = 0.
- ZTOT_CI_CNVI(:,:,:) = 0.
- ZTOT_TH_DEPS(:,:,:) = 0.
- ZTOT_RS_DEPS(:,:,:) = 0.
- ZTOT_RI_CNVS(:,:,:) = 0.
- ZTOT_CI_CNVS(:,:,:) = 0.
- ZTOT_RI_AGGS(:,:,:) = 0.
- ZTOT_CI_AGGS(:,:,:) = 0.
- ZTOT_TH_DEPG(:,:,:) = 0.
- ZTOT_RG_DEPG(:,:,:) = 0.
- ZTOT_TH_BERFI(:,:,:) = 0.
- ZTOT_RC_BERFI(:,:,:) = 0.
- ZTOT_TH_RIM(:,:,:) = 0.
- ZTOT_RC_RIM(:,:,:) = 0.
- ZTOT_CC_RIM(:,:,:) = 0.
- ZTOT_RS_RIM(:,:,:) = 0.
- ZTOT_RG_RIM(:,:,:) = 0.
- ZTOT_RI_HMS(:,:,:) = 0.
- ZTOT_CI_HMS(:,:,:) = 0.
- ZTOT_RS_HMS(:,:,:) = 0.
- ZTOT_TH_ACC(:,:,:) = 0.
- ZTOT_RR_ACC(:,:,:) = 0.
- ZTOT_CR_ACC(:,:,:) = 0.
- ZTOT_RS_ACC(:,:,:) = 0.
- ZTOT_RG_ACC(:,:,:) = 0.
- ZTOT_RS_CMEL(:,:,:) = 0.
- ZTOT_TH_CFRZ(:,:,:) = 0.
- ZTOT_RR_CFRZ(:,:,:) = 0.
- ZTOT_CR_CFRZ(:,:,:) = 0.
- ZTOT_RI_CFRZ(:,:,:) = 0.
- ZTOT_CI_CFRZ(:,:,:) = 0.
- ZTOT_TH_WETG(:,:,:) = 0.
- ZTOT_RC_WETG(:,:,:) = 0.
- ZTOT_CC_WETG(:,:,:) = 0.
- ZTOT_RR_WETG(:,:,:) = 0.
- ZTOT_CR_WETG(:,:,:) = 0.
- ZTOT_RI_WETG(:,:,:) = 0.
- ZTOT_CI_WETG(:,:,:) = 0.
- ZTOT_RS_WETG(:,:,:) = 0.
- ZTOT_RG_WETG(:,:,:) = 0.
- ZTOT_RH_WETG(:,:,:) = 0.
- ZTOT_TH_DRYG(:,:,:) = 0.
- ZTOT_RC_DRYG(:,:,:) = 0.
- ZTOT_CC_DRYG(:,:,:) = 0.
- ZTOT_RR_DRYG(:,:,:) = 0.
- ZTOT_CR_DRYG(:,:,:) = 0.
- ZTOT_RI_DRYG(:,:,:) = 0.
- ZTOT_CI_DRYG(:,:,:) = 0.
- ZTOT_RS_DRYG(:,:,:) = 0.
- ZTOT_RG_DRYG(:,:,:) = 0.
- ZTOT_RI_HMG(:,:,:) = 0.
- ZTOT_CI_HMG(:,:,:) = 0.
- ZTOT_RG_HMG(:,:,:) = 0.
- ZTOT_TH_GMLT(:,:,:) = 0.
- ZTOT_RR_GMLT(:,:,:) = 0.
- ZTOT_CR_GMLT(:,:,:) = 0.
- ZTOT_RC_WETH(:,:,:) = 0.
- ZTOT_CC_WETH(:,:,:) = 0.
- ZTOT_RR_WETH(:,:,:) = 0.
- ZTOT_CR_WETH(:,:,:) = 0.
- ZTOT_RI_WETH(:,:,:) = 0.
- ZTOT_CI_WETH(:,:,:) = 0.
- ZTOT_RS_WETH(:,:,:) = 0.
- ZTOT_RG_WETH(:,:,:) = 0.
- ZTOT_RH_WETH(:,:,:) = 0.
- ZTOT_RG_COHG(:,:,:) = 0.
- ZTOT_RR_HMLT(:,:,:) = 0.
- ZTOT_CR_HMLT(:,:,:) = 0.
-END IF
-!
-! Initial values computed as source * PTSTEP
-!
-! Mixing ratios
-!
-KRR=SIZE(PRT,4)
-ZRVT(:,:,:) = PRS(:,:,:,1) * PTSTEP
-ZRVS(:,:,:) = PRS(:,:,:,1)
-IF ( KRR .GE. 2 ) ZRCT(:,:,:) = PRS(:,:,:,2) * PTSTEP
-IF ( KRR .GE. 2 ) ZRCS(:,:,:) = PRS(:,:,:,2)
-IF ( KRR .GE. 3 ) ZRRT(:,:,:) = PRS(:,:,:,3) * PTSTEP
-IF ( KRR .GE. 3 ) ZRRS(:,:,:) = PRS(:,:,:,3)
-IF ( KRR .GE. 4 ) ZRIT(:,:,:) = PRS(:,:,:,4) * PTSTEP
-IF ( KRR .GE. 4 ) ZRIS(:,:,:) = PRS(:,:,:,4)
-IF ( KRR .GE. 5 ) ZRST(:,:,:) = PRS(:,:,:,5) * PTSTEP
-IF ( KRR .GE. 5 ) ZRSS(:,:,:) = PRS(:,:,:,5)
-IF ( KRR .GE. 6 ) ZRGT(:,:,:) = PRS(:,:,:,6) * PTSTEP
-IF ( KRR .GE. 6 ) ZRGS(:,:,:) = PRS(:,:,:,6)
-IF ( KRR .GE. 7 ) ZRHT(:,:,:) = PRS(:,:,:,7) * PTSTEP
-IF ( KRR .GE. 7 ) ZRHS(:,:,:) = PRS(:,:,:,7)
-ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
-!
-! Concentrations
-!
-IF ( LWARM_LIMA ) ZCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC) * PTSTEP
-IF ( LWARM_LIMA ) ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) ZCRT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR) * PTSTEP
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) ZCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD_LIMA ) ZCIT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI) * PTSTEP
-IF ( LCOLD_LIMA ) ZCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-!
-IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
-IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-!
-IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
-IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-!
-IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
-IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-!
-IF ( LCOLD_LIMA .AND. LHHONI_LIMA ) ZHOMFT(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE) * PTSTEP
-IF ( LCOLD_LIMA .AND. LHHONI_LIMA ) ZHOMFS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Sedimentation
-! -------------
-!
-PEXN(:,:,:)=PEXNREF(:,:,:)
-ZEXN(:,:,:)=PEXNREF(:,:,:)
-ZT(:,:,:) = ZTHT(:,:,:) * PEXN(:,:,:)
-!
-ZW1(:,:,:)=0.
-ZLBDC(:,:,:) = 1.E10
-WHERE (ZRCT(:,:,:)>XRTMIN(2) .AND. ZCCT(:,:,:)>XCTMIN(2))
- ZLBDC(:,:,:) = XLBC*ZCCT(:,:,:) / ZRCT(:,:,:)
- ZLBDC(:,:,:) = ZLBDC(:,:,:)**XLBEXC
-END WHERE
-CALL LIMA_WARM_SEDIMENTATION (LSEDC_LIMA, KSPLITR, PTSTEP, 1, &
- HFMFILE, 'DUMMY', OCLOSE_OUT, &
- PZZ, PRHODREF, PPABST, ZT, &
- ZLBDC, &
- ZRCT, ZRRT, ZCCT, ZCRT, &
- ZRCS, ZRRS, ZCCS, ZCRS, &
- PINPRC, PINPRR, &
- ZW1 )
-!
-CALL LIMA_COLD_SEDIMENTATION (LSEDI_LIMA, KSPLITG, PTSTEP, 1, &
- HFMFILE, 'DUMMY', OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, &
- ZRIT, ZCIT, &
- ZRIS, ZRSS, ZRGS, ZRHS, ZCIS, &
- PINPRS, PINPRG, &
- PINPRH )
-!
-IF ( KRR .GE. 2 ) ZRCT(:,:,:) = ZRCS(:,:,:) * PTSTEP
-IF ( KRR .GE. 3 ) ZRRT(:,:,:) = ZRRS(:,:,:) * PTSTEP
-IF ( KRR .GE. 4 ) ZRIT(:,:,:) = ZRIS(:,:,:) * PTSTEP
-IF ( KRR .GE. 5 ) ZRST(:,:,:) = ZRSS(:,:,:) * PTSTEP
-IF ( KRR .GE. 6 ) ZRGT(:,:,:) = ZRGS(:,:,:) * PTSTEP
-IF ( KRR .GE. 7 ) ZRHT(:,:,:) = ZRHS(:,:,:) * PTSTEP
-ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
-!
-IF ( LWARM_LIMA ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
-IF ( LCOLD_LIMA ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
-!
-! Call budgets
-!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_RC .AND. LSEDC_LIMA) CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI .AND. LSEDI_LIMA) CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- IF (LSEDC_LIMA) CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LRAIN_LIMA) CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LSEDI_LIMA) CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Nucleation processes
-! --------------------
-!
-!
-IF( LACTIT_LIMA ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * PEXN(:,:,:)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
-!
-CALL LIMA_NUCLEATION_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXN, PPABST, ZT, ZTM, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, &
- ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT,YDDDH, YDLDDH, YDMDDH )
-ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
-!
-! Saving sources before microphysics time-splitting loop
-!
-ZRCS(:,:,:) = ZRCT(:,:,:) / PTSTEP
-ZRRS(:,:,:) = ZRRT(:,:,:) / PTSTEP
-ZRIS(:,:,:) = ZRIT(:,:,:) / PTSTEP
-ZRSS(:,:,:) = ZRST(:,:,:) / PTSTEP
-ZRGS(:,:,:) = ZRGT(:,:,:) / PTSTEP
-ZRHS(:,:,:) = ZRHT(:,:,:) / PTSTEP
-!
-ZCCS(:,:,:) = ZCCT(:,:,:) / PTSTEP
-ZCRS(:,:,:) = ZCRT(:,:,:) / PTSTEP
-ZCIS(:,:,:) = ZCIT(:,:,:) / PTSTEP
-!
-ZCCNFS(:,:,:,:) = ZCCNFS(:,:,:,:) / PTSTEP
-ZCCNAS(:,:,:,:) = ZCCNAS(:,:,:,:) / PTSTEP
-ZIFNFS(:,:,:,:) = ZIFNFS(:,:,:,:) / PTSTEP
-ZIFNNS(:,:,:,:) = ZIFNNS(:,:,:,:) / PTSTEP
-ZIMMNS(:,:,:,:) = ZIMMNS(:,:,:,:) / PTSTEP
-ZHOMFS(:,:,:) = ZHOMFS(:,:,:) / PTSTEP
-!
-ZTHS(:,:,:) = ZTHT(:,:,:) / PTSTEP
-!
-!
-!* 1. PREPARE COMPUTATIONS
-! -----------------------
-!
-!
-PDZZ(:,:,:)=PZZ(:,:,:)
-KKA=1
-KKU=SIZE(PDZZ,3)
-KKL=1
-!
-IIB=1+JPHEXT
-IIE=SIZE(PDZZ,1) - JPHEXT
-IIT=SIZE(PDZZ,1)
-IJB=1+JPHEXT
-IJE=SIZE(PDZZ,2) - JPHEXT
-IJT=SIZE(PDZZ,2)
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
-IKT=SIZE(PDZZ,3)
-IKTB=1+JPVEXT
-IKTE=IKT-JPVEXT
-!
-ZINV_TSTEP=1./PTSTEP
-!
-PEXN(:,:,:)=PEXNREF(:,:,:)
-ZEXN(:,:,:)=PEXNREF(:,:,:)
-!ZTHT(:,:,:)=PTHT(:,:,:)
-!
-!ZT(:,:,:) = PTHT(:,:,:) * PEXN(:,:,:)
-!!$IF( LACTIT_LIMA ) THEN
-!!$ ZTM(:,:,:) = PTHM(:,:,:) * PEXN(:,:,:)
-!!$ELSE
-!!$ ZTM(:,:,:) = ZT(:,:,:)
-!!$END IF
-! LSFACT and LVFACT without exner
-ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRT(:,:,:,1) + XCL*(SUM(PRT(:,:,:,2:3),4)) &
- + XCI*(SUM(PRT(:,:,:,4:),4)))
-ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRT(:,:,:,1) + XCL*(SUM(PRT(:,:,:,2:3),4)) &
- + XCI*(SUM(PRT(:,:,:,4:),4)))
-!
-! Setting everything at 0
-!
-
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. LOOP
-! ----
-!
-!
-! Maximum number of iterations
-INB_ITER_MAX=NMAXITER
-IF(XTSTEP_TS/=0.)THEN
- INB_ITER_MAX=MAX(1, INT(PTSTEP/XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
- ZTSTEP=PTSTEP/INB_ITER_MAX
- INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !Fot the case XMRSTEP/=0. at the same time
-ENDIF
-IITER(:,:,:)=0
-ZTIME(:,:,:)=0. ! Current integration time (all points may have a different integration time)
-!
-! Begin the huge time splitting loop
-!
-WHERE (ZRT_SUM(:,:,:)<XRTMIN(2)) ZTIME(:,:,:)=PTSTEP ! no need to treat hydrometeor-free point
-!
-DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
- !
- IF(XMRSTEP/=0.) THEN
- ! In this case we need to remember the mixing ratios used to compute the tendencies
- ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- Z0RVT(:,:,:)=ZRVT(:,:,:)
- Z0RCT(:,:,:)=ZRCT(:,:,:)
- Z0CCT(:,:,:)=ZCCT(:,:,:)
- Z0RRT(:,:,:)=ZRRT(:,:,:)
- Z0CRT(:,:,:)=ZCRT(:,:,:)
- Z0RIT(:,:,:)=ZRIT(:,:,:)
- Z0CIT(:,:,:)=ZCIT(:,:,:)
- Z0RST(:,:,:)=ZRST(:,:,:)
- Z0RGT(:,:,:)=ZRGT(:,:,:)
- Z0RHT(:,:,:)=ZRHT(:,:,:)
-!!$ Z0CCNFT(:,:,:,:) = ZCCNFT(:,:,:,:)
-!!$ Z0CCNAT(:,:,:,:) = ZCCNAT(:,:,:,:)
-!!$ Z0IFNFT(:,:,:,:) = ZIFNFT(:,:,:,:)
-!!$ Z0IFNNT(:,:,:,:) = ZIFNNT(:,:,:,:)
-!!$ Z0IMMNT(:,:,:,:) = ZIMMNT(:,:,:,:)
-!!$ Z0HOMFT(:,:,:) = ZHOMFT(:,:,:)
- ENDIF
- !
- IF(XTSTEP_TS/=0.) THEN
- ! In this case we need to remember the time when tendencies were computed
- ! because when time has evolved more than a limit, we must re-compute tendecies
- ZTIME_LASTCALL(:,:,:)=ZTIME(:,:,:)
- ENDIF
- !
- LLCOMPUTE(:,:,:)=.FALSE.
- LLCOMPUTE(IIB:IIE,IJB:IJE,IKB:IKE) = ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
- WHERE(LLCOMPUTE(:,:,:))
- IITER(:,:,:)=IITER(:,:,:)+1
- END WHERE
- !
- DO WHILE(ANY(LLCOMPUTE(:,:,:))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
-
- !
- ! Packing variables to run computations only where necessary
- !
- IPACK = COUNT(LLCOMPUTE)
- ALLOCATE(I1(IPACK))
- ALLOCATE(I2(IPACK))
- ALLOCATE(I3(IPACK))
- ALLOCATE(ZRHODREF1D(IPACK))
- ALLOCATE(ZEXNREF1D(IPACK))
- ALLOCATE(ZEXN1D(IPACK))
- ALLOCATE(ZP1D(IPACK))
- ALLOCATE(ZTHT1D(IPACK))
- ALLOCATE(ZRVT1D(IPACK))
- ALLOCATE(ZRCT1D(IPACK))
- ALLOCATE(ZRRT1D(IPACK))
- ALLOCATE(ZRIT1D(IPACK))
- ALLOCATE(ZRST1D(IPACK))
- ALLOCATE(ZRGT1D(IPACK))
- ALLOCATE(ZRHT1D(IPACK))
- ALLOCATE(ZCCT1D(IPACK))
- ALLOCATE(ZCRT1D(IPACK))
- ALLOCATE(ZCIT1D(IPACK))
- ALLOCATE(ZIFNN1D(IPACK,NMOD_IFN))
- ALLOCATE(ZEVAP1D(IPACK))
- ALLOCATE(ZTIME1D(IPACK))
- ALLOCATE(LLCOMPUTE1D(IPACK))
- ALLOCATE(IITER1D(IPACK))
- ALLOCATE(ZTIME_LASTCALL1D(IPACK))
- ALLOCATE(Z0RVT1D(IPACK))
- ALLOCATE(Z0RCT1D(IPACK))
- ALLOCATE(Z0RRT1D(IPACK))
- ALLOCATE(Z0RIT1D(IPACK))
- ALLOCATE(Z0RST1D(IPACK))
- ALLOCATE(Z0RGT1D(IPACK))
- ALLOCATE(Z0RHT1D(IPACK))
- IPACK = COUNTJV(LLCOMPUTE,I1,I2,I3)
- DO II=1,IPACK
- ZRHODREF1D(II) = PRHODREF(I1(II),I2(II),I3(II))
- ZEXNREF1D(II) = PEXNREF(I1(II),I2(II),I3(II))
- ZEXN1D(II) = ZEXN(I1(II),I2(II),I3(II))
- ZP1D(II) = PPABST(I1(II),I2(II),I3(II))
- ZTHT1D(II) = ZTHT(I1(II),I2(II),I3(II))
- ZRVT1D(II) = ZRVT(I1(II),I2(II),I3(II))
- ZRCT1D(II) = ZRCT(I1(II),I2(II),I3(II))
- ZRRT1D(II) = ZRRT(I1(II),I2(II),I3(II))
- ZRIT1D(II) = ZRIT(I1(II),I2(II),I3(II))
- ZRST1D(II) = ZRST(I1(II),I2(II),I3(II))
- ZRGT1D(II) = ZRGT(I1(II),I2(II),I3(II))
- ZRHT1D(II) = ZRHT(I1(II),I2(II),I3(II))
- ZCCT1D(II) = ZCCT(I1(II),I2(II),I3(II))
- ZCRT1D(II) = ZCRT(I1(II),I2(II),I3(II))
- ZCIT1D(II) = ZCIT(I1(II),I2(II),I3(II))
- ZIFNN1D(II,:) = ZIFNNT(I1(II),I2(II),I3(II),:)
- ZEVAP1D(II) = PEVAP3D(I1(II),I2(II),I3(II))
- ZTIME1D(II) = ZTIME(I1(II),I2(II),I3(II))
- LLCOMPUTE1D(II) = LLCOMPUTE(I1(II),I2(II),I3(II))
- IITER1D(II) = IITER(I1(II),I2(II),I3(II))
- ZTIME_LASTCALL1D(II) = ZTIME_LASTCALL(I1(II),I2(II),I3(II))
- Z0RVT1D(II) = Z0RVT(I1(II),I2(II),I3(II))
- Z0RCT1D(II) = Z0RCT(I1(II),I2(II),I3(II))
- Z0RRT1D(II) = Z0RRT(I1(II),I2(II),I3(II))
- Z0RIT1D(II) = Z0RIT(I1(II),I2(II),I3(II))
- Z0RST1D(II) = Z0RST(I1(II),I2(II),I3(II))
- Z0RGT1D(II) = Z0RGT(I1(II),I2(II),I3(II))
- Z0RHT1D(II) = Z0RHT(I1(II),I2(II),I3(II))
- END DO
- !
- ! Allocating 1D variables
- !
- ALLOCATE(ZMAXTIME(IPACK)) ; ZMAXTIME(:) = 0.
- ALLOCATE(ZTIME_THRESHOLD(IPACK)) ; ZTIME_THRESHOLD(:) = 0.
- !
- ALLOCATE(ZA_TH(IPACK)) ; ZA_TH(:) = 0.
- ALLOCATE(ZA_RV(IPACK)) ; ZA_RV(:) = 0.
- ALLOCATE(ZA_RC(IPACK)) ; ZA_RC(:) = 0.
- ALLOCATE(ZA_RR(IPACK)) ; ZA_RR(:) = 0.
- ALLOCATE(ZA_RI(IPACK)) ; ZA_RI(:) = 0.
- ALLOCATE(ZA_RS(IPACK)) ; ZA_RS(:) = 0.
- ALLOCATE(ZA_RG(IPACK)) ; ZA_RG(:) = 0.
- ALLOCATE(ZA_RH(IPACK)) ; ZA_RH(:) = 0.
- ALLOCATE(ZA_CC(IPACK)) ; ZA_CC(:) = 0.
- ALLOCATE(ZA_CR(IPACK)) ; ZA_CR(:) = 0.
- ALLOCATE(ZA_CI(IPACK)) ; ZA_CI(:) = 0.
- !
- ALLOCATE(ZB_TH(IPACK)) ; ZB_TH(:) = 0.
- ALLOCATE(ZB_RV(IPACK)) ; ZB_RV(:) = 0.
- ALLOCATE(ZB_RC(IPACK)) ; ZB_RC(:) = 0.
- ALLOCATE(ZB_RR(IPACK)) ; ZB_RR(:) = 0.
- ALLOCATE(ZB_RI(IPACK)) ; ZB_RI(:) = 0.
- ALLOCATE(ZB_RS(IPACK)) ; ZB_RS(:) = 0.
- ALLOCATE(ZB_RG(IPACK)) ; ZB_RG(:) = 0.
- ALLOCATE(ZB_RH(IPACK)) ; ZB_RH(:) = 0.
- ALLOCATE(ZB_CC(IPACK)) ; ZB_CC(:) = 0.
- ALLOCATE(ZB_CR(IPACK)) ; ZB_CR(:) = 0.
- ALLOCATE(ZB_CI(IPACK)) ; ZB_CI(:) = 0.
- ALLOCATE(ZB_IFNN(IPACK,NMOD_IFN)) ; ZB_IFNN(:,:) = 0.
- !
- ALLOCATE(Z_CR_BRKU(IPACK)) ; Z_CR_BRKU(:) = 0.
- ALLOCATE(Z_TH_HONR(IPACK)) ; Z_TH_HONR(:) = 0.
- ALLOCATE(Z_RR_HONR(IPACK)) ; Z_RR_HONR(:) = 0.
- ALLOCATE(Z_CR_HONR(IPACK)) ; Z_CR_HONR(:) = 0.
- ALLOCATE(Z_TH_IMLT(IPACK)) ; Z_TH_IMLT(:) = 0.
- ALLOCATE(Z_RC_IMLT(IPACK)) ; Z_RC_IMLT(:) = 0.
- ALLOCATE(Z_CC_IMLT(IPACK)) ; Z_CC_IMLT(:) = 0.
- ALLOCATE(Z_TH_HONC(IPACK)) ; Z_TH_HONC(:) = 0.
- ALLOCATE(Z_RC_HONC(IPACK)) ; Z_RC_HONC(:) = 0.
- ALLOCATE(Z_CC_HONC(IPACK)) ; Z_CC_HONC(:) = 0.
- ALLOCATE(Z_CC_SELF(IPACK)) ; Z_CC_SELF(:) = 0.
- ALLOCATE(Z_RC_AUTO(IPACK)) ; Z_RC_AUTO(:) = 0.
- ALLOCATE(Z_CC_AUTO(IPACK)) ; Z_CC_AUTO(:) = 0.
- ALLOCATE(Z_CR_AUTO(IPACK)) ; Z_CR_AUTO(:) = 0.
- ALLOCATE(Z_RC_ACCR(IPACK)) ; Z_RC_ACCR(:) = 0.
- ALLOCATE(Z_CC_ACCR(IPACK)) ; Z_CC_ACCR(:) = 0.
- ALLOCATE(Z_CR_SCBU(IPACK)) ; Z_CR_SCBU(:) = 0.
- ALLOCATE(Z_TH_EVAP(IPACK)) ; Z_TH_EVAP(:) = 0.
- ALLOCATE(Z_RR_EVAP(IPACK)) ; Z_RR_EVAP(:) = 0.
- ALLOCATE(Z_RI_CNVI(IPACK)) ; Z_RI_CNVI(:) = 0.
- ALLOCATE(Z_CI_CNVI(IPACK)) ; Z_CI_CNVI(:) = 0.
- ALLOCATE(Z_TH_DEPS(IPACK)) ; Z_TH_DEPS(:) = 0.
- ALLOCATE(Z_RS_DEPS(IPACK)) ; Z_RS_DEPS(:) = 0.
- ALLOCATE(Z_RI_CNVS(IPACK)) ; Z_RI_CNVS(:) = 0.
- ALLOCATE(Z_CI_CNVS(IPACK)) ; Z_CI_CNVS(:) = 0.
- ALLOCATE(Z_RI_AGGS(IPACK)) ; Z_RI_AGGS(:) = 0.
- ALLOCATE(Z_CI_AGGS(IPACK)) ; Z_CI_AGGS(:) = 0.
- ALLOCATE(Z_TH_DEPG(IPACK)) ; Z_TH_DEPG(:) = 0.
- ALLOCATE(Z_RG_DEPG(IPACK)) ; Z_RG_DEPG(:) = 0.
- ALLOCATE(Z_TH_BERFI(IPACK)); Z_TH_BERFI(:) = 0.
- ALLOCATE(Z_RC_BERFI(IPACK)); Z_RC_BERFI(:) = 0.
- ALLOCATE(Z_TH_RIM(IPACK)) ; Z_TH_RIM = 0.
- ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM = 0.
- ALLOCATE(Z_CC_RIM(IPACK)) ; Z_CC_RIM = 0.
- ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM = 0.
- ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM = 0.
- ALLOCATE(Z_RI_HMS(IPACK)) ; Z_RI_HMS = 0.
- ALLOCATE(Z_CI_HMS(IPACK)) ; Z_CI_HMS = 0.
- ALLOCATE(Z_RS_HMS(IPACK)) ; Z_RS_HMS = 0.
- ALLOCATE(Z_TH_ACC(IPACK)) ; Z_TH_ACC = 0.
- ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC = 0.
- ALLOCATE(Z_CR_ACC(IPACK)) ; Z_CR_ACC = 0.
- ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC = 0.
- ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC = 0.
- ALLOCATE(Z_RS_CMEL(IPACK)) ; Z_RS_CMEL = 0.
- ALLOCATE(Z_TH_CFRZ(IPACK)) ; Z_TH_CFRZ = 0.
- ALLOCATE(Z_RR_CFRZ(IPACK)) ; Z_RR_CFRZ = 0.
- ALLOCATE(Z_CR_CFRZ(IPACK)) ; Z_CR_CFRZ = 0.
- ALLOCATE(Z_RI_CFRZ(IPACK)) ; Z_RI_CFRZ = 0.
- ALLOCATE(Z_CI_CFRZ(IPACK)) ; Z_CI_CFRZ = 0.
- ALLOCATE(Z_TH_WETG(IPACK)) ; Z_TH_WETG = 0.
- ALLOCATE(Z_RC_WETG(IPACK)) ; Z_RC_WETG = 0.
- ALLOCATE(Z_CC_WETG(IPACK)) ; Z_CC_WETG = 0.
- ALLOCATE(Z_RR_WETG(IPACK)) ; Z_RR_WETG = 0.
- ALLOCATE(Z_CR_WETG(IPACK)) ; Z_CR_WETG = 0.
- ALLOCATE(Z_RI_WETG(IPACK)) ; Z_RI_WETG = 0.
- ALLOCATE(Z_CI_WETG(IPACK)) ; Z_CI_WETG = 0.
- ALLOCATE(Z_RS_WETG(IPACK)) ; Z_RS_WETG = 0.
- ALLOCATE(Z_RG_WETG(IPACK)) ; Z_RG_WETG = 0.
- ALLOCATE(Z_RH_WETG(IPACK)) ; Z_RH_WETG = 0.
- ALLOCATE(Z_TH_DRYG(IPACK)) ; Z_TH_DRYG = 0.
- ALLOCATE(Z_RC_DRYG(IPACK)) ; Z_RC_DRYG = 0.
- ALLOCATE(Z_CC_DRYG(IPACK)) ; Z_CC_DRYG = 0.
- ALLOCATE(Z_RR_DRYG(IPACK)) ; Z_RR_DRYG = 0.
- ALLOCATE(Z_CR_DRYG(IPACK)) ; Z_CR_DRYG = 0.
- ALLOCATE(Z_RI_DRYG(IPACK)) ; Z_RI_DRYG = 0.
- ALLOCATE(Z_CI_DRYG(IPACK)) ; Z_CI_DRYG = 0.
- ALLOCATE(Z_RS_DRYG(IPACK)) ; Z_RS_DRYG = 0.
- ALLOCATE(Z_RG_DRYG(IPACK)) ; Z_RG_DRYG = 0.
- ALLOCATE(Z_RI_HMG(IPACK)) ; Z_RI_HMG = 0.
- ALLOCATE(Z_CI_HMG(IPACK)) ; Z_CI_HMG = 0.
- ALLOCATE(Z_RG_HMG(IPACK)) ; Z_RG_HMG = 0.
- ALLOCATE(Z_TH_GMLT(IPACK)) ; Z_TH_GMLT = 0.
- ALLOCATE(Z_RR_GMLT(IPACK)) ; Z_RR_GMLT = 0.
- ALLOCATE(Z_CR_GMLT(IPACK)) ; Z_CR_GMLT = 0.
-
-
-!!$ ZZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
-!!$ ZLSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZZT(:,:,:)-XTT)) &
-!!$ /( (XCPD + XCPV*ZRVT(:,:,:) + XCL*(ZRCT(:,:,:)+ZRRT(:,:,:)) &
-!!$ + XCI*(ZRIT(:,:,:)+ZRST(:,:,:)+ZRGT(:,:,:)+ZRHT(:,:,:)))*ZEXN(:,:,:) )
-!!$ ZLVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZZT(:,:,:)-XTT)) &
-!!$ /( (XCPD + XCPV*ZRVT(:,:,:) + XCL*(ZRCT(:,:,:)+ZRRT(:,:,:)) &
-!!$ + XCI*(ZRIT(:,:,:)+ZRST(:,:,:)+ZRGT(:,:,:)+ZRHT(:,:,:)))*ZEXN(:,:,:) )
- !
- !*** 4.1 Tendecies computation
- !
-
- CALL LIMA_INST_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, LLCOMPUTE1D, &
- ZEXNREF1D, ZP1D, &
- ZTHT1D, ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, &
- ZCCT1D, ZCRT1D, ZCIT1D, &
- ZIFNN1D, &
- Z_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- Z_TH_HONR, Z_RR_HONR, Z_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- Z_TH_IMLT, Z_RC_IMLT, Z_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RG, &
- ZB_CC, ZB_CR, ZB_CI, &
- ZB_IFNN)
-
- CALL LIMA_TENDENCIES (PTSTEP, HFMFILE, OCLOSE_OUT, LLCOMPUTE1D, &
- ZEXNREF1D, ZRHODREF1D, ZP1D, ZTHT1D, &
- ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, ZRHT1D, &
- ZCCT1D, ZCRT1D, ZCIT1D, &
- Z_TH_HONC, Z_RC_HONC, Z_CC_HONC, &
- Z_CC_SELF, &
- Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, &
- Z_RC_ACCR, Z_CC_ACCR, &
- Z_CR_SCBU, &
- Z_TH_EVAP, Z_RR_EVAP, &
- Z_RI_CNVI, Z_CI_CNVI, &
- Z_TH_DEPS, Z_RS_DEPS, &
- Z_RI_CNVS, Z_CI_CNVS, &
- Z_RI_AGGS, Z_CI_AGGS, &
- Z_TH_DEPG, Z_RG_DEPG, &
- Z_TH_BERFI, Z_RC_BERFI, &
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_RG_RIM, &
- Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, &
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_RG_ACC, &
- Z_RS_CMEL, &
- Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, &
- Z_TH_WETG, Z_RC_WETG, Z_CC_WETG, Z_RR_WETG, Z_CR_WETG, &
- Z_RI_WETG, Z_CI_WETG, Z_RS_WETG, Z_RG_WETG, Z_RH_WETG, &
- Z_TH_DRYG, Z_RC_DRYG, Z_CC_DRYG, Z_RR_DRYG, Z_CR_DRYG, &
- Z_RI_DRYG, Z_CI_DRYG, Z_RS_DRYG, Z_RG_DRYG, &
- Z_RI_HMG, Z_CI_HMG, Z_RG_HMG, &
- Z_TH_GMLT, Z_RR_GMLT, Z_CR_GMLT, &
-!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
-!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
- ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, &
- ZA_RI, ZA_CI, ZA_RS, ZA_RG, ZA_RH, &
- ZEVAP1D )
-
- !
- !*** 4.2 Integration time
- !
- ! If we can, we will use these tendecies until the end of the timestep
- ZMAXTIME(:)=PTSTEP-ZTIME1D(:) ! Remaining time until the end of the timestep
-
- ! We need to adjust tendencies when temperature reaches 0
- IF(LFEEDBACKT) THEN
- !Is ZB_TH enough to change temperature sign?
- WHERE( ((ZTHT1D(:) - XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - XTT/ZEXN1D(:))) < 0. )
- ZMAXTIME(:)=0.
- ENDWHERE
- !Can ZA_TH make temperature change of sign?
- ZTIME_THRESHOLD(:)=-1.
- WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>0.)
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- ENDWHERE
- ENDIF
-
- ! We need to adjust tendencies when a species disappears
- ! When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- WHERE(ZA_RV(:)<-1.E-20 .AND. ZRVT1D(:)>XRTMIN(1))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT1D(:))/ZA_RV(:))
- END WHERE
- WHERE(ZA_RC(:)<-1.E-20 .AND. ZRCT1D(:)>XRTMIN(2))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT1D(:))/ZA_RC(:))
- END WHERE
- WHERE(ZA_RR(:)<-1.E-20 .AND. ZRRT1D(:)>XRTMIN(3))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT1D(:))/ZA_RR(:))
- END WHERE
- WHERE(ZA_RI(:)<-1.E-20 .AND. ZRIT1D(:)>XRTMIN(4))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT1D(:))/ZA_RI(:))
- END WHERE
- WHERE(ZA_RS(:)<-1.E-20 .AND. ZRST1D(:)>XRTMIN(5))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST1D(:))/ZA_RS(:))
- END WHERE
- WHERE(ZA_RG(:)<-1.E-20 .AND. ZRGT1D(:)>XRTMIN(6))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT1D(:))/ZA_RG(:))
- END WHERE
- WHERE(ZA_RH(:)<-1.E-20 .AND. ZRHT1D(:)>XRTMIN(7))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT1D(:))/ZA_RH(:))
- END WHERE
-
- ! We stop when the end of the timestep is reached
- WHERE(PTSTEP-ZTIME1D(:)-ZMAXTIME(:)<=0.)
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ! We must recompute tendencies when the end of the sub-timestep is reached
- IF(XTSTEP_TS/=0.) THEN
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ZTIME1D(:)+ZMAXTIME(:)>ZTIME_LASTCALL1D(:)+ZTSTEP)
- ZMAXTIME(:)=ZTIME_LASTCALL1D(:)-ZTIME1D(:)+ZTSTEP
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
- ENDIF
-
- ! We must recompute tendencies when the maximum allowed change is reached
- ! When a species is missing, only the external tendencies can be active and we do not want to recompute
- ! the microphysical tendencies when external tendencies are negative (results won't change because species was already missing)
- IF(XMRSTEP/=0.) THEN
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT1D(:)-ZRVT1D(:)-ZB_RV(:))/ZA_RV(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRVT1D(:)>XRTMIN(1) .OR. ZA_RV(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT1D(:)-ZRCT1D(:)-ZB_RC(:))/ZA_RC(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRCT1D(:)>XRTMIN(2) .OR. ZA_RC(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT1D(:)-ZRRT1D(:)-ZB_RR(:))/ZA_RR(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRRT1D(:)>XRTMIN(3) .OR. ZA_RR(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT1D(:)-ZRIT1D(:)-ZB_RI(:))/ZA_RI(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRIT1D(:)>XRTMIN(4) .OR. ZA_RI(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST1D(:)-ZRST1D(:)-ZB_RS(:))/ZA_RS(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRST1D(:)>XRTMIN(5) .OR. ZA_RS(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT1D(:)-ZRGT1D(:)-ZB_RG(:))/ZA_RG(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRGT1D(:)>XRTMIN(6) .OR. ZA_RG(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT1D(:)-ZRHT1D(:)-ZB_RH(:))/ZA_RH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRHT1D(:)>XRTMIN(7) .OR. ZA_RH(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
-
- WHERE(IITER1D(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), &
- ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
- ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP)
- ZMAXTIME(:)=0.
- LLCOMPUTE1D(:)=.FALSE.
- ENDWHERE
- ENDIF
- !
- !*** 4.3 New values of variables for next iteration
- !
- ZTHT1D = ZTHT1D + ZA_TH(:) * ZMAXTIME(:) + ZB_TH(:)
- ZRVT1D = ZRVT1D + ZA_RV(:) * ZMAXTIME(:) + ZB_RV(:)
- ZRCT1D = ZRCT1D + ZA_RC(:) * ZMAXTIME(:) + ZB_RC(:)
- ZCCT1D = ZCCT1D + ZA_CC(:) * ZMAXTIME(:) + ZB_CC(:)
- ZRRT1D = ZRRT1D + ZA_RR(:) * ZMAXTIME(:) + ZB_RR(:)
- ZCRT1D = ZCRT1D + ZA_CR(:) * ZMAXTIME(:) + ZB_CR(:)
- ZRIT1D = ZRIT1D + ZA_RI(:) * ZMAXTIME(:) + ZB_RI(:)
- ZCIT1D = ZCIT1D + ZA_CI(:) * ZMAXTIME(:) + ZB_CI(:)
- ZRST1D = ZRST1D + ZA_RS(:) * ZMAXTIME(:) + ZB_RS(:)
- ZRGT1D = ZRGT1D + ZA_RG(:) * ZMAXTIME(:) + ZB_RG(:)
- ZRHT1D = ZRHT1D + ZA_RH(:) * ZMAXTIME(:) + ZB_RH(:)
- !
-
- DO II=1,NMOD_IFN
- ZIFNN1D(:,II) = ZIFNN1D(:,II) + ZB_IFNN(:,II)
- END DO
- !
- !*** 4.5
- !
- WHERE (ZRCT1D .LE. XRTMIN(2))
- ZRVT1D = ZRVT1D + ZRCT1D
- ZRCT1D = 0.
- ZCCT1D = 0.
- END WHERE
- WHERE (ZRRT1D .LE. XRTMIN(3))
- ZRVT1D = ZRVT1D + ZRRT1D
- ZRRT1D = 0.
- ZCRT1D = 0.
- END WHERE
- WHERE (ZRIT1D .LE. XRTMIN(4))
- ZRVT1D = ZRVT1D + ZRIT1D
- ZRIT1D = 0.
- ZCIT1D = 0.
- END WHERE
-
- !
- !*** 4.5 Next loop
- !
- ZTIME1D(:)=ZTIME1D(:)+ZMAXTIME(:)
- !
- !*** 4.4 Unpacking
- !
- DO II=1,IPACK
- ZTHT(I1(II),I2(II),I3(II)) = ZTHT1D(II)
- ZRVT(I1(II),I2(II),I3(II)) = ZRVT1D(II)
- ZRCT(I1(II),I2(II),I3(II)) = ZRCT1D(II)
- ZRRT(I1(II),I2(II),I3(II)) = ZRRT1D(II)
- ZRIT(I1(II),I2(II),I3(II)) = ZRIT1D(II)
- ZRST(I1(II),I2(II),I3(II)) = ZRST1D(II)
- ZRGT(I1(II),I2(II),I3(II)) = ZRGT1D(II)
- ZRHT(I1(II),I2(II),I3(II)) = ZRHT1D(II)
- ZCCT(I1(II),I2(II),I3(II)) = ZCCT1D(II)
- ZCRT(I1(II),I2(II),I3(II)) = ZCRT1D(II)
- ZCIT(I1(II),I2(II),I3(II)) = ZCIT1D(II)
- ZIFNNT(I1(II),I2(II),I3(II),:) = ZIFNN1D(II,:)
- PEVAP3D(I1(II),I2(II),I3(II)) = ZEVAP1D(II)
- ZTIME(I1(II),I2(II),I3(II)) = ZTIME1D(II)
- LLCOMPUTE(I1(II),I2(II),I3(II)) = LLCOMPUTE1D(II)
- IITER(I1(II),I2(II),I3(II)) = IITER1D(II)
- END DO
- !
- !*** 4.4 Unpacking for budgets
- !
- IF(LBU_ENABLE) THEN
- DO II=1,IPACK
-!!$ ZTOT_RC_HENU(I1(II),I2(II),I3(II)) = ZTOT_RC_HENU(I1(II),I2(II),I3(II)) + Z_RC_HENU(II)
-!!$ ZTOT_CC_HENU(I1(II),I2(II),I3(II)) = ZTOT_CC_HENU(I1(II),I2(II),I3(II)) + Z_CC_HENU(II)
- ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) = ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) + Z_CR_BRKU(II)
-!!$ ZTOT_RI_HIND(I1(II),I2(II),I3(II)) = ZTOT_RI_HIND(I1(II),I2(II),I3(II)) + Z_RI_HIND(II)
-!!$ ZTOT_CI_HIND(I1(II),I2(II),I3(II)) = ZTOT_CI_HIND(I1(II),I2(II),I3(II)) + Z_CI_HIND(II)
-!!$ ZTOT_RC_HINC(I1(II),I2(II),I3(II)) = ZTOT_RC_HINC(I1(II),I2(II),I3(II)) + Z_RC_HINC(II)
-!!$ ZTOT_CC_HINC(I1(II),I2(II),I3(II)) = ZTOT_CC_HINC(I1(II),I2(II),I3(II)) + Z_CC_HINC(II)
-!!$ ZTOT_RI_HONH(I1(II),I2(II),I3(II)) = ZTOT_RI_HONH(I1(II),I2(II),I3(II)) + Z_RI_HONH(II)
-!!$ ZTOT_CI_HONH(I1(II),I2(II),I3(II)) = ZTOT_CI_HONH(I1(II),I2(II),I3(II)) + Z_CI_HONH(II)
- ZTOT_TH_HONC(I1(II),I2(II),I3(II)) = ZTOT_TH_HONC(I1(II),I2(II),I3(II)) + Z_TH_HONC(II) * ZMAXTIME(II)
- ZTOT_RC_HONC(I1(II),I2(II),I3(II)) = ZTOT_RC_HONC(I1(II),I2(II),I3(II)) + Z_RC_HONC(II) * ZMAXTIME(II)
- ZTOT_CC_HONC(I1(II),I2(II),I3(II)) = ZTOT_CC_HONC(I1(II),I2(II),I3(II)) + Z_CC_HONC(II) * ZMAXTIME(II)
- ZTOT_TH_HONR(I1(II),I2(II),I3(II)) = ZTOT_TH_HONR(I1(II),I2(II),I3(II)) + Z_TH_HONR(II)
- ZTOT_RR_HONR(I1(II),I2(II),I3(II)) = ZTOT_RR_HONR(I1(II),I2(II),I3(II)) + Z_RR_HONR(II)
- ZTOT_CR_HONR(I1(II),I2(II),I3(II)) = ZTOT_CR_HONR(I1(II),I2(II),I3(II)) + Z_CR_HONR(II)
- ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) = ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) + Z_TH_IMLT(II)
- ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) + Z_RC_IMLT(II)
- ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) + Z_CC_IMLT(II)
- ZTOT_CC_SELF(I1(II),I2(II),I3(II)) = ZTOT_CC_SELF(I1(II),I2(II),I3(II)) + Z_CC_SELF(II) * ZMAXTIME(II)
- ZTOT_RC_AUTO(I1(II),I2(II),I3(II)) = ZTOT_RC_AUTO(I1(II),I2(II),I3(II)) + Z_RC_AUTO(II) * ZMAXTIME(II)
- ZTOT_CC_AUTO(I1(II),I2(II),I3(II)) = ZTOT_CC_AUTO(I1(II),I2(II),I3(II)) + Z_CC_AUTO(II) * ZMAXTIME(II)
- ZTOT_CR_AUTO(I1(II),I2(II),I3(II)) = ZTOT_CR_AUTO(I1(II),I2(II),I3(II)) + Z_CR_AUTO(II) * ZMAXTIME(II)
- ZTOT_RC_ACCR(I1(II),I2(II),I3(II)) = ZTOT_RC_ACCR(I1(II),I2(II),I3(II)) + Z_RC_ACCR(II) * ZMAXTIME(II)
- ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) = ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) + Z_CC_ACCR(II) * ZMAXTIME(II)
- ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) = ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) + Z_CR_SCBU(II) * ZMAXTIME(II)
-!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
- ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) = ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) + Z_TH_EVAP(II) * ZMAXTIME(II)
- ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) + Z_RR_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
- ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) + Z_RI_CNVI(II) * ZMAXTIME(II)
- ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) + Z_CI_CNVI(II) * ZMAXTIME(II)
- ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) + Z_TH_DEPS(II) * ZMAXTIME(II)
- ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) = ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) + Z_RS_DEPS(II) * ZMAXTIME(II)
- ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) + Z_RI_CNVS(II) * ZMAXTIME(II)
- ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) + Z_CI_CNVS(II) * ZMAXTIME(II)
- ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) = ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) + Z_RI_AGGS(II) * ZMAXTIME(II)
- ZTOT_CI_AGGS(I1(II),I2(II),I3(II)) = ZTOT_CI_AGGS(I1(II),I2(II),I3(II)) + Z_CI_AGGS(II) * ZMAXTIME(II)
- ZTOT_TH_DEPG(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPG(I1(II),I2(II),I3(II)) + Z_TH_DEPG(II) * ZMAXTIME(II)
- ZTOT_RG_DEPG(I1(II),I2(II),I3(II)) = ZTOT_RG_DEPG(I1(II),I2(II),I3(II)) + Z_RG_DEPG(II) * ZMAXTIME(II)
- ZTOT_TH_BERFI(I1(II),I2(II),I3(II))= ZTOT_TH_BERFI(I1(II),I2(II),I3(II)) + Z_TH_BERFI(II) * ZMAXTIME(II)
- ZTOT_RC_BERFI(I1(II),I2(II),I3(II))= ZTOT_RC_BERFI(I1(II),I2(II),I3(II)) + Z_RC_BERFI(II) * ZMAXTIME(II)
- ZTOT_TH_RIM(I1(II),I2(II),I3(II)) = ZTOT_TH_RIM(I1(II),I2(II),I3(II)) + Z_TH_RIM(II) * ZMAXTIME(II)
- ZTOT_RC_RIM(I1(II),I2(II),I3(II)) = ZTOT_RC_RIM(I1(II),I2(II),I3(II)) + Z_RC_RIM(II) * ZMAXTIME(II)
- ZTOT_CC_RIM(I1(II),I2(II),I3(II)) = ZTOT_CC_RIM(I1(II),I2(II),I3(II)) + Z_CC_RIM(II) * ZMAXTIME(II)
- ZTOT_RS_RIM(I1(II),I2(II),I3(II)) = ZTOT_RS_RIM(I1(II),I2(II),I3(II)) + Z_RS_RIM(II) * ZMAXTIME(II)
- ZTOT_RG_RIM(I1(II),I2(II),I3(II)) = ZTOT_RG_RIM(I1(II),I2(II),I3(II)) + Z_RG_RIM(II) * ZMAXTIME(II)
- ZTOT_RI_HMS(I1(II),I2(II),I3(II)) = ZTOT_RI_HMS(I1(II),I2(II),I3(II)) + Z_RI_HMS(II) * ZMAXTIME(II)
- ZTOT_CI_HMS(I1(II),I2(II),I3(II)) = ZTOT_CI_HMS(I1(II),I2(II),I3(II)) + Z_CI_HMS(II) * ZMAXTIME(II)
- ZTOT_RS_HMS(I1(II),I2(II),I3(II)) = ZTOT_RS_HMS(I1(II),I2(II),I3(II)) + Z_RS_HMS(II) * ZMAXTIME(II)
- ZTOT_TH_ACC(I1(II),I2(II),I3(II)) = ZTOT_TH_ACC(I1(II),I2(II),I3(II)) + Z_TH_ACC(II) * ZMAXTIME(II)
- ZTOT_RR_ACC(I1(II),I2(II),I3(II)) = ZTOT_RR_ACC(I1(II),I2(II),I3(II)) + Z_RR_ACC(II) * ZMAXTIME(II)
- ZTOT_CR_ACC(I1(II),I2(II),I3(II)) = ZTOT_CR_ACC(I1(II),I2(II),I3(II)) + Z_CR_ACC(II) * ZMAXTIME(II)
- ZTOT_RS_ACC(I1(II),I2(II),I3(II)) = ZTOT_RS_ACC(I1(II),I2(II),I3(II)) + Z_RS_ACC(II) * ZMAXTIME(II)
- ZTOT_RG_ACC(I1(II),I2(II),I3(II)) = ZTOT_RG_ACC(I1(II),I2(II),I3(II)) + Z_RG_ACC(II) * ZMAXTIME(II)
- ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) + Z_RS_CMEL(II) * ZMAXTIME(II)
- ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) + Z_TH_CFRZ(II) * ZMAXTIME(II)
- ZTOT_RR_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_RR_CFRZ(I1(II),I2(II),I3(II)) + Z_RR_CFRZ(II) * ZMAXTIME(II)
- ZTOT_CR_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_CR_CFRZ(I1(II),I2(II),I3(II)) + Z_CR_CFRZ(II) * ZMAXTIME(II)
- ZTOT_RI_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_RI_CFRZ(I1(II),I2(II),I3(II)) + Z_RI_CFRZ(II) * ZMAXTIME(II)
- ZTOT_CI_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_CI_CFRZ(I1(II),I2(II),I3(II)) + Z_CI_CFRZ(II) * ZMAXTIME(II)
- ZTOT_TH_WETG(I1(II),I2(II),I3(II)) = ZTOT_TH_WETG(I1(II),I2(II),I3(II)) + Z_TH_WETG(II) * ZMAXTIME(II)
- ZTOT_RC_WETG(I1(II),I2(II),I3(II)) = ZTOT_RC_WETG(I1(II),I2(II),I3(II)) + Z_RC_WETG(II) * ZMAXTIME(II)
- ZTOT_CC_WETG(I1(II),I2(II),I3(II)) = ZTOT_CC_WETG(I1(II),I2(II),I3(II)) + Z_CC_WETG(II) * ZMAXTIME(II)
- ZTOT_RR_WETG(I1(II),I2(II),I3(II)) = ZTOT_RR_WETG(I1(II),I2(II),I3(II)) + Z_RR_WETG(II) * ZMAXTIME(II)
- ZTOT_CR_WETG(I1(II),I2(II),I3(II)) = ZTOT_CR_WETG(I1(II),I2(II),I3(II)) + Z_CR_WETG(II) * ZMAXTIME(II)
- ZTOT_RI_WETG(I1(II),I2(II),I3(II)) = ZTOT_RI_WETG(I1(II),I2(II),I3(II)) + Z_RI_WETG(II) * ZMAXTIME(II)
- ZTOT_CI_WETG(I1(II),I2(II),I3(II)) = ZTOT_CI_WETG(I1(II),I2(II),I3(II)) + Z_CI_WETG(II) * ZMAXTIME(II)
- ZTOT_RS_WETG(I1(II),I2(II),I3(II)) = ZTOT_RS_WETG(I1(II),I2(II),I3(II)) + Z_RS_WETG(II) * ZMAXTIME(II)
- ZTOT_RG_WETG(I1(II),I2(II),I3(II)) = ZTOT_RG_WETG(I1(II),I2(II),I3(II)) + Z_RG_WETG(II) * ZMAXTIME(II)
- ZTOT_RH_WETG(I1(II),I2(II),I3(II)) = ZTOT_RH_WETG(I1(II),I2(II),I3(II)) + Z_RH_WETG(II) * ZMAXTIME(II)
- ZTOT_TH_DRYG(I1(II),I2(II),I3(II)) = ZTOT_TH_DRYG(I1(II),I2(II),I3(II)) + Z_TH_DRYG(II) * ZMAXTIME(II)
- ZTOT_RC_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RC_DRYG(I1(II),I2(II),I3(II)) + Z_RC_DRYG(II) * ZMAXTIME(II)
- ZTOT_CC_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CC_DRYG(I1(II),I2(II),I3(II)) + Z_CC_DRYG(II) * ZMAXTIME(II)
- ZTOT_RR_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RR_DRYG(I1(II),I2(II),I3(II)) + Z_RR_DRYG(II) * ZMAXTIME(II)
- ZTOT_CR_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CR_DRYG(I1(II),I2(II),I3(II)) + Z_CR_DRYG(II) * ZMAXTIME(II)
- ZTOT_RI_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RI_DRYG(I1(II),I2(II),I3(II)) + Z_RI_DRYG(II) * ZMAXTIME(II)
- ZTOT_CI_DRYG(I1(II),I2(II),I3(II)) = ZTOT_CI_DRYG(I1(II),I2(II),I3(II)) + Z_CI_DRYG(II) * ZMAXTIME(II)
- ZTOT_RS_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RS_DRYG(I1(II),I2(II),I3(II)) + Z_RS_DRYG(II) * ZMAXTIME(II)
- ZTOT_RG_DRYG(I1(II),I2(II),I3(II)) = ZTOT_RG_DRYG(I1(II),I2(II),I3(II)) + Z_RG_DRYG(II) * ZMAXTIME(II)
- ZTOT_RI_HMG(I1(II),I2(II),I3(II)) = ZTOT_RI_HMG(I1(II),I2(II),I3(II)) + Z_RI_HMG(II) * ZMAXTIME(II)
- ZTOT_CI_HMG(I1(II),I2(II),I3(II)) = ZTOT_CI_HMG(I1(II),I2(II),I3(II)) + Z_CI_HMG(II) * ZMAXTIME(II)
- ZTOT_RG_HMG(I1(II),I2(II),I3(II)) = ZTOT_RG_HMG(I1(II),I2(II),I3(II)) + Z_RG_HMG(II) * ZMAXTIME(II)
- ZTOT_TH_GMLT(I1(II),I2(II),I3(II)) = ZTOT_TH_GMLT(I1(II),I2(II),I3(II)) + Z_TH_GMLT(II) * ZMAXTIME(II)
- ZTOT_RR_GMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_GMLT(I1(II),I2(II),I3(II)) + Z_RR_GMLT(II) * ZMAXTIME(II)
- ZTOT_CR_GMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_GMLT(I1(II),I2(II),I3(II)) + Z_CR_GMLT(II) * ZMAXTIME(II)
-!!$ ZTOT_RC_WETH(I1(II),I2(II),I3(II)) = ZTOT_RC_WETH(I1(II),I2(II),I3(II)) + Z_RC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_WETH(I1(II),I2(II),I3(II)) = ZTOT_CC_WETH(I1(II),I2(II),I3(II)) + Z_CC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_WETH(I1(II),I2(II),I3(II)) = ZTOT_RR_WETH(I1(II),I2(II),I3(II)) + Z_RR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_WETH(I1(II),I2(II),I3(II)) = ZTOT_CR_WETH(I1(II),I2(II),I3(II)) + Z_CR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RI_WETH(I1(II),I2(II),I3(II)) = ZTOT_RI_WETH(I1(II),I2(II),I3(II)) + Z_RI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CI_WETH(I1(II),I2(II),I3(II)) = ZTOT_CI_WETH(I1(II),I2(II),I3(II)) + Z_CI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RS_WETH(I1(II),I2(II),I3(II)) = ZTOT_RS_WETH(I1(II),I2(II),I3(II)) + Z_RS_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_WETH(I1(II),I2(II),I3(II)) = ZTOT_RG_WETH(I1(II),I2(II),I3(II)) + Z_RG_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RH_WETH(I1(II),I2(II),I3(II)) = ZTOT_RH_WETH(I1(II),I2(II),I3(II)) + Z_RH_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
- END DO
- ENDIF
- !
- ! Deallocating variables
- !
- DEALLOCATE(I1)
- DEALLOCATE(I2)
- DEALLOCATE(I3)
- DEALLOCATE(ZRHODREF1D)
- DEALLOCATE(ZEXNREF1D)
- DEALLOCATE(ZEXN1D)
- DEALLOCATE(ZP1D)
- DEALLOCATE(ZTHT1D)
- DEALLOCATE(ZRVT1D)
- DEALLOCATE(ZRCT1D)
- DEALLOCATE(ZRRT1D)
- DEALLOCATE(ZRIT1D)
- DEALLOCATE(ZRST1D)
- DEALLOCATE(ZRGT1D)
- DEALLOCATE(ZRHT1D)
- DEALLOCATE(ZCCT1D)
- DEALLOCATE(ZCRT1D)
- DEALLOCATE(ZCIT1D)
- DEALLOCATE(ZIFNN1D)
- DEALLOCATE(ZEVAP1D)
- DEALLOCATE(ZTIME1D)
- DEALLOCATE(LLCOMPUTE1D)
- DEALLOCATE(IITER1D)
- DEALLOCATE(ZTIME_LASTCALL1D)
- DEALLOCATE(Z0RVT1D)
- DEALLOCATE(Z0RCT1D)
- DEALLOCATE(Z0RRT1D)
- DEALLOCATE(Z0RIT1D)
- DEALLOCATE(Z0RST1D)
- DEALLOCATE(Z0RGT1D)
- DEALLOCATE(Z0RHT1D)
- !
- DEALLOCATE(ZMAXTIME)
- DEALLOCATE(ZTIME_THRESHOLD)
- !
- DEALLOCATE(ZA_TH)
- DEALLOCATE(ZA_RV)
- DEALLOCATE(ZA_RC)
- DEALLOCATE(ZA_RR)
- DEALLOCATE(ZA_RI)
- DEALLOCATE(ZA_RS)
- DEALLOCATE(ZA_RG)
- DEALLOCATE(ZA_RH)
- DEALLOCATE(ZA_CC)
- DEALLOCATE(ZA_CR)
- DEALLOCATE(ZA_CI)
- !
- DEALLOCATE(ZB_TH)
- DEALLOCATE(ZB_RV)
- DEALLOCATE(ZB_RC)
- DEALLOCATE(ZB_RR)
- DEALLOCATE(ZB_RI)
- DEALLOCATE(ZB_RS)
- DEALLOCATE(ZB_RG)
- DEALLOCATE(ZB_RH)
- DEALLOCATE(ZB_CC)
- DEALLOCATE(ZB_CR)
- DEALLOCATE(ZB_CI)
- DEALLOCATE(ZB_IFNN)
- !
- DEALLOCATE(Z_CR_BRKU)
- DEALLOCATE(Z_TH_HONR)
- DEALLOCATE(Z_RR_HONR)
- DEALLOCATE(Z_CR_HONR)
- DEALLOCATE(Z_TH_IMLT)
- DEALLOCATE(Z_RC_IMLT)
- DEALLOCATE(Z_CC_IMLT)
- DEALLOCATE(Z_TH_HONC)
- DEALLOCATE(Z_RC_HONC)
- DEALLOCATE(Z_CC_HONC)
- DEALLOCATE(Z_CC_SELF)
- DEALLOCATE(Z_RC_AUTO)
- DEALLOCATE(Z_CC_AUTO)
- DEALLOCATE(Z_CR_AUTO)
- DEALLOCATE(Z_RC_ACCR)
- DEALLOCATE(Z_CC_ACCR)
- DEALLOCATE(Z_CR_SCBU)
- DEALLOCATE(Z_TH_EVAP)
- DEALLOCATE(Z_RR_EVAP)
- DEALLOCATE(Z_RI_CNVI)
- DEALLOCATE(Z_CI_CNVI)
- DEALLOCATE(Z_TH_DEPS)
- DEALLOCATE(Z_RS_DEPS)
- DEALLOCATE(Z_RI_CNVS)
- DEALLOCATE(Z_CI_CNVS)
- DEALLOCATE(Z_RI_AGGS)
- DEALLOCATE(Z_CI_AGGS)
- DEALLOCATE(Z_TH_DEPG)
- DEALLOCATE(Z_RG_DEPG)
- DEALLOCATE(Z_TH_BERFI)
- DEALLOCATE(Z_RC_BERFI)
- DEALLOCATE(Z_TH_RIM)
- DEALLOCATE(Z_RC_RIM)
- DEALLOCATE(Z_CC_RIM)
- DEALLOCATE(Z_RS_RIM)
- DEALLOCATE(Z_RG_RIM)
- DEALLOCATE(Z_RI_HMS)
- DEALLOCATE(Z_CI_HMS)
- DEALLOCATE(Z_RS_HMS)
- DEALLOCATE(Z_TH_ACC)
- DEALLOCATE(Z_RR_ACC)
- DEALLOCATE(Z_CR_ACC)
- DEALLOCATE(Z_RS_ACC)
- DEALLOCATE(Z_RG_ACC)
- DEALLOCATE(Z_RS_CMEL)
- DEALLOCATE(Z_TH_CFRZ)
- DEALLOCATE(Z_RR_CFRZ)
- DEALLOCATE(Z_CR_CFRZ)
- DEALLOCATE(Z_RI_CFRZ)
- DEALLOCATE(Z_CI_CFRZ)
- DEALLOCATE(Z_TH_WETG)
- DEALLOCATE(Z_RC_WETG)
- DEALLOCATE(Z_CC_WETG)
- DEALLOCATE(Z_RR_WETG)
- DEALLOCATE(Z_CR_WETG)
- DEALLOCATE(Z_RI_WETG)
- DEALLOCATE(Z_CI_WETG)
- DEALLOCATE(Z_RS_WETG)
- DEALLOCATE(Z_RG_WETG)
- DEALLOCATE(Z_RH_WETG)
- DEALLOCATE(Z_TH_DRYG)
- DEALLOCATE(Z_RC_DRYG)
- DEALLOCATE(Z_CC_DRYG)
- DEALLOCATE(Z_RR_DRYG)
- DEALLOCATE(Z_CR_DRYG)
- DEALLOCATE(Z_RI_DRYG)
- DEALLOCATE(Z_CI_DRYG)
- DEALLOCATE(Z_RS_DRYG)
- DEALLOCATE(Z_RG_DRYG)
- DEALLOCATE(Z_RI_HMG)
- DEALLOCATE(Z_CI_HMG)
- DEALLOCATE(Z_RG_HMG)
- DEALLOCATE(Z_TH_GMLT)
- DEALLOCATE(Z_RR_GMLT)
- DEALLOCATE(Z_CR_GMLT)
- !
- ENDDO
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. TOTAL TENDENCIES
-! ----------------
-!
-! Old state = state before microphysics time-splitting = state after sedimentation and nucleation processes
-! Tendencies from microphysics = (new state - old state) / PTSTEP
-! = new state / PTSTEP - old source
-!
-ZW_RVS(:,:,:) = 0.
-ZW_RCS(:,:,:) = 0.
-ZW_CCS(:,:,:) = 0.
-ZW_RRS(:,:,:) = 0.
-ZW_CRS(:,:,:) = 0.
-ZW_RIS(:,:,:) = 0.
-ZW_CIS(:,:,:) = 0.
-ZW_RSS(:,:,:) = 0.
-ZW_RGS(:,:,:) = 0.
-ZW_RHS(:,:,:) = 0.
-ZW_THS(:,:,:) = 0.
-!
-ZW_CCNFS(:,:,:,:) = 0.
-ZW_CCNAS(:,:,:,:) = 0.
-ZW_IFNFS(:,:,:,:) = 0.
-ZW_IFNNS(:,:,:,:) = 0.
-ZW_IMMNS(:,:,:,:) = 0.
-ZW_HOMFS(:,:,:) = 0.
-!
-!!$IF ( KRR .GE. 1 ) ZW_RVS(:,:,:) = ( ZRVT(:,:,:) ) *ZINV_TSTEP - ZRVS(:,:,:)
-!!$IF ( KRR .GE. 2 ) ZW_RCS(:,:,:) = ( ZRCT(:,:,:) ) *ZINV_TSTEP - ZRCS(:,:,:)
-!!$IF ( KRR .GE. 3 ) ZW_RRS(:,:,:) = ( ZRRT(:,:,:) ) *ZINV_TSTEP - ZRRS(:,:,:)
-!!$IF ( KRR .GE. 4 ) ZW_RIS(:,:,:) = ( ZRIT(:,:,:) ) *ZINV_TSTEP - ZRIS(:,:,:)
-!!$IF ( KRR .GE. 5 ) ZW_RSS(:,:,:) = ( ZRST(:,:,:) ) *ZINV_TSTEP - ZRSS(:,:,:)
-!!$IF ( KRR .GE. 6 ) ZW_RGS(:,:,:) = ( ZRGT(:,:,:) ) *ZINV_TSTEP - ZRGS(:,:,:)
-!!$IF ( KRR .GE. 7 ) ZW_RHS(:,:,:) = ( ZRHT(:,:,:) ) *ZINV_TSTEP - ZRHS(:,:,:)
-!!$!
-!!$ZW_THS(:,:,:) = (ZW_RCS(:,:,:)+ZW_RRS(:,:,:) )*ZZ_LVFACT(:,:,:) + &
-!!$ & (ZW_RIS(:,:,:)+ZW_RSS(:,:,:)+ZW_RGS(:,:,:)+ZW_RHS(:,:,:))*ZZ_LSFACT(:,:,:)
-!!$!
-!!$! Source at the end of microphysics = new state / PTSTEP
-!!$!
-!!$IF ( KRR .GE. 1 ) ZW_RVS(:,:,:) = ZW_RVS(:,:,:) + ZRVS(:,:,:)
-!!$IF ( KRR .GE. 2 ) ZW_RCS(:,:,:) = ZW_RCS(:,:,:) + ZRCS(:,:,:)
-!!$IF ( KRR .GE. 3 ) ZW_RRS(:,:,:) = ZW_RRS(:,:,:) + ZRRS(:,:,:)
-!!$IF ( KRR .GE. 4 ) ZW_RIS(:,:,:) = ZW_RIS(:,:,:) + ZRIS(:,:,:)
-!!$IF ( KRR .GE. 5 ) ZW_RSS(:,:,:) = ZW_RSS(:,:,:) + ZRSS(:,:,:)
-!!$IF ( KRR .GE. 6 ) ZW_RGS(:,:,:) = ZW_RGS(:,:,:) + ZRGS(:,:,:)
-!!$IF ( KRR .GE. 7 ) ZW_RHS(:,:,:) = ZW_RHS(:,:,:) + ZRHS(:,:,:)
-!!$!
-!!$ZW_THS(:,:,:) = ZTHS(:,:,:) + ZW_THS(:,:,:)
-!
-IF ( KRR .GE. 1 ) ZW_RVS(:,:,:) = ( ZRVT(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 2 ) ZW_RCS(:,:,:) = ( ZRCT(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 3 ) ZW_RRS(:,:,:) = ( ZRRT(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 4 ) ZW_RIS(:,:,:) = ( ZRIT(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 5 ) ZW_RSS(:,:,:) = ( ZRST(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 6 ) ZW_RGS(:,:,:) = ( ZRGT(:,:,:) ) *ZINV_TSTEP
-IF ( KRR .GE. 7 ) ZW_RHS(:,:,:) = ( ZRHT(:,:,:) ) *ZINV_TSTEP
-!
-IF ( LWARM_LIMA ) ZW_CCS(:,:,:) = ( ZCCT(:,:,:) ) *ZINV_TSTEP
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) ZW_CRS(:,:,:) = ( ZCRT(:,:,:) ) *ZINV_TSTEP
-IF ( LCOLD_LIMA ) ZW_CIS(:,:,:) = ( ZCIT(:,:,:) ) *ZINV_TSTEP
-!
-IF ( NMOD_CCN .GE. 1 ) ZW_CCNFS(:,:,:,:) = ( ZCCNFT(:,:,:,:) ) *ZINV_TSTEP
-IF ( NMOD_CCN .GE. 1 ) ZW_CCNAS(:,:,:,:) = ( ZCCNAT(:,:,:,:) ) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) ZW_IFNFS(:,:,:,:) = ( ZIFNFT(:,:,:,:) ) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) ZW_IFNNS(:,:,:,:) = ( ZIFNNT(:,:,:,:) ) *ZINV_TSTEP
-IF ( NMOD_IMM .GE. 1 ) ZW_IMMNS(:,:,:,:) = ( ZIMMNT(:,:,:,:) ) *ZINV_TSTEP
-IF ( LHHONI_LIMA ) ZW_HOMFS(:,:,:) = ( ZHOMFT(:,:,:) ) *ZINV_TSTEP
-!
-ZW_THS(:,:,:) = ZTHT(:,:,:) * ZINV_TSTEP
-!
-!*** 7.3 Final tendencies
-!
-! Mixing ratios
-!
-PRS(:,:,:,1) = ZW_RVS(:,:,:)
-IF ( KRR .GE. 2 ) PRS(:,:,:,2) = ZW_RCS(:,:,:)
-IF ( KRR .GE. 3 ) PRS(:,:,:,3) = ZW_RRS(:,:,:)
-IF ( KRR .GE. 4 ) PRS(:,:,:,4) = ZW_RIS(:,:,:)
-IF ( KRR .GE. 5 ) PRS(:,:,:,5) = ZW_RSS(:,:,:)
-IF ( KRR .GE. 6 ) PRS(:,:,:,6) = ZW_RGS(:,:,:)
-IF ( KRR .GE. 7 ) PRS(:,:,:,7) = ZW_RHS(:,:,:)
-!
-IF ( LWARM_LIMA ) PSVS(:,:,:,NSV_LIMA_NC) = ZW_CCS(:,:,:)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PSVS(:,:,:,NSV_LIMA_NR) = ZW_CRS(:,:,:)
-IF ( LCOLD_LIMA ) PSVS(:,:,:,NSV_LIMA_NI) = ZW_CIS(:,:,:)
-!
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZW_CCNFS(:,:,:,:)
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZW_CCNAS(:,:,:,:)
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = ZW_IFNFS(:,:,:,:)
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZW_IFNNS(:,:,:,:)
-IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZW_IMMNS(:,:,:,:)
-IF ( LCOLD_LIMA .AND. LHHONI_LIMA ) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZW_HOMFS(:,:,:)
-!
-PTHS(:,:,:) = ZW_THS(:,:,:)
-!
-! Call budgets
-!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_EVAP(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_IMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_BERFI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_RIM(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_ACC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_GMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RV) THEN
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RC) THEN
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ! impact of rain evap !!!!!!
- ZRCS(:,:,:) = ZRCS(:,:,:)
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_RIM(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RR) THEN
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_ACC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RI) THEN
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RS) THEN
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_RIM(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_HMS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_ACC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RG) THEN
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_RIM(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_ACC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_CFRZ(:,:,:)/PTSTEP - ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_HMG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_RH) THEN
- ZRHS(:,:,:) = ZRHS(:,:,:) + ZTOT_RH_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- IF (LBUDGET_SV) THEN
- !
- ! Cloud droplets
- !
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_SELF(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ! impact of rain evap !!!!!!
- ZCCS(:,:,:) = ZCCS(:,:,:)
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_RIM(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- !
- ! Rain drops
- !
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_AUTO(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_SCBU(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ! Rain evaporation !!!!!!!!!!!!!
- ZCRS(:,:,:) = ZCRS(:,:,:)
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_BRKU(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'BRKU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_HONR(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_ACC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- !
- ! Ice crystals
- !
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMS(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_WETG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMG(:,:,:)/PTSTEP
- CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
-
-!!$ ZTOT_RC_WETH(I1(II),I2(II),I3(II)) = ZTOT_RC_WETH(I1(II),I2(II),I3(II)) + Z_RC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_WETH(I1(II),I2(II),I3(II)) = ZTOT_CC_WETH(I1(II),I2(II),I3(II)) + Z_CC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_WETH(I1(II),I2(II),I3(II)) = ZTOT_RR_WETH(I1(II),I2(II),I3(II)) + Z_RR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_WETH(I1(II),I2(II),I3(II)) = ZTOT_CR_WETH(I1(II),I2(II),I3(II)) + Z_CR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RI_WETH(I1(II),I2(II),I3(II)) = ZTOT_RI_WETH(I1(II),I2(II),I3(II)) + Z_RI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CI_WETH(I1(II),I2(II),I3(II)) = ZTOT_CI_WETH(I1(II),I2(II),I3(II)) + Z_CI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RS_WETH(I1(II),I2(II),I3(II)) = ZTOT_RS_WETH(I1(II),I2(II),I3(II)) + Z_RS_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_WETH(I1(II),I2(II),I3(II)) = ZTOT_RG_WETH(I1(II),I2(II),I3(II)) + Z_RG_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RH_WETH(I1(II),I2(II),I3(II)) = ZTOT_RH_WETH(I1(II),I2(II),I3(II)) + Z_RH_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
-
-END IF
-!
-END SUBROUTINE LIMA
diff --git a/src/arome/micro/lima_adjust.F90 b/src/arome/micro/lima_adjust.F90
deleted file mode 100644
index fd7e8f5cd090d0f6936cc2fc43cca5ec3803d1a8..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_adjust.F90
+++ /dev/null
@@ -1,1229 +0,0 @@
-! #######################
- MODULE MODI_LIMA_ADJUST
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE LIMA_ADJUST(KRR, KMI, HFMFILE, HLUOUT, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR, &
- YDDDH, YDLDDH, YDMDDH )
- !
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-END SUBROUTINE LIMA_ADJUST
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_ADJUST
-!
-! ##########################################################################
- SUBROUTINE LIMA_ADJUST(KRR, KMI, HFMFILE, HLUOUT, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR, &
- YDDDH, YDLDDH, YDMDDH )
-! ##########################################################################
-!
-!!**** *MIMA_ADJUST* - compute the fast microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the fast microphysical sources
-!! through an explict scheme and a saturation ajustement procedure.
-!!
-!!
-!!** METHOD
-!! ------
-!! Reisin et al., 1996 for the explicit scheme when ice is present
-!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
-!! (refer also to book 1 of the documentation).
-!!
-!! Computations are done separately for three cases :
-!! - ri>0 and rc=0
-!! - rc>0 and ri=0
-!! - ri>0 and rc>0
-!!
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
-!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
-!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
-!! XCL ! Cl (liquid)
-!! XTT ! Triple point temperature
-!! XLVTT ! Vaporization heat constant
-!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
-!! ! pressure function
-!! Module MODD_CONF
-!! CCONF
-!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! NBUPROCCTR
-!! LBU_RTH
-!! LBU_RRV
-!! LBU_RRC
-!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
-!! XNA declaration (cloud fraction as global var)
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
-!! Langlois, Tellus, 1973
-!!
-!! AUTHOR
-!! ------
-!! E. Richard * Laboratoire d'Aerologie*
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CONF
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-USE MODD_PARAM_LIMA_COLD
-USE MODD_PARAM_LIMA_MIXED
-USE MODD_NSV
-USE MODD_BUDGET
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODI_LIMA_FUNCTIONS
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-! 3D Microphysical variables
-REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
- :: PRVT, & ! Water vapor m.r. at t
- PRCT, & ! Cloud water m.r. at t
- PRRT, & ! Rain water m.r. at t
- PRIT, & ! Cloud ice m.r. at t
- PRST, & ! Aggregate m.r. at t
- PRGT, & ! Graupel m.r. at t
-!
- PRVS, & ! Water vapor m.r. source
- PRCS, & ! Cloud water m.r. source
- PRRS, & ! Rain water m.r. source
- PRIS, & ! Cloud ice m.r. source
- PRSS, & ! Aggregate m.r. source
- PRGS, & ! Graupel m.r. source
-!
- PCCT, & ! Cloud water conc. at t
- PCIT, & ! Cloud ice conc. at t
-!
- PCCS, & ! Cloud water C. source
- PMAS, & ! Mass of scavenged AP
- PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
- :: PNFS, & ! Free CCN C. source
- PNAS, & ! Activated CCN C. source
- PIFS, & ! Free IFN C. source
- PINS, & ! Nucleated IFN C. source
- PNIS ! Acti. IMM. nuclei C. source
-!
-!
-!
-REAL :: ZEPS ! Mv/Md
-REAL :: ZDT ! Time increment (2*Delta t or Delta t if cold start)
-REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
- :: ZEXNS,& ! guess of the Exner function at t+1
- ZT, & ! guess of the temperature at t+1
- ZCPH, & ! guess of the CPh for the mixing
- ZW, &
- ZW1, &
- ZW2, &
- ZLV, & ! guess of the Lv at t+1
- ZLS, & ! guess of the Ls at t+1
- ZMASK
-LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
- :: GMICRO, GMICRO_RI, GMICRO_RC ! Test where to compute cond/dep proc.
-INTEGER :: IMICRO
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRVT, ZRCT, ZRIT, ZRVS, ZRCS, ZRIS, ZTHS, &
- ZCCT, ZCIT, ZCCS, ZCIS, &
- ZRHODREF, ZZT, ZPRES, ZEXNREF, ZZCPH, &
- ZZW, ZLVFACT, ZLSFACT, &
- ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
- ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
- ZAWI, ZAII, ZFACT, ZDELTW, &
- ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP
-!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILENG ! Length of comment string in LFIFM file
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-INTEGER :: IKB ! K index value of the first inner mass point
-INTEGER :: IKE ! K index value of the last inner mass point
-INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
-INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
-INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
-INTEGER :: ILUOUT ! Logical unit of output listing
-CHARACTER (LEN=100) :: YCOMMENT ! Comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-!
-INTEGER :: ISIZE
-REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
-REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
-!
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
-!
-INTEGER , DIMENSION(3) :: BV
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
-!
-IIB = 1 + JPHEXT
-IIE = SIZE(PRHODJ,1) - JPHEXT
-IJB = 1 + JPHEXT
-IJE = SIZE(PRHODJ,2) - JPHEXT
-IKB = 1 + JPVEXT
-IKE = SIZE(PRHODJ,3) - JPVEXT
-!
-ZEPS= XMV / XMD
-!
-IF (OSUBG_COND) THEN
- ITERMAX=2
-ELSE
- ITERMAX=1
-END IF
-!
-ZDT = PTSTEP
-!
-ISIZE = SIZE(XRTMIN)
-ALLOCATE(ZRTMIN(ISIZE))
-ZRTMIN(:) = XRTMIN(:) / ZDT
-ISIZE = SIZE(XCTMIN)
-ALLOCATE(ZCTMIN(ISIZE))
-ZCTMIN(:) = XCTMIN(:) / ZDT
-!
-! Prepare 3D water mixing ratios
-PRVT(:,:,:) = PRT(:,:,:,1)
-PRVS(:,:,:) = PRS(:,:,:,1)
-!
-PRCT(:,:,:) = 0.
-PRCS(:,:,:) = 0.
-PRRT(:,:,:) = 0.
-PRRS(:,:,:) = 0.
-PRIT(:,:,:) = 0.
-PRIS(:,:,:) = 0.
-PRST(:,:,:) = 0.
-PRSS(:,:,:) = 0.
-PRGT(:,:,:) = 0.
-PRGS(:,:,:) = 0.
-!
-IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
-IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
-IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
-IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
-IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
-IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
-IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
-IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
-IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
-IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
-!
-! Prepare 3D number concentrations
-PCCT(:,:,:) = 0.
-PCIT(:,:,:) = 0.
-PCCS(:,:,:) = 0.
-PCIS(:,:,:) = 0.
-!
-IF ( LWARM_LIMA ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD_LIMA ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
-!
-IF ( LWARM_LIMA ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD_LIMA ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-!
-IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
-!
-IF ( LWARM_LIMA .AND. NMOD_CCN.GE.1 ) THEN
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-END IF
-!
-IF ( LCOLD_LIMA .AND. NMOD_IFN .GE. 1 ) THEN
- ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
- PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-END IF
-!
-IF ( NMOD_IMM .GE. 1 ) THEN
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
- PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
-! -------------------------------------------------------
-!
-!* 2.1 remove negative non-precipitating negative water
-! ------------------------------------------------
-!
-IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
- WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
- WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
- WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
-END IF
-!
-WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
- PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
-END WHERE
-!
-!* 2.2 estimate the Exner function at t+1
-!
-ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
-!
-! beginning of the iterative loop
-!
-DO JITER =1,ITERMAX
-!
-!* 2.3 compute the intermediate temperature at t+1, T*
-!
- ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
-!
-!* 2.4 compute the specific heat for moist air (Cph) at t+1
-!
- ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
- + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
- + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
-!
-!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
-! and of sublimation Ls(T*) at t+1
-!
- ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
- ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
-! ---------------------------------------
-!
- IF ( OSUBG_COND ) THEN
-!
-! not yet available
-!
- STOP
- ELSE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. FULLY EXPLICIT SCHEME FROM TZIVION et al. (1989)
-! -----------------------------------------------
-!
-!* select cases where r_i>0 and r_c=0
-!
-GMICRO(:,:,:) = .FALSE.
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- (PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
- PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
- .AND. .NOT. (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
- PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
-GMICRO_RI(:,:,:) = GMICRO(:,:,:)
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-IF( IMICRO >= 1 ) THEN
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRIT(IMICRO))
- ALLOCATE(ZCIT(IMICRO))
-!
- ALLOCATE(ZRVS(IMICRO))
- ALLOCATE(ZRIS(IMICRO))
- ALLOCATE(ZCIS(IMICRO)) !!!BVIE!!!
- ALLOCATE(ZTHS(IMICRO))
-!
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZEXNREF(IMICRO))
- ALLOCATE(ZZCPH(IMICRO))
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL)) !!!BVIE!!!
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZLSFACT(IMICRO))
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
- ALLOCATE(ZRVSATI(IMICRO))
- ALLOCATE(ZRVSATI_PRIME(IMICRO))
- ALLOCATE(ZDELTI(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
- ALLOCATE(ZITI(IMICRO))
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
- ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
- * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
-!
- ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
- ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
- /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
- ! Lbda_I
- ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
- / (ZRVSATI(:)*ZAI(:))
-!
- ALLOCATE(ZAII(IMICRO))
- ALLOCATE(ZDEP(IMICRO))
-!
- ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
- ZDEP(:) = 0.0
-!
- ZZW(:) = ZAII(:)*ZITI(:)*ZDT ! R*delta_T
- WHERE( ZZW(:)<1.0E-2 )
- ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - (ZZW(:)/2.0)*(1.0-ZZW(:)/3.0))
- ELSEWHERE
- ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - EXP(-ZZW(:)))/ZZW(:)
- END WHERE
-!
-! Integration
-!
- WHERE( ZDEP(:) < 0.0 )
- ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
- ELSEWHERE
- ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
-! ZDEP(:) = MIN ( ZDEP(:), ZCIS(:)*5.E-10 ) !!!BVIE!!!
- END WHERE
- WHERE( ZRIS(:) < ZRTMIN(4) )
- ZDEP(:) = 0.0
- END WHERE
- ZRVS(:) = ZRVS(:) - ZDEP(:)
- ZRIS(:) = ZRIS(:) + ZDEP(:)
- ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
-!
-! Implicit ice crystal sublimation if ice saturated conditions are not met
-!
- ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
- WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
- ZZW(:) = ZRVS(:) + ZRIS(:)
- ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
- ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
- * ZLSFACT(:) / ZEXNREF(:)
- ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
- END WHERE
-!
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZCIS) !!!BVIE!!!
- DEALLOCATE(ZTHS)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZZCPH)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZRVSATI)
- DEALLOCATE(ZRVSATI_PRIME)
- DEALLOCATE(ZDELTI)
- DEALLOCATE(ZAI)
- DEALLOCATE(ZCJ)
- DEALLOCATE(ZKA)
- DEALLOCATE(ZDV)
- DEALLOCATE(ZITI)
- DEALLOCATE(ZAII)
- DEALLOCATE(ZDEP)
-END IF ! IMICRO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. FULLY IMPLICIT CONDENSATION SCHEME
-! ---------------------------------
-!
-!* select cases where r_c>0 and r_i=0
-!
-!
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
- PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) ) &
- .AND. .NOT. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
- PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) )
-GMICRO_RC(:,:,:) = GMICRO(:,:,:)
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-IF( IMICRO >= 1 ) THEN
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRCT(IMICRO))
-!
- ALLOCATE(ZRVS(IMICRO))
- ALLOCATE(ZRCS(IMICRO))
- ALLOCATE(ZTHS(IMICRO))
-!
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZEXNREF(IMICRO))
- ALLOCATE(ZZCPH(IMICRO))
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZLVFACT(IMICRO))
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
- ALLOCATE(ZRVSATW(IMICRO))
- ALLOCATE(ZRVSATW_PRIME(IMICRO))
-!
- ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
- ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
- * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
- ALLOCATE(ZAWW(IMICRO))
- ALLOCATE(ZDELT1(IMICRO))
- ALLOCATE(ZDELT2(IMICRO))
- ALLOCATE(ZCND(IMICRO))
-!
- ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
- ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
- ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
- + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
- ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
- ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
-!
-! Integration
-!
- WHERE( ZCND(:) < 0.0 )
- ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
- ELSEWHERE
- ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
- END WHERE
- ZRVS(:) = ZRVS(:) - ZCND(:)
- ZRCS(:) = ZRCS(:) + ZCND(:)
- ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZTHS)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZZCPH)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZRVSATW)
- DEALLOCATE(ZRVSATW_PRIME)
- DEALLOCATE(ZAWW)
- DEALLOCATE(ZDELT1)
- DEALLOCATE(ZDELT2)
- DEALLOCATE(ZCND)
-END IF ! IMICRO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. IMPLICIT-EXPLICIT SCHEME USING REISIN et al. (1996)
-! ---------------------------------------------------
-!
-!* select cases where r_i>0 and r_c>0 (supercooled water)
-!
-!
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. .NOT. GMICRO_RC(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
- PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
- .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
- PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-IF( IMICRO >= 1 ) THEN
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRCT(IMICRO))
- ALLOCATE(ZRIT(IMICRO))
- ALLOCATE(ZCCT(IMICRO))
- ALLOCATE(ZCIT(IMICRO))
-!
- ALLOCATE(ZRVS(IMICRO))
- ALLOCATE(ZRCS(IMICRO))
- ALLOCATE(ZRIS(IMICRO))
- ALLOCATE(ZCCS(IMICRO))
- ALLOCATE(ZCIS(IMICRO))
- ALLOCATE(ZTHS(IMICRO))
-!
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZEXNREF(IMICRO))
- ALLOCATE(ZZCPH(IMICRO))
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZLVFACT(IMICRO))
- ALLOCATE(ZLSFACT(IMICRO))
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
- ALLOCATE(ZRVSATW(IMICRO))
- ALLOCATE(ZRVSATI(IMICRO))
- ALLOCATE(ZRVSATW_PRIME(IMICRO))
- ALLOCATE(ZRVSATI_PRIME(IMICRO))
- ALLOCATE(ZDELTW(IMICRO))
- ALLOCATE(ZDELTI(IMICRO))
- ALLOCATE(ZAW(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
- ALLOCATE(ZITW(IMICRO))
- ALLOCATE(ZITI(IMICRO))
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
-!
-!* 6.2 implicit adjustment at water saturation
-!
- ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
- ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
- * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
- ZDELTW(:) = ABS( ZRVS(:)*ZDT - ZRVSATW(:) )
- ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
- ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
- * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
- ZDELTI(:) = ABS( ZRVS(:)*ZDT - ZRVSATI(:) )
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
-!
- ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCT(:),XCTMIN(2)) &
- /(MAX(ZRCT(:),XRTMIN(2))) )**XLBEXC)
- ! Lbda_c
- ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
- / (ZRVSATW(:)*ZAW(:))
- ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
- /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
- ! Lbda_I
- ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
- / (ZRVSATI(:)*ZAI(:))
-!
- ALLOCATE(ZAWW(IMICRO))
- ALLOCATE(ZAIW(IMICRO))
- ALLOCATE(ZAWI(IMICRO))
- ALLOCATE(ZAII(IMICRO))
-!
- ALLOCATE(ZFACT(IMICRO))
- ALLOCATE(ZDELT1(IMICRO))
- ALLOCATE(ZDELT2(IMICRO))
-!
- ZAII(:) = ZITI(:)*ZDELTI(:)
- WHERE( ZAII(:)<1.0E-15 )
- ZFACT(:) = ZLVFACT(:)
- ELSEWHERE
- ZFACT(:) = (ZLVFACT(:)*ZITW(:)*ZDELTW(:)+ZLSFACT(:)*ZITI(:)*ZDELTI(:)) &
- / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
- END WHERE
- ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZFACT(:)
-!
- ZDELT2(:) = (ZRVSATW_PRIME(:)*ZFACT(:)/ZAWW(:)) * &
- ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
- + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
- ZDELT1(:) = (ZFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
-!
- ALLOCATE(ZCND(IMICRO))
- ALLOCATE(ZDEP(IMICRO))
- ZCND(:) = 0.0
- ZDEP(:) = 0.0
-!
- ZZW(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZFACT(:)*ZDT)
- WHERE( ZAII(:)<1.0E-15 )
- ZCND(:) = ZZW(:)
- ZDEP(:) = 0.0
- ELSEWHERE
- ZCND(:) = ZZW(:)*ZITW(:)*ZDELTW(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
- ZDEP(:) = ZZW(:)*ZITI(:)*ZDELTI(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
- END WHERE
-!
-! Integration
-!
- WHERE( ZCND(:) < 0.0 )
- ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
- ELSEWHERE
- ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
- END WHERE
- ZRVS(:) = ZRVS(:) - ZCND(:)
- ZRCS(:) = ZRCS(:) + ZCND(:)
- ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
-!
- WHERE( ZDEP(:) < 0.0 )
- ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
- ELSEWHERE
- ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
- END WHERE
- ZRVS(:) = ZRVS(:) - ZDEP(:)
- ZRIS(:) = ZRIS(:) + ZDEP(:)
- ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
-!
-!* 6.3 explicit integration of the final eva/dep rates
-!
- ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
-!
-! If Si < 0, implicit adjustment to Si=0 using ice only
-!
- WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
- ZZW(:) = ZRVS(:) + ZRIS(:)
- ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
- ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
- * ZLSFACT(:) / ZEXNREF(:)
- ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
- END WHERE
-!
-! Following the previous adjustment, the real procedure begins
-!
- ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
-!
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
-!
- ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
- ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
- * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
- ZDELTW(:) = ZRVS(:)*ZDT - ZRVSATW(:)
- ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
- ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
- * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
- ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
-!
- ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCS(:),ZCTMIN(2)) &
- /(MAX(ZRCS(:),ZRTMIN(2))) )**XLBEXC)
- ! Lbda_c
- ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
- / (ZRVSATW(:)*ZAW(:))
- ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIS(:),ZCTMIN(4)) &
- /(MAX(ZRIS(:),ZRTMIN(4))) )**XLBEXI)
- ! Lbda_I
- ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
- / (ZRVSATI(:)*ZAI(:))
-!
- ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
- ZAIW(:) = 1.0 + ZRVSATI_PRIME(:)*ZLVFACT(:)
- ZAWI(:) = 1.0 + ZRVSATW_PRIME(:)*ZLSFACT(:)
- ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
-!
- ZCND(:) = 0.0
- ZDEP(:) = 0.0
- ZZW(:) = ZAWW(:)*ZITW(:) + ZAII(:)*ZITI(:) ! R
- WHERE( ZZW(:)<1.0E-2 )
- ZFACT(:) = ZDT*(0.5 - (ZZW(:)*ZDT)/6.0)
- ELSEWHERE
- ZFACT(:) = (1.0/ZZW(:))*(1.0-(1.0-EXP(-ZZW(:)*ZDT))/(ZZW(:)*ZDT))
- END WHERE
- ZCND(:) = ZITW(:)*(ZDELTW(:)-( ZAWW(:)*ZITW(:)*ZDELTW(:) &
- + ZAWI(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
- ZDEP(:) = ZITI(:)*(ZDELTI(:)-( ZAIW(:)*ZITW(:)*ZDELTW(:) &
- + ZAII(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
-!
-! Integration
-!
- WHERE( ZCND(:) < 0.0 )
- ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
- ELSEWHERE
- ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
- END WHERE
- WHERE( ZRCS(:) < ZRTMIN(2) )
- ZCND(:) = 0.0
- END WHERE
- ZRVS(:) = ZRVS(:) - ZCND(:)
- ZRCS(:) = ZRCS(:) + ZCND(:)
- ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
-!
- WHERE( ZDEP(:) < 0.0 )
- ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
- ELSEWHERE
- ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
- END WHERE
- WHERE( ZRIS(:) < ZRTMIN(4) )
- ZDEP(:) = 0.0
- END WHERE
- ZRVS(:) = ZRVS(:) - ZDEP(:)
- ZRIS(:) = ZRIS(:) + ZDEP(:)
- ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
-!
-! Implicit ice crystal sublimation if ice saturated conditions are not met
-!
- ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
- WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
- ZZW(:) = ZRVS(:) + ZRIS(:)
- ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
- ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
- * ZLSFACT(:) / ZEXNREF(:)
- ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
- END WHERE
-!
-!
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZCIS)
- DEALLOCATE(ZTHS)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZZCPH)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZRVSATW)
- DEALLOCATE(ZRVSATI)
- DEALLOCATE(ZRVSATW_PRIME)
- DEALLOCATE(ZRVSATI_PRIME)
- DEALLOCATE(ZDELTW)
- DEALLOCATE(ZDELTI)
- DEALLOCATE(ZAW)
- DEALLOCATE(ZAI)
- DEALLOCATE(ZCJ)
- DEALLOCATE(ZKA)
- DEALLOCATE(ZDV)
- DEALLOCATE(ZITW)
- DEALLOCATE(ZITI)
- DEALLOCATE(ZAWW)
- DEALLOCATE(ZAIW)
- DEALLOCATE(ZAWI)
- DEALLOCATE(ZAII)
- DEALLOCATE(ZFACT)
- DEALLOCATE(ZDELT1)
- DEALLOCATE(ZDELT2)
- DEALLOCATE(ZCND)
- DEALLOCATE(ZDEP)
-END IF ! IMICRO
-!
-END IF ! OSUBG_COND
-!
-! full sublimation of the cloud ice crystals if there are few
-!
-ZMASK(:,:,:) = 0.0
-ZW(:,:,:) = 0.
-WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
- PRVS(:,:,:) = PRVS(:,:,:) + PRIS(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - PRIS(:,:,:)*ZLS(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
- PRIS(:,:,:) = 0.0
- ZW(:,:,:) = MAX(PCIS(:,:,:),0.)
- PCIS(:,:,:) = 0.0
-END WHERE
-!
-IF (LCOLD_LIMA .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
- ZW1(:,:,:) = 0.
- IF (NMOD_IFN .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PINS,DIM=4)
- IF (NMOD_IMM .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PNIS,DIM=4)
- ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
- ZW2(:,:,:) = 0.
- WHERE ( ZW(:,:,:) > 0. )
- ZMASK(:,:,:) = 1.0
- ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
- ENDWHERE
-END IF
-!
-IF (LCOLD_LIMA .AND. NMOD_IFN.GE.1) THEN
- DO JMOD_IFN = 1, NMOD_IFN
- PIFS(:,:,:,JMOD_IFN) = PIFS(:,:,:,JMOD_IFN) + &
- ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
- PINS(:,:,:,JMOD_IFN) = PINS(:,:,:,JMOD_IFN) - &
- ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
- PINS(:,:,:,JMOD_IFN) = MAX( 0.0 , PINS(:,:,:,JMOD_IFN) )
- ENDDO
-END IF
-!
-IF (LCOLD_LIMA .AND. NMOD_IMM.GE.1) THEN
- JMOD_IMM = 0
- DO JMOD = 1, NMOD_CCN
- IF (NIMM(JMOD) == 1) THEN
- JMOD_IMM = JMOD_IMM + 1
- PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
- ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
- PNIS(:,:,:,JMOD_IMM) = PNIS(:,:,:,JMOD_IMM) - &
- ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
- PNIS(:,:,:,JMOD_IMM) = MAX( 0.0 , PNIS(:,:,:,JMOD_IMM) )
- END IF
- ENDDO
-END IF
-!
-! complete evaporation of the cloud droplets if there are few
-!
-ZMASK(:,:,:) = 0.0
-ZW(:,:,:) = 0.
-WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
- PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
- PRCS(:,:,:) = 0.0
- ZW(:,:,:) = MAX(PCCS(:,:,:),0.)
- PCCS(:,:,:) = 0.0
-END WHERE
-!
-ZW1(:,:,:) = 0.
-IF (LWARM_LIMA .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
-ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
-ZW2(:,:,:) = 0.
-WHERE ( ZW(:,:,:) > 0. )
- ZMASK(:,:,:) = 1.0
- ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
-ENDWHERE
-!
-IF (LWARM_LIMA .AND. NMOD_CCN.GE.1) THEN
- DO JMOD = 1, NMOD_CCN
- PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
- ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
- PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - &
- ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
- PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) )
- ENDDO
-END IF
-!
-IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
-!
-! end of the iterative loop
-!
-END DO
-!
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
-!
-!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
-!
-IF ( .NOT. OSUBG_COND ) THEN
- WHERE (PRCS(:,:,:) > 1.E-12 / ZDT)
- ZW(:,:,:) = 1.
- ELSEWHERE
- ZW(:,:,:) = 0.
- ENDWHERE
- IF ( SIZE(PSRCS,3) /= 0 ) THEN
- PSRCS(:,:,:) = ZW(:,:,:)
- END IF
-END IF
-!
-IF ( HRAD /= 'NONE' ) THEN
- PCLDFR(:,:,:) = ZW(:,:,:)
-END IF
-!
-IF ( OCLOSE_OUT ) THEN
- ILENCH=LEN(YCOMMENT)
- YRECFM ='NEB'
- YCOMMENT='X_Y_Z_NEB (0)'
- IGRID = 1
- ILENG = SIZE(ZW,1)*SIZE(ZW,2)*SIZE(ZW,3)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZW,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-!
-!* 6. SAVE CHANGES IN PRS AND PSVS
-! ----------------------------
-!
-!
-! Prepare 3D water mixing ratios
-PRS(:,:,:,1) = PRVS(:,:,:)
-IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
-IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
-IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
-IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
-IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
-!
-! Prepare 3D number concentrations
-!
-IF ( LWARM_LIMA ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LCOLD_LIMA ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
-!
-IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
-!
-IF ( LWARM_LIMA .AND. NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
-END IF
-!
-IF ( LCOLD_LIMA .AND. NMOD_IFN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
-END IF
-!
-IF ( LCOLD_LIMA .AND. NMOD_IMM .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
-END IF
-!
-! write SSI in LFI
-!
-IF ( OCLOSE_OUT ) THEN
- ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
- ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
- ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
- ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
-
- ILENCH=LEN(YCOMMENT)
- YRECFM ='SSI'
- YCOMMENT='X_Y_Z_SSI'
- IGRID = 1
- ILENG = SIZE(ZW,1)*SIZE(ZW,2)*SIZE(ZW,3)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZW,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-!
-!* 7. STORE THE BUDGET TERMS
-! ----------------------
-!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,'CEDS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:) * PRHODJ(:,:,:),6,'CEDS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:) * PRHODJ(:,:,:),7,'CEDS_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:) * PRHODJ(:,:,:),9,'CEDS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCCS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- CALL BUDGET_DDH (PCIS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
- IF (NMOD_CCN .GE. 1) THEN
- DO JL = 1, NMOD_CCN
- CALL BUDGET_DDH (PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- END DO
- END IF
- IF (NMOD_IFN .GE. 1) THEN
- DO JL = 1, NMOD_IFN
- CALL BUDGET_DDH (PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- END DO
- END IF
- END IF
-END IF
-
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
-IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
-IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
-
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_ADJUST
diff --git a/src/arome/micro/lima_bergeron.F90 b/src/arome/micro/lima_bergeron.F90
deleted file mode 100644
index 63677da20cf0a6db2a08eb48ea66320b968a79fc..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_bergeron.F90
+++ /dev/null
@@ -1,127 +0,0 @@
-! #################################
- MODULE MODI_LIMA_BERGERON
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_BERGERON (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI, &
- PA_TH, PA_RC, PA_RI )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-!!
-END SUBROUTINE LIMA_BERGERON
-END INTERFACE
-END MODULE MODI_LIMA_BERGERON
-!
-! ######################################################################
- SUBROUTINE LIMA_BERGERON(HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI, &
- PA_TH, PA_RC, PA_RI )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-!
-!* 0.2 Declarations of local variables :
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-P_TH_BERFI(:) = 0.0
-P_RC_BERFI(:) = 0.0
-!
-WHERE( (PRCT(:)>XRTMIN(2)) .AND. (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) .AND. LDCOMPUTE(:))
-! ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
-! - (XGAMW-XGAMI)*ALOG(ZZT(:)) ) -1.0
-! supersaturation over ice at water saturation
- P_RC_BERFI(:) = - ( PSSIW(:) / PAI(:) ) * PCIT(:) * &
- ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) )
- P_TH_BERFI(:) = - P_RC_BERFI(:)*(PLSFACT(:)-PLVFACT(:))
-END WHERE
-!
-PA_RC(:) = PA_RC(:) + P_RC_BERFI(:)
-PA_RI(:) = PA_RI(:) - P_RC_BERFI(:)
-PA_TH(:) = PA_TH(:) + P_TH_BERFI(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_BERGERON
diff --git a/src/arome/micro/lima_ccn_activation.F90 b/src/arome/micro/lima_ccn_activation.F90
deleted file mode 100644
index a4824192b76ee45437af77e580d16b9be1d74ce7..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_ccn_activation.F90
+++ /dev/null
@@ -1,766 +0,0 @@
-! ###############################
- MODULE MODI_LIMA_CCN_ACTIVATION
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-!
-END SUBROUTINE LIMA_CCN_ACTIVATION
-END INTERFACE
-END MODULE MODI_LIMA_CCN_ACTIVATION
-! #############################################################################
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
-! #############################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the activation of CCN
-!! according to Cohard and Pinty, QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration.
-!!
-!! Computation steps :
-!! 1- Check where computations are necessary
-!! 2- and 3- Compute the maximum of supersaturation using the iterative
-!! Ridder algorithm
-!! 4- Compute the nucleation source
-!! 5- Deallocate local variables
-!!
-!! Contains :
-!! 6- Functions : Ridder algorithm
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
-USE MODD_PARAM_LIMA, ONLY : LACTIT_LIMA, NMOD_CCN, XKHEN_MULTI, XCTMIN, XLIMIT_FACTOR
-USE MODD_PARAM_LIMA_WARM, ONLY : XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
- XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XPSI1
-!
-USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-!
-!
-!* 0.1 Declarations of local variables :
-!
-! Packing variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GNUCT
-INTEGER :: INUCT
-INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed micophysical variables
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! activated nucleus conc. source
-!
-! Other packed variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
-!
-! Work arrays
-REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
- ZZTDT, & ! dT/dt
- ZSMAX, & ! Maximum supersaturation
- ZVEC1
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZTDT, ZDRC, ZRVSAT, ZW
-REAL, DIMENSION(SIZE(PNFT,1),SIZE(PNFT,2),SIZE(PNFT,3)) &
- :: ZCONC_TOT ! total CCN C. available
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
- ! interpolations
-!
-!
-REAL :: ZEPS ! molar mass ratio
-REAL :: ZS1, ZS2, ZXACC
-INTEGER :: JMOD
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PREPARE COMPUTATIONS - PACK
-! ---------------------------
-!
-IIB=1+JPHEXT
-IIE=SIZE(PRHODREF,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PRHODREF,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PRHODREF,3) - JPVEXT
-!
-! Saturation vapor mixing ratio and radiative tendency
-!
-ZEPS= XMV / XMD
-!
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
-ZTDT(:,:,:) = 0.
-!! ZDRC(:,:,:) = 0.
-IF (LACTIT_LIMA) THEN
- ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
-!!! ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
-!! ZDRC(:,:,:) = PRCS(:,:,:)-(PRCT(:,:,:)/PTSTEP) ! drc/dt
-!!
-!! BV - W and drc/dt effect should not be included in ZTDT (already accounted for in the computations) ?
-!!
-!! ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
-!! (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
-END IF
-!
-! find locations where CCN are available
-!
-ZCONC_TOT(:,:,:) = 0.0
-DO JMOD = 1, NMOD_CCN
- ZCONC_TOT(:,:,:) = ZCONC_TOT(:,:,:) + PNFT(:,:,:,JMOD) ! sum over the free CCN
-ENDDO
-!
-! optimization by looking for locations where
-! the updraft velocity is positive!!!
-!
-GNUCT(:,:,:) = .FALSE.
-!
-! NEW : -22°C = limit sup for condensation freezing in Fridlin et al., 2007
-IF( LACTIT_LIMA ) THEN
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
- ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
-ELSE
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
-END IF
-INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
-!
-IF( INUCT >= 1 ) THEN
-!
- ALLOCATE(ZNFT(INUCT,NMOD_CCN))
- ALLOCATE(ZNAT(INUCT,NMOD_CCN))
- ALLOCATE(ZTMP(INUCT,NMOD_CCN))
- ALLOCATE(ZZT(INUCT))
- ALLOCATE(ZZTDT(INUCT))
- ALLOCATE(ZZW1(INUCT))
- ALLOCATE(ZZW2(INUCT))
- ALLOCATE(ZZW3(INUCT))
- ALLOCATE(ZZW4(INUCT))
- ALLOCATE(ZZW5(INUCT))
- ALLOCATE(ZZW6(INUCT))
- ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
- ALLOCATE(ZVEC1(INUCT))
- ALLOCATE(IVEC1(INUCT))
- ALLOCATE(ZRHODREF(INUCT))
- ALLOCATE(ZEXNREF(INUCT))
- DO JL=1,INUCT
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
- ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
- ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- DO JMOD = 1,NMOD_CCN
- ZNFT(JL,JMOD) = PNFT(I1(JL),I2(JL),I3(JL),JMOD)
- ZNAT(JL,JMOD) = PNAT(I1(JL),I2(JL),I3(JL),JMOD)
- ZCHEN_MULTI(JL,JMOD) = (ZNFT(JL,JMOD)+ZNAT(JL,JMOD))*ZRHODREF(JL) &
- / XLIMIT_FACTOR(JMOD)
- ENDDO
- ENDDO
-!
- ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
- + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. compute the constant term (ZZW3) relative to smax
-! ----------------------------------------------------
-!
-! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
-!
-!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NAHEN)-0.00001, &
- XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
- ALLOCATE(ZSMAX(INUCT))
-!
-!
- IF (LACTIT_LIMA) THEN ! including a cooling rate
-!
-! Compute the tabulation of function of ZZW3 :
-!
-! (Psi1*w+Psi3*DT/Dt)**1.5
-! ZZW3 = XAHENG*(Psi1*w + Psi3*DT/Dt)**1.5 = ------------------------
-! 2*pi*rho_l*G**(3/2)
-!
-!
- ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZZTDT(:)
- ZZW5(:)=XPSI1( IVEC1(:) )*ZZW2(:)+XPSI3(IVEC1(:) )*ZZTDT(:)
- WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
- ZZW4(:) = 0.
- ZZW5(:) = 0.
- END WHERE
- ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
- - XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
- ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
-!
-!
- ELSE ! LACTIT_LIMA , for clouds
-!
-!
-! Compute the tabulation of function of ZZW3 :
-!
-! (Psi1 * w)**1.5
-! ZZW3 = XAHENG * (Psi1 * w)**1.5 = -------------------------
-! 2 pi rho_l * G**(3/2)
-!
-!
- ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
- -XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
-!
- END IF ! LACTIT_LIMA
-!
-!
-! (Psi1*w+Psi3*DT/Dt)**1.5 rho_air
-! ZZW3 = ------------------------ * -------
-! 2*pi*rho_l*G**(3/2) Psi2
-!
- ZZW5(:) = 1.
- ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
- ! for multiple aerosol modes
- WHERE (ZZW3(:) == 0.)
- ZZW5(:) = -1.
- END WHERE
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Compute the maximum of supersaturation
-! -----------------------------------------
-!
-!
-! estimate S_max for the CPB98 parameterization with SEVERAL aerosols mode
-! Reminder : Smax=0.01 for a 1% supersaturation
-!
-! Interval bounds to tabulate sursaturation Smax
-! Check with values used for tabulation in ini_lima_warm.f90
- ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
- ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
- ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
-!
- ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. Compute the nucleus source
-! -----------------------------
-!
-!
-! Again : Smax=0.01 for a 1% supersaturation
-! Modified values for Beta and C (see in init_aerosol_properties) account for that
-!
- WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
- END WHERE
- ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
-!
- ZTMP(:,:)=0.0
-!
-! Compute the concentration of activable aerosols for each mode
-! based on the max of supersaturation ( -> ZTMP )
-!
- DO JMOD = 1, NMOD_CCN ! iteration on mode number
- ZZW1(:) = 0.
- ZZW2(:) = 0.
- ZZW3(:) = 0.
- !
- WHERE( ZSMAX(:)>0.0 )
- ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
- - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
- !
- ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/ZRHODREF(:))*ZSMAX(:)**XKHEN_MULTI(JMOD) &
- *ZZW2(:)
- ENDWHERE
- ENDDO
-!
-! Compute the concentration of aerosols activated at this time step
-! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
-!
- DO JMOD = 1, NMOD_CCN ! iteration on mode number
- ZZW1(:) = 0.
- ZZW2(:) = 0.
- ZZW3(:) = 0.
- !
- WHERE( SUM(ZTMP(:,:),DIM=2) .GT. 25.E6/ZRHODREF(:) )
- ZZW1(:) = MIN( ZNFT(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAT(:,JMOD) , 0.0 ) )
- ENDWHERE
- !
- !* update the concentration of activated CCN = Na
- !
- PNAT(:,:,:,JMOD) = PNAT(:,:,:,JMOD) + UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
- !
- !* update the concentration of free CCN = Nf
- !
- PNFT(:,:,:,JMOD) = PNFT(:,:,:,JMOD) - UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
- !
- !* prepare to update the cloud water concentration
- !
- ZZW6(:) = ZZW6(:) + ZZW1(:)
- ENDDO
-!
-! Output tendencies
-!
- ZZW1(:)=0.
- WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
- ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
- END WHERE
- ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
-!
- PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
- PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
- PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
- (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. Cleaning
-! -----------
-!
-!
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC1)
- DEALLOCATE(ZNFT)
- DEALLOCATE(ZNAT)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZSMAX)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- DEALLOCATE(ZZW4)
- DEALLOCATE(ZZW5)
- DEALLOCATE(ZZW6)
- DEALLOCATE(ZZTDT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZCHEN_MULTI)
- DEALLOCATE(ZEXNREF)
-!
-END IF ! INUCT
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. Functions used to compute the maximum of supersaturation
-! -----------------------------------------------------------
-!
-!
-CONTAINS
-!------------------------------------------------------------------------------
-!
- FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,NPTS) RESULT(PZRIDDR)
-!
-!
-!!**** *ZRIDDR* - iterative algorithm to find root of a function
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this function is to find the root of a given function
-!! the arguments are the brackets bounds (the interval where to find the root)
-!! the accuracy needed and the input parameters of the given function.
-!! Using Ridders' method, return the root of a function known to lie between
-!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
-!! accuracy PXACC.
-!!
-!!** METHOD
-!! ------
-!! Ridders' method
-!!
-!! EXTERNAL
-!! --------
-!! FUNCSMAX
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
-!! (ISBN 0-521-43064-X)
-!! Copyright (C) 1986-1992 by Cambridge University Press.
-!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
-!!
-!! AUTHOR
-!! ------
-!! Frederick Chosson *CERFACS*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/07/07
-!! S.BERTHET 2008 vectorization
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: NPTS
-REAL, DIMENSION(:), INTENT(IN) :: PZZW3
-REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
-REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
-!
-!* 0.2 declarations of local variables
-!
-!
-INTEGER, PARAMETER :: MAXIT=60
-REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
-REAL, DIMENSION(:), ALLOCATABLE :: fh,fl, fm,fnew
-REAL :: s,xh,xl,xm,xnew
-REAL :: PX2
-INTEGER :: j, JL
-!
-ALLOCATE( fh(NPTS))
-ALLOCATE( fl(NPTS))
-ALLOCATE( fm(NPTS))
-ALLOCATE(fnew(NPTS))
-ALLOCATE(PZRIDDR(NPTS))
-!
-PZRIDDR(:)= UNUSED
-PX2 = PX2INIT
-fl(:) = FUNCSMAX(PX1,PZZW3(:),NPTS)
-fh(:) = FUNCSMAX(PX2,PZZW3(:),NPTS)
-!
-DO JL = 1, NPTS
- PX2 = PX2INIT
-100 if ((fl(JL) > 0.0 .and. fh(JL) < 0.0) .or. (fl(JL) < 0.0 .and. fh(JL) > 0.0)) then
- xl = PX1
- xh = PX2
- do j=1,MAXIT
- xm = 0.5*(xl+xh)
- fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),JL)
- s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
- if (s == 0.0) then
- GO TO 101
- endif
- xnew = xm+(xm-xl)*(sign(1.0,fl(JL)-fh(JL))*fm(JL)/s)
- if (abs(xnew - PZRIDDR(JL)) <= PXACC) then
- GO TO 101
- endif
- PZRIDDR(JL) = xnew
- fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),JL)
- if (fnew(JL) == 0.0) then
- GO TO 101
- endif
- if (sign(fm(JL),fnew(JL)) /= fm(JL)) then
- xl =xm
- fl(JL)=fm(JL)
- xh =PZRIDDR(JL)
- fh(JL)=fnew(JL)
- else if (sign(fl(JL),fnew(JL)) /= fl(JL)) then
- xh =PZRIDDR(JL)
- fh(JL)=fnew(JL)
- else if (sign(fh(JL),fnew(JL)) /= fh(JL)) then
- xl =PZRIDDR(JL)
- fl(JL)=fnew(JL)
- else if (PX2 .lt. 0.05) then
- PX2 = PX2 + 1.0E-2
- PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
- go to 100
- print*, 'PZRIDDR: never get here'
- STOP
- end if
- if (abs(xh-xl) <= PXACC) then
- GO TO 101
- endif
-!!SB
-!!$ if (j == MAXIT .and. (abs(xh-xl) > PXACC) ) then
-!!$ PZRIDDR(JL)=0.0
-!!$ go to 101
-!!$ endif
-!!SB
- end do
- print*, 'PZRIDDR: exceeded maximum iterations',j
- STOP
- else if (fl(JL) == 0.0) then
- PZRIDDR(JL)=PX1
- else if (fh(JL) == 0.0) then
- PZRIDDR(JL)=PX2
- else if (PX2 .lt. 0.05) then
- PX2 = PX2 + 1.0E-2
- PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
- go to 100
- else
-!!$ print*, 'PZRIDDR: root must be bracketed'
-!!$ print*,'npts ',NPTS,'jl',JL
-!!$ print*, 'PX1,PX2,fl,fh',PX1,PX2,fl(JL),fh(JL)
-!!$ print*, 'PX2 = 30 % of supersaturation, there is no solution for Smax'
-!!$ print*, 'try to put greater PX2 (upper bound for Smax research)'
-!!$ STOP
- PZRIDDR(JL)=0.0
- go to 101
- end if
-101 ENDDO
-!
-DEALLOCATE( fh)
-DEALLOCATE( fl)
-DEALLOCATE( fm)
-DEALLOCATE(fnew)
-!
-END FUNCTION ZRIDDR
-!
-!------------------------------------------------------------------------------
-!
- FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,NPTS) RESULT(PFUNCSMAX)
-!
-!
-!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
-!!
-!!
-!! PURPOSE
-!! -------
-!! This function describe the equilibrium between Smax and two aerosol mode
-!! acting as CCN. This function is derive from eq. (9) of CPB98 but for two
-!! aerosols mode described by their respective parameters C, k, Mu, Beta.
-!! the arguments are the supersaturation in "no unit" and the r.h.s. of this eq.
-!! and the ratio of concentration of injected aerosols on maximum concentration
-!! of injected aerosols ever.
-!!** METHOD
-!! ------
-!! This function is called by zriddr.f90
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAM_LIMA_WARM
-!! XHYPF32
-!!
-!! XHYPINTP1
-!! XHYPINTP2
-!!
-!! Module MODD_PARAM_C2R2
-!! XKHEN_MULTI()
-!! NMOD_CCN
-!!
-!! REFERENCE
-!! ---------
-!! Cohard, J.M., J.P.Pinty, K.Suhre, 2000:"On the parameterization of activation
-!! spectra from cloud condensation nuclei microphysical properties",
-!! J. Geophys. Res., Vol.105, N0.D9, pp. 11753-11766
-!!
-!! AUTHOR
-!! ------
-!! Frederick Chosson *CERFACS*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/07/07
-!! S.Berthet 19/03/08 Extension a une population multimodale d aerosols
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: NPTS
-REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
-REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
-REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
-!
-!* 0.2 declarations of local variables
-!
-REAL :: ZHYPF
-!
-REAL :: PZVEC1
-INTEGER :: PIVEC1
-!
-ALLOCATE(PFUNCSMAX(NPTS))
-!
-PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
-PIVEC1 = INT( PZVEC1 )
-PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
-DO JMOD = 1, NMOD_CCN
- ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
- ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
- - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
- ! sum of s**(ki+2) * F32 * Ci * ki * beta(ki/2,3/2)
- PFUNCSMAX(:) = PFUNCSMAX(:) + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
- * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(:,JMOD) &
- * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
- / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
-ENDDO
-! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PFUNCSMAX(:) = PFUNCSMAX(:) - PPZZW3(:)
-!
-END FUNCTION FUNCSMAX
-!
-!------------------------------------------------------------------------------
-!
- FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,KINDEX) RESULT(PSINGL_FUNCSMAX)
-!
-!
-!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
-!!
-!!
-!! PURPOSE
-!! -------
-! As for FUNCSMAX but for a scalar
-!!
-!!** METHOD
-!! ------
-!! This function is called by zriddr.f90
-!!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: KINDEX
-REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
-REAL, INTENT(IN) :: PPZZW3 !
-REAL :: PSINGL_FUNCSMAX !
-!
-!* 0.2 declarations of local variables
-!
-REAL :: ZHYPF
-!
-REAL :: PZVEC1
-INTEGER :: PIVEC1
-!
-PSINGL_FUNCSMAX = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
-PIVEC1 = INT( PZVEC1 )
-PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
-DO JMOD = 1, NMOD_CCN
- ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
- ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
- - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
- ! sum of s**(ki+2) * F32 * Ci * ki * bêta(ki/2,3/2)
- PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
- * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(KINDEX,JMOD) &
- * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
- / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
-ENDDO
-! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PSINGL_FUNCSMAX = PSINGL_FUNCSMAX - PPZZW3
-!
-END FUNCTION SINGL_FUNCSMAX
-!
-!-----------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_CCN_ACTIVATION
diff --git a/src/arome/micro/lima_ccn_hom_freezing.F90 b/src/arome/micro/lima_ccn_hom_freezing.F90
deleted file mode 100644
index a7da41311666b48be8c8eca8f0b36c7660f91853..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_ccn_hom_freezing.F90
+++ /dev/null
@@ -1,398 +0,0 @@
-! #################################
- MODULE MODI_LIMA_CCN_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_HOM_FREEZING (HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
-!
-END SUBROUTINE LIMA_CCN_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_CCN_HOM_FREEZING
-!
-! ######################################################################
- SUBROUTINE LIMA_CCN_HOM_FREEZING (HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY : XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
- XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
- XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
- XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
- XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Theta source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! Rain water conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZNHT ! Nucleated Ice nuclei conc. source
- !by Homogeneous freezing
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZNHT ! Nucleated Ice nuclei conc. source
- ! by Homogeneous freezing of haze
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZLBDAC, & ! Slope parameter of the cloud droplet distr.
- ZSI, & ! Saturation over ice
- ZTCELSIUS,&
- ZLS, &
- ZPSI1, &
- ZPSI2, &
- ZTAU, &
- ZBFACT, &
- ZW_NU, &
- ZFREECCN, &
- ZCCNFROZEN
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
-!
-INTEGER :: INEGT ! Case number of hom. nucleation
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the hom. nucleation
-INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
-!
-REAL :: ZEPS ! molar mass ratio
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-! Physical domain
-IIB=1+JPHEXT
-IIE=SIZE(PTHT,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PTHT,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PTHT,3) - JPVEXT
-!
-! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-ZNHT(:,:,:) = PNHT(:,:,:)
-!
-! Computations only where the temperature is below -35°C
-! PACK variables
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-!
-IF (INEGT.GT.0) THEN
-
- ALLOCATE(ZRVT(INEGT))
- ALLOCATE(ZRCT(INEGT))
- ALLOCATE(ZRRT(INEGT))
- ALLOCATE(ZRIT(INEGT))
- ALLOCATE(ZRST(INEGT))
- ALLOCATE(ZRGT(INEGT))
- !
- ALLOCATE(ZTHT(INEGT))
- !
- ALLOCATE(ZCCT(INEGT))
- ALLOCATE(ZCRT(INEGT))
- ALLOCATE(ZCIT(INEGT))
- !
- ALLOCATE(ZNFT(INEGT,NMOD_CCN))
- ALLOCATE(ZZNHT(INEGT))
- !
- ALLOCATE(ZRHODREF(INEGT))
- ALLOCATE(ZZT(INEGT))
- ALLOCATE(ZPRES(INEGT))
- ALLOCATE(ZEXNREF(INEGT))
- !
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- !
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
- !
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- !
- DO JMOD_CCN = 1, NMOD_CCN
- ZNFT(JL,JMOD_CCN) = PNFT(I1(JL),I2(JL),I3(JL),JMOD_CCN)
- ENDDO
- ZZNHT(JL) = ZNHT(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
-!
-! PACK : done
-! Prepare computations
-!
- ALLOCATE( ZLSFACT (INEGT) )
- ALLOCATE( ZLVFACT (INEGT) )
- ALLOCATE( ZSI (INEGT) )
- ALLOCATE( ZTCELSIUS (INEGT) )
- ALLOCATE( ZLBDAC (INEGT) )
-!
- ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
- ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
- ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
-!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. Haze homogeneous freezing
-! ------------------------
-!
-!
-! Compute the haze homogeneous nucleation source: RHHONI
-!
- IF( NMOD_CCN.GT.0 ) THEN
-
-! Sum of the available CCN
- ALLOCATE( ZFREECCN(INEGT) )
- ALLOCATE( ZCCNFROZEN(INEGT) )
- ZFREECCN(:)=0.
- ZCCNFROZEN(:)=0.
- DO JMOD_CCN = 1, NMOD_CCN
- ZFREECCN(:) = ZFREECCN(:) + ZNFT(:,JMOD_CCN)
- END DO
-!
- ALLOCATE(ZW_NU(INEGT))
- DO JL=1,INEGT
- ZW_NU(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
- END DO
-!
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZEPS = XMV / XMD
- ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
- (MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
-!
- ALLOCATE(ZLS(INEGT))
- ALLOCATE(ZPSI1(INEGT))
- ALLOCATE(ZPSI2(INEGT))
- ALLOCATE(ZTAU(INEGT))
- ALLOCATE(ZBFACT(INEGT))
-!
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
- ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
-!
- ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
-! ! Psi1 (a1*Scr in KL01)
-! BV correction PSI2 enlever 1/ZEPS ?
-! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
- ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
- ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
-! ! Psi2 (a2+a3*Scr in KL01)
- ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
- ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
- ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHT(:) ) )
-!
- ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
-! BV correction ZBFACT enlever 1/ZEPS ?
-! * (1.0/ZRVT(:)+1.0/ZEPS) &
- * (1.0/ZRVT(:)) &
- / (XCOEF_DIFVAP_HONH*(ZZT(:)**XCEXP_DIFVAP_HONH /ZPRES(:)))
-!
-! BV correction ZZX rho_i{-1} ?
-! ZZX(:) = MAX( MIN( XRHOI_HONH*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
- ZZX(:) = MAX( MIN( (1/XRHOI_HONH)*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
- * (ZW_NU(:)/SQRT(ZTAU(:))) , ZFREECCN(:) ) , 0.)
-!
- ZZW(:) = MIN( XRCOEF_HONH*ZZX(:)*(ZTAU(:)/ZBFACT(:))**1.5 , ZRVT(:) )
- END WHERE
-!
-! Apply the changes
- DO JMOD_CCN = 1, NMOD_CCN
- WHERE(ZFREECCN(:)>1.)
- ZCCNFROZEN(:) = ZZX(:) * ZNFT(:,JMOD_CCN)/ZFREECCN(:)
- END WHERE
- PNFT(:,:,:,JMOD_CCN) = PNFT(:,:,:,JMOD_CCN) - UNPACK( ZCCNFROZEN(:), MASK=GNEGT(:,:,:),FIELD=0.)
- END DO
-!
- PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:),FIELD=0.)
- PRVT(:,:,:) = PRVT(:,:,:) - UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
- PRIT(:,:,:) = PRIT(:,:,:) + UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
- PCIT(:,:,:) = PCIT(:,:,:) + UNPACK( ZZX(:), MASK=GNEGT(:,:,:),FIELD=0.)
- PNHT(:,:,:) = PNHT(:,:,:) + UNPACK( ZZX(:), MASK=GNEGT(:,:,:),FIELD=0.)
-
- DEALLOCATE(ZFREECCN)
- DEALLOCATE(ZCCNFROZEN)
- DEALLOCATE(ZLS)
- DEALLOCATE(ZPSI1)
- DEALLOCATE(ZPSI2)
- DEALLOCATE(ZTAU)
- DEALLOCATE(ZBFACT)
- DEALLOCATE(ZW_NU)
-!
- END IF
-!
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
-!
- DEALLOCATE(ZTHT)
-!
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZCRT)
- DEALLOCATE(ZCIT)
-!
- DEALLOCATE(ZNFT)
- DEALLOCATE(ZZNHT)
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
-!
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZSI)
- DEALLOCATE(ZTCELSIUS)
- DEALLOCATE(ZLBDAC)
-!
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
-!
-!
-END IF ! INEGT>0
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_CCN_HOM_FREEZING
diff --git a/src/arome/micro/lima_cold.F90 b/src/arome/micro/lima_cold.F90
deleted file mode 100644
index 2c6030595882735561eaa737fb363c8f161bab51..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_cold.F90
+++ /dev/null
@@ -1,446 +0,0 @@
-! #####################
- MODULE MODI_LIMA_COLD
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHM, PPABSM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- PINPRS, PINPRG, PINPRH, &
- YDDDH, YDLDDH, YDMDDH)
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-END SUBROUTINE LIMA_COLD
-END INTERFACE
-END MODULE MODI_LIMA_COLD
-!
-! ######################################################################
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHM, PPABSM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- PINPRS, PINPRG, PINPRH, &
- YDDDH, YDLDDH, YDMDDH)
-! ######################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase
-!! microphysical sources involving only primary ice and snow, except for
-!! the sedimentation which also includes graupelns, and the homogeneous
-!! freezing of CCNs, cloud droplets and raindrops.
-!!
-!!
-!!** METHOD
-!! ------
-!! The nucleation of IFN is parameterized following either Meyers (1992)
-!! or Phillips (2008, 2013).
-!!
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!!
-!! REFERENCES
-!! ----------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_NSV
-USE MODD_PARAM_LIMA
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE MODI_LIMA_COLD_SEDIMENTATION
-USE MODI_LIMA_MEYERS
-USE MODI_LIMA_PHILLIPS
-USE MODI_LIMA_COLD_HOM_NUCL
-USE MODI_LIMA_COLD_SLOW_PROCESSES
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: PRVT, & ! Water vapor m.r. at t
- PRCT, & ! Cloud water m.r. at t
- PRRT, & ! Rain water m.r. at t
- PRIT, & ! Cloud ice m.r. at t
- PRST, & ! Snow/aggregate m.r. at t
- PRGT, & ! Graupel m.r. at t
- PRHT, & ! Graupel m.r. at t
- !
- PRVS, & ! Water vapor m.r. source
- PRCS, & ! Cloud water m.r. source
- PRRS, & ! Rain water m.r. source
- PRIS, & ! Pristine ice m.r. source
- PRSS, & ! Snow/aggregate m.r. source
- PRGS, & ! Graupel/hail m.r. source
- PRHS, & ! Graupel/hail m.r. source
- !
- PCCT, & ! Cloud water C. at t
- PCRT, & ! Rain water C. at t
- PCIT, & ! Ice crystal C. at t
- !
- PCCS, & ! Cloud water C. source
- PCRS, & ! Rain water C. source
- PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Haze homogeneous activation
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. 3D MICROPHYSCAL VARIABLES
-! -------------------------
-!
-!
-! Prepare 3D water mixing ratios
-PRVT(:,:,:) = PRT(:,:,:,1)
-PRVS(:,:,:) = PRS(:,:,:,1)
-!
-PRCT(:,:,:) = 0.
-PRCS(:,:,:) = 0.
-PRRT(:,:,:) = 0.
-PRRS(:,:,:) = 0.
-PRIT(:,:,:) = 0.
-PRIS(:,:,:) = 0.
-PRST(:,:,:) = 0.
-PRSS(:,:,:) = 0.
-PRGT(:,:,:) = 0.
-PRGS(:,:,:) = 0.
-PRHT(:,:,:) = 0.
-PRHS(:,:,:) = 0.
-!
-IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
-IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
-IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
-IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
-IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
-IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
-IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
-IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
-IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
-IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
-IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
-IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
-!
-! Prepare 3D number concentrations
-PCCT(:,:,:) = 0.
-PCRT(:,:,:) = 0.
-PCIT(:,:,:) = 0.
-PCCS(:,:,:) = 0.
-PCRS(:,:,:) = 0.
-PCIS(:,:,:) = 0.
-!
-IF ( LWARM_LIMA ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD_LIMA ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
-!
-IF ( LWARM_LIMA ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD_LIMA ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-ELSE
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
-END IF
-!
-IF ( NMOD_IFN .GE. 1 ) THEN
- ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
- PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-ELSE
- ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PIFS(:,:,:,:) = 0.
- PINS(:,:,:,:) = 0.
-END IF
-!
-IF ( NMOD_IMM .GE. 1 ) THEN
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
- PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-ELSE
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNIS(:,:,:,:) = 0.0
-END IF
-!
-IF ( OHHONI ) THEN
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
-ELSE
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = 0.0
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, &
- PRIT, PCIT, &
- PRIS, PRSS, PRGS, PRHS, PCIS, &
- PINPRS, PINPRG,&
- PINPRH )
-IF (LBU_ENABLE) THEN
- IF (LBUDGET_RI .AND. OSEDI) &
- CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10 ,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11 ,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12 ,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- IF (OSEDI) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
- END IF
-END IF
-!-------------------------------------------------------------------------------
-!
-!
-! COMPUTE THE NUCLEATION PROCESS SOURCES
-! --------------------------------------
-!
-IF (LNUCL_LIMA) THEN
-!
- IF ( LMEYERS_LIMA ) THEN
- PIFS(:,:,:,:) = 0.0
- PNIS(:,:,:,:) = 0.0
- CALL LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCCS, PCIS, PINS, &
- YDDDH, YDLDDH, YDMDDH )
- ELSE
- CALL LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCIT, PCCS, PCIS, &
- PNAS, PIFS, PINS, PNIS, &
- YDDDH, YDLDDH, YDMDDH )
- END IF
-!
- IF (LWARM_LIMA) THEN
- CALL LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
- PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS , &
- YDDDH, YDLDDH, YDMDDH )
- END IF
-!
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 4. SLOW PROCESSES: depositions, aggregation
-! ----------------------------------------
-!
-IF (LSNOW_LIMA) THEN
-!
- CALL LIMA_COLD_SLOW_PROCESSES(PTSTEP, KMI, HFMFILE, HLUOUT, &
- OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRIS, PRSS, &
- PCIT, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 4. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
-! -------------------------------------------------
-!
-PRS(:,:,:,1) = PRVS(:,:,:)
-IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
-IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
-IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
-IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
-IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
-IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
-!
-! Prepare 3D number concentrations
-!
-IF ( LWARM_LIMA ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
-IF ( LCOLD_LIMA ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
-END IF
-!
-IF ( NMOD_IFN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
-END IF
-!
-IF ( NMOD_IMM .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
-END IF
-
-IF ( OHHONI ) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = PNHS(:,:,:)
-!
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
-IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
-IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
-IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_COLD
diff --git a/src/arome/micro/lima_cold_hom_nucl.F90 b/src/arome/micro/lima_cold_hom_nucl.F90
deleted file mode 100644
index f30a0feb314e23c19f6c63ef96af144bcd158b60..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_cold_hom_nucl.F90
+++ /dev/null
@@ -1,696 +0,0 @@
-! ######################
- MODULE MODI_LIMA_COLD_HOM_NUCL
-! ######################
-!
-INTERFACE
- SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
- PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_COLD_HOM_NUCL
-END INTERFACE
-END MODULE MODI_LIMA_COLD_HOM_NUCL
-!
-! ######################################################################
- SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
- PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS, &
- YDDDH, YDLDDH, YDMDDH )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY : XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
- XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
- XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
- XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
- XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel/hail m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
- !by Immersion
-REAL, DIMENSION(:), ALLOCATABLE :: ZZNHS ! Nucleated Ice nuclei conc. source
- !by Homogeneous freezing
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZNHS ! Nucleated Ice nuclei conc. source
- ! by Homogeneous freezing of haze
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZLBDAC, & ! Slope parameter of the cloud droplet distr.
- ZSI, & ! Saturation over ice
- ZTCELSIUS,&
- ZLS, &
- ZPSI1, &
- ZPSI2, &
- ZTAU, &
- ZBFACT, &
- ZW_NU, &
- ZFREECCN, &
- ZCCNFROZEN
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
-!
-INTEGER :: INEGT ! Case number of hom. nucleation
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the hom. nucleation
-INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
-!
-REAL :: ZEPS ! molar mass ratio
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-! Physical domain
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-IF( OHHONI ) THEN
- ZNHS(:,:,:) = PNHS(:,:,:)
-ELSE
- ZNHS(:,:,:) = 0.0
-END IF
-!
-! Computations only where the temperature is below -35°C
-! PACK variables
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-!
-IF (INEGT.GT.0) THEN
-
- ALLOCATE(ZRVT(INEGT))
- ALLOCATE(ZRCT(INEGT))
- ALLOCATE(ZRRT(INEGT))
- ALLOCATE(ZRIT(INEGT))
- ALLOCATE(ZRST(INEGT))
- ALLOCATE(ZRGT(INEGT))
- !
- ALLOCATE(ZCCT(INEGT))
- !
- ALLOCATE(ZRVS(INEGT))
- ALLOCATE(ZRCS(INEGT))
- ALLOCATE(ZRRS(INEGT))
- ALLOCATE(ZRIS(INEGT))
- ALLOCATE(ZRGS(INEGT))
- !
- ALLOCATE(ZTHS(INEGT))
- !
- ALLOCATE(ZCCS(INEGT))
- ALLOCATE(ZCRS(INEGT))
- ALLOCATE(ZCIS(INEGT))
- !
- ALLOCATE(ZNFS(INEGT,NMOD_CCN))
- ALLOCATE(ZNIS(INEGT,NMOD_IMM))
- ALLOCATE(ZZNHS(INEGT))
- !
- ALLOCATE(ZRHODREF(INEGT))
- ALLOCATE(ZZT(INEGT))
- ALLOCATE(ZPRES(INEGT))
- ALLOCATE(ZEXNREF(INEGT))
- !
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- !
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- !
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
- !
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
- !
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
- !
- DO JMOD_CCN = 1, NMOD_CCN
- ZNFS(JL,JMOD_CCN) = PNFS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
- ENDDO
- DO JMOD_IMM = 1, NMOD_IMM
- ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
- ENDDO
- ZZNHS(JL) = ZNHS(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
-!
-! PACK : done
-! Prepare computations
-!
- ALLOCATE( ZLSFACT (INEGT) )
- ALLOCATE( ZLVFACT (INEGT) )
- ALLOCATE( ZSI (INEGT) )
- ALLOCATE( ZTCELSIUS (INEGT) )
- ALLOCATE( ZLBDAC (INEGT) )
-!
- ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
- ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
- ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
-!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. Haze homogeneous freezing
-! ------------------------
-!
-!
-! Compute the haze homogeneous nucleation source: RHHONI
-!
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) THEN
-
-! Sum of the available CCN
- ALLOCATE( ZFREECCN(INEGT) )
- ALLOCATE( ZCCNFROZEN(INEGT) )
- ZFREECCN(:)=0.
- ZCCNFROZEN(:)=0.
- DO JMOD_CCN = 1, NMOD_CCN
- ZFREECCN(:) = ZFREECCN(:) + ZNFS(:,JMOD_CCN)
- END DO
-!
- ALLOCATE(ZW_NU(INEGT))
- DO JL=1,INEGT
- ZW_NU(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
- END DO
-!
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZEPS = XMV / XMD
- ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
- (MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
-!
- ALLOCATE(ZLS(INEGT))
- ALLOCATE(ZPSI1(INEGT))
- ALLOCATE(ZPSI2(INEGT))
- ALLOCATE(ZTAU(INEGT))
- ALLOCATE(ZBFACT(INEGT))
-!
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
- ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
-!
- ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
-! ! Psi1 (a1*Scr in KL01)
-! BV correction PSI2 enlever 1/ZEPS ?
-! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
- ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
- ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
-! ! Psi2 (a2+a3*Scr in KL01)
- ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
- ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
- ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHS(:) ) )
-!
- ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
-! BV correction ZBFACT enlever 1/ZEPS ?
-! * (1.0/ZRVT(:)+1.0/ZEPS) &
- * (1.0/ZRVT(:)) &
- / (XCOEF_DIFVAP_HONH*(ZZT(:)**XCEXP_DIFVAP_HONH /ZPRES(:)))
-!
-! BV correction ZZX rho_i{-1} ?
-! ZZX(:) = MAX( MIN( XRHOI_HONH*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
- ZZX(:) = MAX( MIN( (1/XRHOI_HONH)*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
-! BV correction ZZX PTSTEP wrong place ?
-! * (ZW_NU(:)/SQRT(ZTAU(:))), ZNFS(:,JMOD_CCN) )/PTSTEP , 0.)
- * (ZW_NU(:)/SQRT(ZTAU(:)))/PTSTEP , ZFREECCN(:) ) , 0.)
-!
- ZZW(:) = MIN( XRCOEF_HONH*ZZX(:)*(ZTAU(:)/ZBFACT(:))**1.5 , ZRVS(:) )
- END WHERE
-!
-! Apply the changes to ZNFS,
- DO JMOD_CCN = 1, NMOD_CCN
- WHERE(ZFREECCN(:)>1.)
- ZCCNFROZEN(:) = ZZX(:) * ZNFS(:,JMOD_CCN)/ZFREECCN(:)
- ZNFS(:,JMOD_CCN) = ZNFS(:,JMOD_CCN) - ZCCNFROZEN(:)
- END WHERE
- ZW(:,:,:) = PNFS(:,:,:,JMOD_CCN)
- PNFS(:,:,:,JMOD_CCN)=UNPACK( ZNFS(:,JMOD_CCN), MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:))
- END DO
- ZZNHS(:) = ZZNHS(:) + ZZX(:)
- ZNHS(:,:,:) = UNPACK( ZZNHS(:), MASK=GNEGT(:,:,:),FIELD=0.0)
- PNHS(:,:,:) = ZNHS(:,:,:)
-!
- DEALLOCATE(ZFREECCN)
- DEALLOCATE(ZCCNFROZEN)
- DEALLOCATE(ZLS)
- DEALLOCATE(ZPSI1)
- DEALLOCATE(ZPSI2)
- DEALLOCATE(ZTAU)
- DEALLOCATE(ZBFACT)
- DEALLOCATE(ZW_NU)
-!
- ZRVS(:) = ZRVS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RHHONI))
- ZCIS(:) = ZCIS(:) + ZZX(:)
-!
- END IF ! OHHONI
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. OHHONI) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
- 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- CALL BUDGET_DDH ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
- 12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- END IF
- END IF
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Cloud droplets homogeneous freezing
-! -----------------------------------
-!
-!
-! Compute the droplet homogeneous nucleation source: RCHONI
-! -> Pruppacher(1995)
-!
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZCCT(:)>XCTMIN(2)) .AND. (ZRCT(:)>XRTMIN(2)) )
- ZLBDAC(:) = XLBC*ZCCT(:) / (ZRCT(:)) ! Lambda_c**3
- ZZX(:) = 1.0 / ( 1.0 + (XC_HONC/ZLBDAC(:))*PTSTEP* &
- EXP( XTEXP1_HONC + ZTCELSIUS(:)*( &
- XTEXP2_HONC + ZTCELSIUS(:)*( &
- XTEXP3_HONC + ZTCELSIUS(:)*( &
- XTEXP4_HONC + ZTCELSIUS(:)*XTEXP5_HONC))) ) )**XNUC
- ZZW(:) = ZCCS(:) * (1.0 - ZZX(:)) ! CCHONI
-!
- ZCCS(:) = ZCCS(:) - ZZW(:)
- ZCIS(:) = ZCIS(:) + ZZW(:)
-!
- ZZW(:) = ZRCS(:) * (1.0 - ZZX(:)) ! RCHONI
-!
- ZRCS(:) = ZRCS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- 7,'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NC,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. Rain drops homogeneous freezing
-! -------------------------------
-!
-!
-! Compute the drop homogeneous nucleation source: RRHONG
-!
- ZZW(:) = 0.0
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
- ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
- ZRRS(:) = ZRRS(:) - ZZW(:)
- ZRGS(:) = ZRGS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
-!
- ZCRS(:) = 0.0 ! No more raindrops when T<-35 C
- ENDWHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GNEGT(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:),&
- 8,'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GNEGT(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:),&
- 11,'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NR,'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. Unpack variables, clean
-! -----------------------
-!
-!
-! End of homogeneous nucleation processes
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRGS(:,:,:)
- PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCCS(:,:,:)
- PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCRS(:,:,:)
- PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIS(:,:,:)
- PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
-!
- DEALLOCATE(ZCCT)
-!
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZRGS)
-!
- DEALLOCATE(ZTHS)
-!
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZCRS)
- DEALLOCATE(ZCIS)
-!
- DEALLOCATE(ZNFS)
- DEALLOCATE(ZNIS)
- DEALLOCATE(ZZNHS)
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
-!
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZSI)
- DEALLOCATE(ZTCELSIUS)
- DEALLOCATE(ZLBDAC)
-!
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
-!
-ELSE
-!
-! Advance the budget calls
-!
-
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF ( OHHONI ) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
- & 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- CALL BUDGET_DDH (ZNHS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
- END IF
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
-
-
-
-
- END IF
-!
-END IF ! INEGT>0
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_COLD_HOM_NUCL
diff --git a/src/arome/micro/lima_cold_sedimentation.F90 b/src/arome/micro/lima_cold_sedimentation.F90
deleted file mode 100644
index 635a0d931236226792af650bdbd3464f8e45ca3d..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_cold_sedimentation.F90
+++ /dev/null
@@ -1,383 +0,0 @@
-! ###################################
- MODULE MODI_LIMA_COLD_SEDIMENTATION
-! ###################################
-!
-INTERFACE
- SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, &
- PRIT, PCIT, &
- PRIS, PRSS, PRGS, PRHS, PCIS, &
- PINPRS, PINPRG, PINPRH )
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the FM file output
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-
-!
- END SUBROUTINE LIMA_COLD_SEDIMENTATION
-END INTERFACE
-END MODULE MODI_LIMA_COLD_SEDIMENTATION
-!
-!
-! ######################################################################
- SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, &
- PRIT, PCIT, &
- PRIS, PRSS, PRGS, PRHS, PCIS, &
- PINPRS,PINPRG,PINPRH )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sediimentation
-!! of primary ice, snow and graupel.
-!!
-!! METHOD
-!! ------
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBEXI, XLBI, XDI, &
- XFSEDRI, XFSEDCI, XFSEDS, XEXSEDS
-USE MODD_PARAM_LIMA_MIXED, ONLY : XFSEDG, XEXSEDG, XFSEDH, XEXSEDH
-USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN, XCTMIN
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE MODD_NSV
-
-IMPLICIT NONE
-
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the FM file output
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK, JL, JN ! Loop index
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: ISEDIM ! Case number of sedimentation
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GSEDIM ! Test where to compute the SED processes
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW ! Work array
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)+1) &
- :: ZWSEDR, & ! Sedimentation of MMR
- ZWSEDC ! Sedimentation of number conc.
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRIS, & ! Pristine ice m.r. source
- ZCIS, & ! Pristine ice conc. source
- ZRSS, & ! Snow/aggregate m.r. source
- ZRGS, & ! Graupel/hail m.r. source
- ZRHS, & ! Graupel/hail m.r. source
- ZRIT, & ! Pristine ice m.r. at t
- ZCIT, & ! Pristine ice conc. at t
- ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLBDAI, & ! Slope parameter of the ice crystal distr.
- ZRTMIN
-!
-INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
-!
-REAL :: ZTSPLITG ! Small time step for rain sedimentation
-!
-INTEGER :: IKMAX
-!
-!!!!!!!!!!! Entiers pour niveaux inversés dans AROME !!!!!!!!!!!!!!!!!!!!!!!!!!!
-INTEGER :: IBOTTOM, INVLVL
-!
-!-------------------------------------------------------------------------------
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!!!!!!!!!!! Entiers pour niveaux inversés dans AROME !!!!!!!!!!!!!!!!!!!!!!!!!!!
-IBOTTOM=IKE
-INVLVL=-1
-!
-ZWSEDR(:,:,:)=0.
-ZWSEDC(:,:,:)=0.
-IKMAX=SIZE(PRHODREF,3)
-!
-! Time splitting and ZRTMIN
-!
-ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-!
-ZTSPLITG= PTSTEP / FLOAT(KSPLITG)
-!
-PINPRS(:,:) = 0.
-PINPRG(:,:) = 0.
-PINPRH(:,:) = 0.
-!
-! ################################
-! Compute the sedimentation fluxes
-! ################################
-!
-DO JN = 1 , KSPLITG
- ! Computation only where enough ice, snow, graupel or hail
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRSS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(5) &
- .OR. PRGS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(6) &
- .OR. PRHS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(7)
- IF( OSEDI ) THEN
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) &
- .OR. PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4)
- END IF
-!
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
-!
- IF( JN==1 ) THEN
- IF( OSEDI ) THEN
- PCIS(:,:,:) = PCIS(:,:,:) * PTSTEP
- PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
- END IF
- PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
- PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
- PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
- DO JK = IKB , IKE
-!Dans AROME, PZZ = épaisseur de la couche
-! ZW(:,:,JK)=ZTSPLITG/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
- ZW(:,:,JK)=ZTSPLITG/(PZZ(:,:,JK))
- END DO
- END IF
-!
- ALLOCATE(ZRHODREF(ISEDIM))
- DO JL = 1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- END DO
-!
- ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
- ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
- ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
-!
-!* 2.21 for pristine ice
-!
- IF( OSEDI.AND.MAXVAL(PRIS(:,:,:))>ZRTMIN(4) ) THEN
- ALLOCATE(ZRIS(ISEDIM))
- ALLOCATE(ZCIS(ISEDIM))
- ALLOCATE(ZRIT(ISEDIM))
- ALLOCATE(ZCIT(ISEDIM))
- ALLOCATE(ZLBDAI(ISEDIM))
- DO JL = 1,ISEDIM
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- END DO
- ZLBDAI(:) = 1.E10
- WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
- ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
- END WHERE
- WHERE( ZRIS(:)>ZRTMIN(4) )
- ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDAI(:)**(-XDI)
- ZZW(:) = XFSEDRI * ZRIS(:) * ZZY(:) * ZRHODREF(:)
- ZZX(:) = XFSEDCI * ZCIS(:) * ZZY(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,1:IKMAX) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- PCIS(:,:,JK) = PCIS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDC(:,:,JK+1*INVLVL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRIS(:,:,1) = PRIS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- PCIS(:,:,1) = PCIS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDC(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZCIS)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZLBDAI)
- END IF
-!
-!* 2.22 for aggregates
-!
- ZZW(:) = 0.
- IF( MAXVAL(PRSS(:,:,:))>ZRTMIN(5) ) THEN
- ALLOCATE(ZRSS(ISEDIM))
- DO JL = 1,ISEDIM
- ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
- END DO
- WHERE( ZRSS(:)>ZRTMIN(5) )
-! Correction BVIE ZRHODREF
-! ZZW(:) = XFSEDS * ZRSS(:)**XEXSEDS * ZRHODREF(:)**(XEXSEDS-XCEXVT)
- ZZW(:) = XFSEDS * ZRSS(:)**XEXSEDS * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRSS(:,:,1) = PRSS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRSS)
- ELSE
- ZWSEDR(:,:,IBOTTOM) = 0.0
- END IF
-!
- PINPRS(:,:) = PINPRS(:,:) + ZWSEDR(:,:,IBOTTOM)/XRHOLW/KSPLITG ! in m/s
-!
-!* 2.23 for graupeln
-!
- ZZW(:) = 0.
- IF( MAXVAL(PRGS(:,:,:))>ZRTMIN(6) ) THEN
- ALLOCATE(ZRGS(ISEDIM))
- DO JL = 1,ISEDIM
- ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
- END DO
- WHERE( ZRGS(:)>ZRTMIN(6) )
-! Correction BVIE ZRHODREF
-! ZZW(:) = XFSEDG * ZRGS(:)**XEXSEDG * ZRHODREF(:)**(XEXSEDG-XCEXVT)
- ZZW(:) = XFSEDG * ZRGS(:)**XEXSEDG * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRGS(:,:,1) = PRGS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRGS)
- ELSE
- ZWSEDR(:,:,IBOTTOM) = 0.0
- END IF
-!
- PINPRG(:,:) = PINPRG(:,:) + ZWSEDR(:,:,IBOTTOM)/XRHOLW/KSPLITG ! in m/s
-!
-!* 2.23 for hail
-!
- ZZW(:) = 0.
- IF( MAXVAL(PRHS(:,:,:))>ZRTMIN(7) ) THEN
- ALLOCATE(ZRHS(ISEDIM))
- DO JL = 1,ISEDIM
- ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
- END DO
- WHERE( ZRHS(:)>ZRTMIN(7) )
-! Correction BVIE ZRHODREF
-! ZZW(:) = XFSEDH * ZRHS(:)**XEXSEDH * ZRHODREF(:)**(XEXSEDH-XCEXVT)
- ZZW(:) = XFSEDH * ZRHS(:)**XEXSEDH * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRHS(:,:,1) = PRHS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRHS)
- ELSE
- ZWSEDR(:,:,IBOTTOM) = 0.0
- END IF
-!
- PINPRH(:,:) = PINPRH(:,:) + ZWSEDR(:,:,IBOTTOM)/XRHOLW/KSPLITG ! in m/s
-!
-!* 2.24 End of sedimentation
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
- IF( JN==KSPLITG ) THEN
- IF( OSEDI ) THEN
- PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
- PCIS(:,:,:) = PCIS(:,:,:) / PTSTEP
- END IF
- PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
- PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
- PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
- END IF
- END IF
-END DO
-!
-DEALLOCATE(ZRTMIN)
-!
-END SUBROUTINE LIMA_COLD_SEDIMENTATION
-!
-!-------------------------------------------------------------------------------
diff --git a/src/arome/micro/lima_cold_slow_processes.F90 b/src/arome/micro/lima_cold_slow_processes.F90
deleted file mode 100644
index a342f7d220a33f5a136080653c7c8c55fa104a13..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_cold_slow_processes.F90
+++ /dev/null
@@ -1,583 +0,0 @@
-! #####################
- MODULE MODI_LIMA_COLD_SLOW_PROCESSES
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, HFMFILE, HLUOUT, &
- OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRIS, PRSS, &
- PCIT, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-
-END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
-END INTERFACE
-END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
-!
-! ######################################################################
- SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, HFMFILE, HLUOUT, &
- OCLOSE_OUT, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRIS, PRSS, &
- PCIT, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources
-!! for slow cold processes :
-!! - conversion of snow to ice
-!! - deposition of vapor on snow
-!! - conversion of ice to snow (Harrington 1995)
-!! - aggregation of ice on snow
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
- XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : LSNOW_LIMA, XRTMIN, XCTMIN, XALPHAI, XALPHAS, &
- XNUI
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
- XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
- XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
- XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
- XDICNVS_LIM, XLBDAICNVS_LIM, &
- XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
- XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NI
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GMICRO ! Computations only where necessary
-INTEGER :: IMICRO
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace PACK
-INTEGER :: JL ! and PACK intrinsics
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZSSI, & ! Supersaturation over ice
- ZLBDAI, & ! Slope parameter of the ice crystal distr.
- ZLBDAS, & ! Slope parameter of the aggregate distr.
- ZAI, & ! Thermodynamical function
- ZCJ, & ! used to compute the ventilation coefficient
- ZKA, & ! Thermal conductivity of the air
- ZDV, & ! Diffusivity of water vapor in the air
- ZVISCA ! Viscosity of air
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZT, ZW ! Temperature
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
-!
-!-------------------------------------------------------------------------------
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-! Physical limitations
-!
-ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-ZCTMIN(:) = XCTMIN(:) / PTSTEP
-!
-! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Looking for regions where computations are necessary
-!
-GMICRO(:,:,:) = .FALSE.
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
- PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5)
-!
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-!
-IF( IMICRO >= 1 ) THEN
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 1. Optimization : packing variables
-! --------------------------------
-!
-!
-!
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRCT(IMICRO))
- ALLOCATE(ZRRT(IMICRO))
- ALLOCATE(ZRIT(IMICRO))
- ALLOCATE(ZRST(IMICRO))
- ALLOCATE(ZRGT(IMICRO))
-!
- ALLOCATE(ZCIT(IMICRO))
-!
- ALLOCATE(ZRVS(IMICRO))
- ALLOCATE(ZRIS(IMICRO))
- ALLOCATE(ZRSS(IMICRO))
-!
- ALLOCATE(ZTHS(IMICRO))
-!
- ALLOCATE(ZCIS(IMICRO))
-!
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZEXNREF(IMICRO))
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
-!
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
-!
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- ALLOCATE(ZRHODJ(IMICRO))
- ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
- END IF
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 2. Microphysical computations
-! --------------------------
-!
-!
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZZX(IMICRO))
- ALLOCATE(ZLSFACT(IMICRO))
- ALLOCATE(ZSSI(IMICRO))
- ALLOCATE(ZLBDAI(IMICRO))
- ALLOCATE(ZLBDAS(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
- ALLOCATE(ZZW1(IMICRO,7))
-!
-! Preliminary computations
-!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
-!
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
- ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
- ! Supersaturation over ice
-! Distribution parameters for ice and snow
- ZLBDAI(:) = 1.E10
- WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
- ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
- END WHERE
- ZLBDAS(:) = 1.E10
- WHERE (ZRST(:)>XRTMIN(5) )
- ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
- END WHERE
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
-!
-! Thermodynamical function ZAI = A_i(T,P)
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
-! ZCJ = c^prime_j/c_i (in the ventilation factor) ( c_i from v(D)=c_i*D^(d_i) )
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
-!
-!
-!
-!
-!* 2.1 Conversion of snow to r_i: RSCNVI
-! ----------------------------------------
-!
-!
- WHERE ( ZRST(:)>XRTMIN(5) )
- ZLBDAS(:) = MIN( XLBDAS_MAX, &
- XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
- END WHERE
- ZZW(:) = 0.0
- WHERE ( ZLBDAS(:)<XLBDASCNVI_MAX .AND. (ZRST(:)>XRTMIN(5)) &
- .AND. (ZSSI(:)<0.0) )
- ZZW(:) = (ZLBDAS(:)*XDSCNVI_LIM)**(XALPHAS)
- ZZX(:) = ( -ZSSI(:)/ZAI(:) ) * (XCCS*ZLBDAS(:)**XCXS) * (ZZW(:)**XNUI) &
- * EXP(-ZZW(:))
-!
-! Correction BVIE RHODREF
-! ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:)/ZRHODREF(:),ZRSS(:) )
- ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:),ZRSS(:) )
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZRSS(:) = ZRSS(:) - ZZW(:)
-!
- ZZW(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*ZCJ(:) )/( XR0DEPSI+XR1DEPSI*ZCJ(:) )
- ZCIS(:) = ZCIS(:) + ZZW(:)
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!* 2.2 Deposition of water vapor on r_s: RVDEPS
-! -----------------------------------------------
-!
-!
- ZZW(:) = 0.0
- WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) )
-!Correction BVIE rhodref
-! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
- ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
- ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS )
- ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
- - MIN( ZRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
- ZRSS(:) = ZRSS(:) + ZZW(:)
- ZRVS(:) = ZRVS(:) - ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!* 2.3 Conversion of pristine ice to r_s: RICNVS
-! ------------------------------------------------
-!
-!
- ZZW(:) = 0.0
- WHERE ( (ZLBDAI(:)<XLBDAICNVS_LIM) .AND. (ZCIT(:)>XCTMIN(4)) &
- .AND. (ZSSI(:)>0.0) )
- ZZW(:) = (ZLBDAI(:)*XDICNVS_LIM)**(XALPHAI)
- ZZX(:) = ( ZSSI(:)/ZAI(:) )*ZCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
-!
-! Correction BVIE
-! ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:)/ZRHODREF(:) &
- ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:) &
- ,ZRIS(:) ) + ZRTMIN(5), ZRTMIN(5) ) - ZRTMIN(5)
- ZRIS(:) = ZRIS(:) - ZZW(:)
- ZRSS(:) = ZRSS(:) + ZZW(:)
-!
- ZZW(:) = MIN( ZZW(:)*(( XC0DEPIS+XC1DEPIS*ZCJ(:) ) &
- /( XR0DEPIS+XR1DEPIS*ZCJ(:) )),ZCIS(:) )
- ZCIS(:) = ZCIS(:) - ZZW(:)
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
-! ---------------------------------------------------
-!
-!
- WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) &
- .AND. (ZCIS(:)>ZCTMIN(4)) )
- ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
- ZZW1(:,1) = (ZCIT(:)*(XCCS*ZLBDAS(:)**XCXS)*EXP( XCOLEXIS*(ZZT(:)-XTT) )) &
- / (ZLBDAI(:)**3)
- ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:,3)),ZCIS(:) )
- ZCIS(:) = ZCIS(:) - ZZW1(:,2)
-!
- ZZW1(:,1) = ZZW1(:,1) / ZLBDAI(:)**XBI
- ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:,3)),ZRIS(:) )
- ZRIS(:) = ZRIS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) + ZZW1(:,2)
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 3. Unpacking & Deallocating
-! ------------------------
-!
-!
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRSS(:,:,:)
- PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = PCIS(:,:,:)
- PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZRSS)
- DEALLOCATE(ZTHS)
- DEALLOCATE(ZCIS)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZSSI)
- DEALLOCATE(ZLBDAI)
- DEALLOCATE(ZLBDAS)
- DEALLOCATE(ZAI)
- DEALLOCATE(ZCJ)
- DEALLOCATE(ZKA)
- DEALLOCATE(ZDV)
- DEALLOCATE(ZZW1)
- IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
-!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET_DDH (ZW,4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET_DDH (ZW,6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET_DDH (ZW,9,'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,9,'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- ENDIF
- IF (LBUDGET_RS) THEN
- ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET_DDH (ZW,10,'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,10,'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ENDIF
- ENDIF
-!
-END IF
-!
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
-!
-END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
diff --git a/src/arome/micro/lima_conversion_melting_snow.F90 b/src/arome/micro/lima_conversion_melting_snow.F90
deleted file mode 100644
index 37c3b450127735ff97d6384ef0cc9f25c301dad8..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_conversion_melting_snow.F90
+++ /dev/null
@@ -1,142 +0,0 @@
-! #################################
- MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
-!
-! ######################################################################
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT, XMV, XMD, XLVTT, XCPV, XCL, XESTT, XRV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
-USE MODD_PARAM_LIMA_MIXED, ONLY : XFSCVMG
-USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRST)) :: ZW ! work arrays
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-P_RS_CMEL(:)=0.
-!
-ZW(:) = 0.0
-WHERE( (PRST(:)>XRTMIN(5)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
- ZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- ZW(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZW(:))/(XRV*PT(:)) )
-!
-! compute RSMLT
-!
- ZW(:) = XFSCVMG*MAX( 0.0,( -ZW(:) * &
- ( X0DEPS* PLBDS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS ) ))!- &
-!!! BVIE
-!!! ZZW1(1) et ZZW1(4) sont nuls là où PT>XTT !!!!!!!!!!!!!!
-!!! On ne tient pas compte de la collection de pluie et gouttelettes par la neige si T>0 !!!!
-! ( ZZW1(:,1)+ZZW1(:,4) ) * &
-! ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
-! ( ZRHODREF(:)*XLMTT ) )
-!
-! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
-! because the graupeln produced by this process are still icy!!!
-!
- P_RS_CMEL(:) = - ZW(:)
-!
-END WHERE
-!
-PA_RS(:) = PA_RS(:) + P_RS_CMEL(:)
-PA_RG(:) = PA_RG(:) - P_RS_CMEL(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
diff --git a/src/arome/micro/lima_droplets_accretion.F90 b/src/arome/micro/lima_droplets_accretion.F90
deleted file mode 100644
index 6ee2a57ec5574a8b05cc349a24e68c07b1f3d045..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_droplets_accretion.F90
+++ /dev/null
@@ -1,172 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPLETS_ACCRETION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_ACCRETION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-!
-END SUBROUTINE LIMA_DROPLETS_ACCRETION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_ACCRETION
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPLETS_ACCRETION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, &
- XACCR4, XACCR5, XACCR3, XACCR2, XACCR1, &
- XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
- XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZW1, ZW2, ZW3, ZW4 ! work arrays
-LOGICAL, DIMENSION(SIZE(PRCT)) :: GACCR
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 3. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-! ----------------------------------------------------------------------
-!
-P_RC_ACCR(:) = 0.0
-P_CC_ACCR(:) = 0.0
-!
-ZW1(:) = 0.0
-ZW2(:) = 0.0
-ZW3(:) = 0.0
-ZW4(:) = 0.0
-!
-WHERE( PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
- ZW2(:) = MAX( 0.0,XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/PLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
- ZW4(:) = XACCR1/PLBDR(:)
-END WHERE
-!
-GACCR(:) = LDCOMPUTE(:) .AND. &
- PRRT(:)>XRTMIN(3) .AND. &
- PCRT(:)>XCTMIN(3) .AND. &
- PRCT(:)>XRTMIN(2) .AND. &
- (PRRT(:)>1.2*ZW2(:)/PRHODREF(:) .OR. &
- ZW4(:)>=MAX(XACCR2,XACCR3/(XACCR4/PLBDC(:)-XACCR5)) )
-!
-! Accretion for D>100 10-6 m
-WHERE( GACCR(:).AND.(ZW4(:)>1.E-4) )
- ZW3(:) = PLBDC3(:) / PLBDR3(:)
- ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:) )*PRHODREF(:)
- ZW2(:) = ZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZW3(:))
-!
- P_CC_ACCR(:) = - ZW2(:)
-!
- ZW1(:) = ( ZW1(:) / PLBDC3(:) )
- ZW2(:) = ZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZW3(:))
-!
- P_RC_ACCR(:) = - ZW2(:)
-END WHERE
-!
-! Accretion for D<100 10-6 m
-WHERE( GACCR(:).AND.(ZW4(:)<=1.E-4) )
- ZW3(:) = PLBDC3(:) / PLBDR3(:)
- ZW1(:) = ( PCCT(:)*PCRT(:) / PLBDC3(:)**2 )*PRHODREF(:)
- ZW3(:) = ZW3(:)**2
- ZW2(:) = ZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZW3(:))
-!
- P_CC_ACCR(:) = - ZW2(:)
-!
- ZW1(:) = ZW1(:) / PLBDC3(:)
- ZW2(:) = ZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZW3(:))
-!
- P_RC_ACCR(:) = - ZW2(:)
-END WHERE
-!
-PA_RC(:) = PA_RC(:) + P_RC_ACCR(:)
-PA_CC(:) = PA_CC(:) + P_CC_ACCR(:)
-PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPLETS_ACCRETION
diff --git a/src/arome/micro/lima_droplets_autoconversion.F90 b/src/arome/micro/lima_droplets_autoconversion.F90
deleted file mode 100644
index 9dbce4f64513bc02f6689c62e6f0112c9d0ff83e..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_droplets_autoconversion.F90
+++ /dev/null
@@ -1,143 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO,&
- PA_RC, PA_CC, PA_RR, PA_CR )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-!
-END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO,&
- PA_RC, PA_CC, PA_RR, PA_CR )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, &
- XITAUTR, XAUTO2, XITAUTR_THRESHOLD, &
- XACCR4, XACCR5, XACCR3, XACCR1, XAC
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZW1, ZW2, ZW3 ! work arrays
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 3. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-! ----------------------------------------------------------------------
-!
-!
-!
-P_RC_AUTO(:) = 0.0
-P_CC_AUTO(:) = 0.0
-P_CR_AUTO(:) = 0.0
-!
-ZW3(:) = 0.0
-ZW2(:) = 0.0
-ZW1(:) = 0.0
-WHERE( PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:) )
- ZW2(:) = MAX( 0.0, &
- XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/PLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
-!
- ZW3(:) = MAX( 0.0, &
- XITAUTR*ZW2(:)*PRCT(:)*(XAUTO2/PLBDC(:)-XITAUTR_THRESHOLD) ) ! L/tau
-!
- P_RC_AUTO(:) = - ZW3(:)
-!
- ZW1(:) = MIN( MIN( 1.2E4, &
- (XACCR4/PLBDC(:)-XACCR5)/XACCR3 ), &
- PLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
- ! switching the autoconversion regimes
- ! min (80 microns, D_h, D_r)
- ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC
-!
- P_CC_AUTO(:) = 0.
- P_CR_AUTO(:) = ZW3(:)
-!
- PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
- PA_CC(:) = PA_CC(:)
- PA_RR(:) = PA_RR(:) - P_RC_AUTO(:)
- PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
-END WHERE
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
diff --git a/src/arome/micro/lima_droplets_hom_freezing.F90 b/src/arome/micro/lima_droplets_hom_freezing.F90
deleted file mode 100644
index c5afd129791fc060bc3961184f3df81b64091c5c..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_droplets_hom_freezing.F90
+++ /dev/null
@@ -1,160 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-!
-END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY : XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PT)) :: ZZW, ZZX, ZZY, ZTCELSIUS
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-P_TH_HONC(:) = 0.
-P_RC_HONC(:) = 0.
-P_CC_HONC(:) = 0.
-!
-WHERE ( (PT(:)<XTT-35.0) .AND. (PCCT(:)>XCTMIN(2)) .AND. (PRCT(:)>XRTMIN(2)) )
- ZTCELSIUS(:) = PT(:)-XTT ! T [°C]
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Cloud droplets homogeneous freezing
-! -----------------------------------
-!
-!
-! Compute the droplet homogeneous nucleation source: RCHONI
-! -> Pruppacher(1995)
-!
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZZY(:) = 0.0
-
- ZZX(:) = 1.0 / ( 1.0 + (XC_HONC/PLBDC(:))*PTSTEP* &
- EXP( XTEXP1_HONC + ZTCELSIUS(:)*( &
- XTEXP2_HONC + ZTCELSIUS(:)*( &
- XTEXP3_HONC + ZTCELSIUS(:)*( &
- XTEXP4_HONC + ZTCELSIUS(:)*XTEXP5_HONC))) ) )**XNUC
-!
- ZZW(:) = PCCT(:) * (1.0 - ZZX(:)) ! CCHONI
- ZZY(:) = PRCT(:) * (1.0 - ZZX(:)) ! RCHONI
-!
- P_RC_HONC(:) = - ZZY(:)/PTSTEP
- P_CC_HONC(:) = - ZZW(:)/PTSTEP
- P_TH_HONC(:) = P_RC_HONC(:) * (PLSFACT(:)-PLVFACT(:))
-!
- PA_TH(:) = PA_TH(:) + P_TH_HONC(:)
- PA_RC(:) = PA_RC(:) + P_RC_HONC(:)
- PA_CC(:) = PA_CC(:) + P_CC_HONC(:)
- PA_RI(:) = PA_RI(:) - P_RC_HONC(:)
- PA_CI(:) = PA_CI(:) - P_CC_HONC(:)
-!
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
diff --git a/src/arome/micro/lima_droplets_riming_snow.F90 b/src/arome/micro/lima_droplets_riming_snow.F90
deleted file mode 100644
index 0f8a3c60ecb459479dae635b866d78d8fed500f0..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_droplets_riming_snow.F90
+++ /dev/null
@@ -1,252 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
-USE MODD_PARAM_LIMA_MIXED, ONLY : NGAMINC, XRIMINTP1, XRIMINTP2, XGAMINC_RIM1, XGAMINC_RIM2, &
- XCRIMSS, XEXCRIMSS, XSRIMCG, XEXSRIMCG, &
- XHMLINTP1, XHMLINTP2, XGAMINC_HMC, XHM_FACTS, XHMTMIN, XHMTMAX
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(PRCT)) :: GRIM
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZZW1, ZZW2, ZZW3, ZZW4
-!
-INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
-REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2 ! Work vectors
-!
-!-------------------------------------------------------------------------------
-!
-!
-P_TH_RIM(:) = 0.
-P_RC_RIM(:) = 0.
-P_CC_RIM(:) = 0.
-P_RS_RIM(:) = 0.
-P_RG_RIM(:) = 0.
-!
-P_RI_HMS(:) = 0.
-P_CI_HMS(:) = 0.
-P_RS_HMS(:) = 0.
-!
-ZZW1(:) = 0.
-ZZW2(:) = 0.
-ZZW3(:) = 0.
-ZZW4(:) = 0.
-!
-!* Cloud droplet riming of the aggregates
-! -------------------------------------------
-!
-!
-GRIM(:) = .False.
-GRIM(:) = (PRCT(:)>XRTMIN(2)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PT(:)<XTT) .AND. LDCOMPUTE(:)
-!
-WHERE( GRIM )
-!
- ZVEC1(:) = PLBDS(:)
-!
-! 1. find the next lower indice for the ZLBDAS in the geometrical
-! set of Lbda_s used to tabulate some moments of the incomplete
-! gamma function
-!
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(:) ) + XRIMINTP2 ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
-!
-! 2. perform the linear interpolation of the normalized
-! "2+XDS"-moment of the incomplete gamma function
-!
- ZVEC1(:) = XGAMINC_RIM1( IVEC2(:)+1 )* ZVEC2(:) &
- - XGAMINC_RIM1( IVEC2(:) )*(ZVEC2(:) - 1.0)
- ZZW1(:) = ZVEC1(:)
-!
-! 3. perform the linear interpolation of the normalized
-! "XBS"-moment of the incomplete gamma function
-!
- ZVEC1(:) = XGAMINC_RIM2( IVEC2(:)+1 )* ZVEC2(:) &
- - XGAMINC_RIM2( IVEC2(:) )*(ZVEC2(:) - 1.0)
- ZZW2(:) = ZVEC1(:)
-!
-! 4. riming
-!
- ! Cloud droplets collected
- P_RC_RIM(:) = - XCRIMSS * PRCT(:) * PLBDS(:)**XEXCRIMSS * PRHODREF(:)**(-XCEXVT)
- P_CC_RIM(:) = P_RC_RIM(:) *(PCCT(:)/PRCT(:)) ! Lambda_c**3
- !
- ! Cloud droplets collected on small aggregates add to snow
- P_RS_RIM(:) = - P_RC_RIM(:) * ZZW1(:)
- !
- ! Cloud droplets collected on large aggregates add to graupel
- P_RG_RIM(:) = P_RC_RIM(:) - P_RS_RIM(:)
- !
- ! Large aggregates collecting droplets add to graupel (instant process ???)
- ZZW3(:) = XSRIMCG * PLBDS(:)**XEXSRIMCG * (1.0 - ZZW2(:))/(PTSTEP*PRHODREF(:))
- P_RS_RIM(:) = P_RS_RIM(:) - ZZW3(:)
- P_RG_RIM(:) = P_RG_RIM(:) + ZZW3(:)
- !
- P_TH_RIM(:) = - P_RC_RIM(:)*(PLSFACT(:)-PLVFACT(:))
-END WHERE
-!
-!
-!* Hallett-Mossop ice production (HMS)
-! -------------------------------------------
-!
-!
-GRIM(:) = .False.
-GRIM(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. &
- (PRST(:)>XRTMIN(5)) .AND. (PRCT(:)>XRTMIN(2)) .AND. &
- LDCOMPUTE(:)
-!
-WHERE ( GRIM )
-!
- ZVEC1(:) = PLBDC(:)
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
- XHMLINTP1 * LOG( ZVEC1(:) ) + XHMLINTP2 ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
- ZVEC1(:) = XGAMINC_HMC( IVEC2(:)+1 )* ZVEC2(:) &
- - XGAMINC_HMC( IVEC2(:) )*(ZVEC2(:) - 1.0)
- ZZW4(:) = ZVEC1(:) ! Large droplets
-!
- WHERE ( ZZW4(:)<0.99 )
- P_CI_HMS(:) = - P_RC_RIM(:) * (PCCT(:)/PRCT(:)) * (1.0-ZZW4(:)) * XHM_FACTS * &
- MAX( 0.0, MIN( (PT(:)-XHMTMIN)/3.0,(XHMTMAX-PT(:))/2.0 ) ) ! CCHMSI
-!
- P_RI_HMS(:) = P_CI_HMS(:) * XMNU0 ! RCHMSI
- P_RS_HMS(:) = - P_RI_HMS(:)
- END WHERE
-
-END WHERE
-!
-!
-PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
-PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
-PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
-PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
-PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
-PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
-PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
diff --git a/src/arome/micro/lima_droplets_self_collection.F90 b/src/arome/micro/lima_droplets_self_collection.F90
deleted file mode 100644
index 5e0c994e08655820da833585f32019e8567aa9b6..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_droplets_self_collection.F90
+++ /dev/null
@@ -1,103 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF, &
- PA_CC )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-!
-END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF, &
- PA_CC )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XSELFC
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PCCT)) :: ZW ! work arrays
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-P_CC_SELF(:)=0.
-!
-WHERE( PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) )
- ZW(:) = XSELFC*(PCCT(:)/PLBDC3(:))**2 * PRHODREF(:) ! analytical integration
- P_CC_SELF(:) = - ZW(:)
- PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
-END WHERE
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
diff --git a/src/arome/micro/lima_drops_break_up.F90 b/src/arome/micro/lima_drops_break_up.F90
deleted file mode 100644
index fccda7a5b0cb71f8e0ad53f49276b2e148b1763e..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_drops_break_up.F90
+++ /dev/null
@@ -1,129 +0,0 @@
-! ###############################
- MODULE MODI_LIMA_DROPS_BREAK_UP
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_BREAK_UP (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-!
-END SUBROUTINE LIMA_DROPS_BREAK_UP
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_BREAK_UP
-! #####################################################################
- SUBROUTINE LIMA_DROPS_BREAK_UP (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
-! #####################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the warm microphysical
-!! sources: nucleation, sedimentation, autoconversion, accretion,
-!! self-collection and vaporisation which are parameterized according
-!! to Cohard and Pinty, QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration. Then assuming a
-!! generalized gamma distribution law for the cloud droplets and the
-!! raindrops, the zeroth and third order moments tendencies are evaluated
-!! for all the coalescence terms by integrating the Stochastic Collection
-!! Equation. As autoconversion is a process that cannot be resolved
-!! analytically, the Berry-Reinhardt parameterisation is employed with
-!! modifications to initiate the raindrop spectrum mode. The integration
-!! of the raindrop evaporation below clouds is straightforward.
-!!
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XACCR1, XLBEXR, XLBR, XSPONBUD1, XSPONBUD3, XSPONCOEF2
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PCRT)) :: ZWLBDR,ZWLBDR3
-INTEGER :: JL
-!
-!-------------------------------------------------------------------------------
-!
-! SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
-! --------------------
-!
-P_CR_BRKU(:)=0.
-!
-ZWLBDR3(:) = 1.E30
-ZWLBDR(:) = 1.E10
-WHERE ( PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
- ZWLBDR3(:) = XLBR * PCRT(:) / PRRT(:)
- ZWLBDR(:) = ZWLBDR3(:)**XLBEXR
-END WHERE
-WHERE (ZWLBDR(:)<(XACCR1/XSPONBUD1) .AND. LDCOMPUTE(:))
- P_CR_BRKU(:) = PCRT(:)*( MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:)-XSPONBUD1)**2),&
- (XACCR1/ZWLBDR(:)/XSPONBUD3)**3) -1. )
-END WHERE
-!
-PB_CR(:) = PB_CR(:) + P_CR_BRKU(:)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPS_BREAK_UP
diff --git a/src/arome/micro/lima_drops_hom_freezing.F90 b/src/arome/micro/lima_drops_hom_freezing.F90
deleted file mode 100644
index 90010219b5360ad0dcd04dca53dc40666ba6cf86..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_drops_hom_freezing.F90
+++ /dev/null
@@ -1,152 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
-!
-END SUBROUTINE LIMA_DROPS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_HOM_FREEZING
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XP00, XRD, XCPD, XCPV, XCL, XCI, XTT, XLSTT, XLVTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PTHT)) :: &
- ZW, &
- ZT, &
- ZLSFACT, &
- ZLVFACT, &
- ZTCELSIUS
-!
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-P_TH_HONR(:) = 0.
-P_RR_HONR(:) = 0.
-P_CR_HONR(:) = 0.
-!
-! Temperature
-ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
-ZTCELSIUS(:) = ZT(:)-XTT ! T [°C]
-!
-ZW(:) = PEXNREF(:)*( XCPD+XCPV*PRVT(:)+XCL*(PRCT(:)+PRRT(:)) &
- +XCI*(PRIT(:)+PRST(:)+PRGT(:)) )
-ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZW(:) ! L_s/(Pi_ref*C_ph)
-ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZW(:) ! L_v/(Pi_ref*C_ph)
-!
-ZW(:) = 0.0
-
-WHERE( (ZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. LDCOMPUTE(:) )
- P_TH_HONR(:) = PRRT(:)*(ZLSFACT(:)-ZLVFACT(:))
- P_RR_HONR(:) = - PRRT(:)
- P_CR_HONR(:) = - PCRT(:)
- PB_TH(:) = PB_TH(:) + P_TH_HONR(:)
- PB_RR(:) = PB_RR(:) - PRRT(:)
- PB_CR(:) = PB_CR(:) - PCRT(:)
- PB_RG(:) = PB_RG(:) + PRRT(:)
-ENDWHERE
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPS_HOM_FREEZING
diff --git a/src/arome/micro/lima_drops_self_collection.F90 b/src/arome/micro/lima_drops_self_collection.F90
deleted file mode 100644
index adfa0adff737a653b4162183da102ede499ce06a..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_drops_self_collection.F90
+++ /dev/null
@@ -1,131 +0,0 @@
-! #################################
- MODULE MODI_LIMA_DROPS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU, &
- PA_CR )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-!
-END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_SELF_COLLECTION
-!
-! ######################################################################
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU, &
- PA_CR )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XACCR1, XSCBUEXP1, XSCBU_EFF1, XSCBU_EFF2, &
- XSCBU2, XSCBU3
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PCRT)) :: &
- ZW1, & ! work arrays
- ZW2, &
- ZW3, &
- ZW4, &
- ZSCBU
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-P_CR_SCBU(:)=0.
-!
-WHERE( PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:) )
- ZW4(:) = XACCR1 / PLBDR(:) ! Mean diameter
-END WHERE
-ZSCBU(:)=0.
-WHERE (ZW4(:)>=XSCBU_EFF1 .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:)) &
- ZSCBU(:) = EXP(XSCBUEXP1*(ZW4(:)-XSCBU_EFF1)) ! coalescence efficiency
-WHERE (ZW4(:)>=XSCBU_EFF2 .AND. LDCOMPUTE(:)) ZSCBU(:) = 0.0 ! Break-up
-!
-ZW1(:) = 0.0
-ZW2(:) = 0.0
-ZW3(:) = 0.0
-!
-WHERE (PCRT(:)>XCTMIN(3) .AND. (ZW4(:)>1.E-4) .AND. LDCOMPUTE(:)) ! analytical integration
- ZW1(:) = XSCBU2 * PCRT(:)**2 / PLBDR3(:) ! D>100 10-6 m
- ZW3(:) = ZW1(:)*ZSCBU(:)
-END WHERE
-!
-WHERE (PCRT(:)>XCTMIN(3) .AND. (ZW4(:)<=1.E-4) .AND. LDCOMPUTE(:))
- ZW2(:) = XSCBU3 *(PCRT(:) / PLBDR3(:))**2 ! D<100 10-6 m
- ZW3(:) = ZW2(:)
-END WHERE
-!
-P_CR_SCBU(:) = - ZW3(:) * PRHODREF(:)
-!
-PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
diff --git a/src/arome/micro/lima_functions.F90 b/src/arome/micro/lima_functions.F90
deleted file mode 100644
index 00bd01a6adb7f0ce8d097d200abd4af2a805a0c9..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_functions.F90
+++ /dev/null
@@ -1,380 +0,0 @@
-!#################################
- MODULE MODI_LIMA_FUNCTIONS
-!#################################
-!
-INTERFACE
-!
-FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
- LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB
- INTEGER, DIMENSION(:), INTENT(INOUT) :: I1,I2,I3
- INTEGER :: IC
-END FUNCTION COUNTJV
-!
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
- REAL, INTENT(IN) :: PALPHA
- REAL, INTENT(IN) :: PNU
- REAL, INTENT(IN) :: PP
- REAL :: PMOMG
-END FUNCTION MOMG
-!
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-END FUNCTION RECT
-!
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-END FUNCTION DELTA
-!
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-END FUNCTION DELTA_VEC
-!
-FUNCTION ARTH(FIRST,INCREMENT,N) RESULT(PARTH)
- REAL, INTENT(IN) :: FIRST,INCREMENT
- INTEGER, INTENT(IN) :: N
- REAL, DIMENSION(N) :: PARTH
-END FUNCTION ARTH
-!
-FUNCTION gammln(xx) RESULT(pgammln)
- REAL, INTENT(IN) :: xx
- REAL :: pgammln
-END FUNCTION gammln
-!
-SUBROUTINE GAULAG(x,w,n,alf)
- INTEGER, INTENT(IN) :: n
- REAL, INTENT(IN) :: alf
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAULAG
-!
-SUBROUTINE GAUHER(x,w,n)
- INTEGER, INTENT(IN) :: n
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAUHER
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_FUNCTIONS
-!
-!------------------------------------------------------------------------------
-!
-!#########################################
-FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!#########################################
-!
- IMPLICIT NONE
-!
- LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(:), INTENT(INOUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
-!
- IC = 0
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
-!
-END FUNCTION COUNTJV
-!
-!------------------------------------------------------------------------------
-!
-!###########################################
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
-!###########################################
-!
-! auxiliary routine used to compute the Pth moment order of the generalized
-! gamma law
-!
- USE MODI_GAMMA
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PP ! order of the moment
- REAL :: PMOMG ! result: moment of order ZP
-!
- PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
-!
-END FUNCTION MOMG
-!
-!------------------------------------------------------------------------------
-!
-!#############################################
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
-!#############################################
-!
-! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-!
- PRECT(:) = PB
- WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
- PRECT(:) = PA
- END WHERE
- RETURN
-!
-END FUNCTION RECT
-!
-!-------------------------------------------------------------------------------
-!
-!###############################################
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
-!###############################################
-!
-! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
-! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-!
-!* local variable
-!
- REAL :: ZA
-!
- ZA = 6.0*(PA-PB)/(PX2-PX1)**3
- WHERE (PX(:).LT.PX1)
- PDELTA(:) = PA
- ELSEWHERE (PX(:).GE.PX2)
- PDELTA(:) = PB
- ELSEWHERE
- PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
- + ZA*PX1*PX2* (PX(:)) &
- - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
- + (ZA/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA
-!
-!-------------------------------------------------------------------------------
-!
-!#######################################################
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
-!#######################################################
-!
-! Same as DELTA for vectorized PX1 and PX2 arguments
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-!
-!* local variable
-!
- REAL, DIMENSION(SIZE(PX,1)) :: ZA
-!
- ZA(:) = 0.0
- wHERE (PX(:)<=PX1(:))
- PDELTA_VEC(:) = PA
- ELSEWHERE (PX(:)>=PX2(:))
- PDELTA_VEC(:) = PB
- ELSEWHERE
- ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
- PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
- + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
- - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
- + (ZA(:)/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA_VEC
-!
-!-------------------------------------------------------------------------------
-!
-!#######################################################
-FUNCTION ARTH(FIRST,INCREMENT,N) RESULT(PARTH)
-!#######################################################
- REAL,INTENT(IN) :: FIRST,INCREMENT
- INTEGER,INTENT(IN) :: N
- REAL,DIMENSION(N) :: PARTH
- INTEGER :: K
-
- DO K=1,N
- PARTH(K)=FIRST+INCREMENT*(K-1)
- END DO
-END FUNCTION ARTH
-!
-!-------------------------------------------------------------------------------
-!
-!#######################################################
-FUNCTION gammln(xx) RESULT(pgammln)
-!#######################################################
-
- USE MODI_LIMA_FUNCTIONS, ONLY: ARTH
-
- IMPLICIT NONE
- REAL, INTENT(IN) :: xx
- REAL :: pgammln
- REAL :: tmp,x
- REAL :: stp = 2.5066282746310005
- REAL, DIMENSION(6) :: coef = (/76.18009172947146,&
- -86.50532032941677,24.01409824083091,&
- -1.231739572450155,0.1208650973866179e-2,&
- -0.5395239384953e-5/)
- x=xx
- tmp=x+5.5
- tmp=(x+0.5)*log(tmp)-tmp
- pgammln=tmp+log(stp*(1.000000000190015+&
- sum(coef(:)/arth(x+1.,1.,size(coef))))/x)
-!
-END FUNCTION gammln
-!
-!-------------------------------------------------------------------------------
-!
-!###########################
-SUBROUTINE gaulag(x,w,n,alf)
-!###########################
- INTEGER, INTENT(IN) :: n
- REAL, INTENT(IN) :: alf
- INTEGER MAXIT
- REAL w(n),x(n)
- DOUBLE PRECISION EPS
- PARAMETER (EPS=3.D-14,MAXIT=10)
- INTEGER i,its,j
- REAL ai
- DOUBLE PRECISION p1,p2,p3,pp,z,z1
-!
- REAL SUMW
-!
- do 13 i=1,n
- if(i.eq.1)then
- z=(1.+alf)*(3.+.92*alf)/(1.+2.4*n+1.8*alf)
- else if(i.eq.2)then
- z=z+(15.+6.25*alf)/(1.+.9*alf+2.5*n)
- else
- ai=i-2
- z=z+((1.+2.55*ai)/(1.9*ai)+1.26*ai*alf/(1.+3.5*ai))* &
- (z-x(i-2))/(1.+.3*alf)
- endif
- do 12 its=1,MAXIT
- p1=1.d0
- p2=0.d0
- do 11 j=1,n
- p3=p2
- p2=p1
- p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j
-11 continue
- pp=(n*p1-(n+alf)*p2)/z
- z1=z
- z=z1-p1/pp
- if(abs(z-z1).le.EPS)goto 1
-12 continue
-1 x(i)=z
- w(i)=-exp(gammln(alf+n)-gammln(float(n)))/(pp*n*p2)
-13 continue
-!
-! NORMALISATION
-!
- SUMW = 0.0
- DO 14 I=1,N
- SUMW = SUMW + W(I)
-14 CONTINUE
- DO 15 I=1,N
- W(I) = W(I)/SUMW
-15 CONTINUE
-!
- return
-END SUBROUTINE gaulag
-!
-!------------------------------------------------------------------------------
-!
-!##########################################
-SUBROUTINE gauher(x,w,n)
-!##########################################
- INTEGER, INTENT(IN) :: n
- INTEGER MAXIT
- REAL w(n),x(n)
- DOUBLE PRECISION EPS,PIM4
- PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
- INTEGER i,its,j,m
- DOUBLE PRECISION p1,p2,p3,pp,z,z1
-!
- REAL SUMW
-!
- m=(n+1)/2
- do 13 i=1,m
- if(i.eq.1)then
- z=sqrt(float(2*n+1))-1.85575*(2*n+1)**(-.16667)
- else if(i.eq.2)then
- z=z-1.14*n**.426/z
- else if (i.eq.3)then
- z=1.86*z-.86*x(1)
- else if (i.eq.4)then
- z=1.91*z-.91*x(2)
- else
- z=2.*z-x(i-2)
- endif
- do 12 its=1,MAXIT
- p1=PIM4
- p2=0.d0
- do 11 j=1,n
- p3=p2
- p2=p1
- p1=z*sqrt(2.d0/j)*p2-sqrt(dble(j-1)/dble(j))*p3
-11 continue
- pp=sqrt(2.d0*n)*p2
- z1=z
- z=z1-p1/pp
- if(abs(z-z1).le.EPS)goto 1
-12 continue
-1 x(i)=z
- x(n+1-i)=-z
- pp=pp/PIM4 ! NORMALIZATION
- w(i)=2.0/(pp*pp)
- w(n+1-i)=w(i)
-13 continue
-!
-! NORMALISATION
-!
- SUMW = 0.0
- DO 14 I=1,N
- SUMW = SUMW + W(I)
-14 CONTINUE
- DO 15 I=1,N
- W(I) = W(I)/SUMW
-15 CONTINUE
-!
- return
-END SUBROUTINE gauher
-!
-!------------------------------------------------------------------------------
diff --git a/src/arome/micro/lima_graupel.F90 b/src/arome/micro/lima_graupel.F90
deleted file mode 100644
index 4cd28def544eaf47f33e0ebb179bedaa1aec3d01..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_graupel.F90
+++ /dev/null
@@ -1,565 +0,0 @@
-! #################################
- MODULE MODI_LIMA_GRAUPEL
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-!
-END SUBROUTINE LIMA_GRAUPEL
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL
-!
-! ######################################################################
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT, LHAIL_LIMA
-USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC, &
- XFCDRYG, XFIDRYG, XCOLIG, XCOLSG, XCOLEXIG, XCOLEXSG, &
- XFSDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XKER_SDRYG, &
- XFRDRYG, XLBRDRYG1, XLBRDRYG2, XLBRDRYG3, XKER_RDRYG, &
- XHMTMIN, XHMTMAX, XHMLINTP1, XHMLINTP2, XHM_FACTG, XGAMINC_HMC, &
- XEX0DEPG, XEX1DEPG, &
- XDRYINTP1R, XDRYINTP1S, XDRYINTP1G, &
- XDRYINTP2R, XDRYINTP2S, XDRYINTP2G, &
- NDRYLBDAR, NDRYLBDAS, NDRYLBDAG
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XCXS, XBS
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(PRCT)) :: GDRY
-INTEGER :: IGDRY
-INTEGER :: JJ
-!
-REAL, DIMENSION(SIZE(PRCT)) :: Z1, Z2, Z3, Z4
-REAL, DIMENSION(SIZE(PRCT)) :: ZZX, ZZW, ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, ZZW7
-REAL, DIMENSION(SIZE(PRCT)) :: ZRDRYG, ZRWETG
-!
-INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
-REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
-!
-INTEGER :: NHAIL
-!
-!-------------------------------------------------------------------------------
-!
-!
-P_RC_WETG(:) = 0.
-P_CC_WETG(:) = 0.
-P_RR_WETG(:) = 0.
-P_CR_WETG(:) = 0.
-P_RI_WETG(:) = 0.
-P_CI_WETG(:) = 0.
-P_RS_WETG(:) = 0.
-P_RG_WETG(:) = 0.
-P_RH_WETG(:) = 0.
-!
-P_RC_DRYG(:) = 0.
-P_CC_DRYG(:) = 0.
-P_RR_DRYG(:) = 0.
-P_CR_DRYG(:) = 0.
-P_RI_DRYG(:) = 0.
-P_CI_DRYG(:) = 0.
-P_RS_DRYG(:) = 0.
-P_RG_DRYG(:) = 0.
-!
-P_RI_HMG(:) = 0.
-P_CI_HMG(:) = 0.
-P_RG_HMG(:) = 0.
-!
-P_RR_GMLT(:) = 0.
-P_CR_GMLT(:) = 0.
-!
-ZZW1(:) = 0. ! RCDRYG
-ZZW2(:) = 0. ! RIDRYG
-ZZW3(:) = 0. ! RSDRYG
-ZZW4(:) = 0. ! RRDRYG
-ZZW5(:) = 0. ! RIWETG
-ZZW6(:) = 0. ! RSWETG
-ZZW7(:) = 0. !
-!
-ZRDRYG(:) = 0.
-ZRWETG(:) = 0.
-!
-!
-!* 1. Graupel growth by collection (dry or wet case)
-! --------------------------------------------------
-!
-! 1.a Collection of rc and ri in the dry mode
-! --------------------------------------------
-!
-WHERE( PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
- ZZW(:) = PLBDG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
- ZZW1(:) = XFCDRYG * PRCT(:) * ZZW(:) ! RCDRYG - rc collected by graupel in dry mode
- ZZW2(:) = XFIDRYG * EXP( XCOLEXIG*(PT(:)-XTT) ) * PRIT(:) * ZZW(:) ! RIDRYG - ri collected by graupel in dry mode
-END WHERE
-!
-!* 1.b Collection of rs in the dry mode
-! ------------------------------------
-!
-GDRY(:) = (PRST(:)>XRTMIN(5)) .AND. (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:)
-!
-WHERE( GDRY )
-!
-!* Select the (ZLBDAG,ZLBDAS) couplet
-!
- ZVEC1(:) = PLBDG(:)
- ZVEC2(:) = PLBDS(:)
-!
-!* find the next lower indice for the ZLBDAG and for the ZLBDAS
-! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
-! tabulate the SDRYG-kernel
-!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(:) ) + XDRYINTP2G ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
-!
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, &
- XDRYINTP1S * LOG( ZVEC2(:) ) + XDRYINTP2S ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
-!
-!* perform the bilinear interpolation of the normalized
-! SDRYG-kernel
- !
- Z1(:) = GET_XKER_SDRYG(IVEC1(:)+1,IVEC2(:)+1)
- Z2(:) = GET_XKER_SDRYG(IVEC1(:)+1,IVEC2(:) )
- Z3(:) = GET_XKER_SDRYG(IVEC1(:) ,IVEC2(:)+1)
- Z4(:) = GET_XKER_SDRYG(IVEC1(:) ,IVEC2(:) )
- ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
- - Z2(:)*(ZVEC2(:) - 1.0) ) &
- * ZVEC1(:) &
- - ( Z3(:)* ZVEC2(:) &
- - Z4(:)*(ZVEC2(:) - 1.0) ) &
- * (ZVEC1(:) - 1.0)
- ZZW(:) = ZVEC3(:)
-!
- ZZW3(:) = XFSDRYG * ZZW(:) * EXP( XCOLEXSG*(PT(:)-XTT) ) & ! RSDRYG - rs collected by graupel in dry mode
- *( PLBDS(:)**(XCXS-XBS) )*( PLBDG(:)**XCXG ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSDRYG1/( PLBDG(:)**2 ) + &
- XLBSDRYG2/( PLBDG(:) * PLBDS(:) ) + &
- XLBSDRYG3/( PLBDS(:)**2) )
-END WHERE
-!
-!* 1.c Collection of rr in the dry mode
-! -------------------------------------
-!
-GDRY(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:)
-!
-WHERE( GDRY )
-!
-!* Select the (ZLBDAG,ZLBDAR) couplet
-!
- ZVEC1(:) = PLBDG(:)
- ZVEC2(:) = PLBDR(:)
-!
-!* Find the next lower indice for the ZLBDAG and for the ZLBDAR
-! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
-! tabulate the RDRYG-kernel
-!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(:) ) + XDRYINTP2G ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
-!
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, &
- XDRYINTP1R * LOG( ZVEC2(:) ) + XDRYINTP2R ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
-!
-!* Perform the bilinear interpolation of the normalized
-! RDRYG-kernel
-!
- Z1(:) = GET_XKER_RDRYG(IVEC1(:)+1,IVEC2(:)+1)
- Z2(:) = GET_XKER_RDRYG(IVEC1(:)+1,IVEC2(:) )
- Z3(:) = GET_XKER_RDRYG(IVEC1(:) ,IVEC2(:)+1)
- Z4(:) = GET_XKER_RDRYG(IVEC1(:) ,IVEC2(:) )
- ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
- - Z2(:)*(ZVEC2(:) - 1.0) ) &
- * ZVEC1(:) &
- - ( Z3(:)* ZVEC2(:) &
- - Z4(:)*(ZVEC2(:) - 1.0) ) &
- * (ZVEC1(:) - 1.0)
- ZZW(:) = ZVEC3(:)
-!
-! BVIE manque PCRT ???????????????????????????????????
-! ZZW4(:) = XFRDRYG * ZZW(:) & ! RRDRYG
- ZZW4(:) = XFRDRYG * ZZW(:) * PCRT(:) & ! RRDRYG
- *( PLBDG(:)**XCXG ) * ( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( PLBDG(:)**2 ) + &
- XLBRDRYG2/( PLBDG(:) * PLBDR(:) ) + &
- XLBRDRYG3/( PLBDR(:)**2) ) / PLBDR(:)**3
-END WHERE
-!
-! 1.d Total collection in the dry mode
-! ------------------------------------
-!
-ZRDRYG(:) = ZZW1(:) + ZZW2(:) + ZZW3(:) + ZZW4(:)
-!
-! 1.e Collection in the wet mode
-! ------------------------------
-!
-ZZW(:) = 0.0
-WHERE( PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
- ZZW5(:) = ZZW2(:) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)) ) ! RIWETG
- ZZW6(:) = ZZW3(:) / (XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT)) ) ! RSWETG
-!
- ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- ZZW(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*PT(:)) )
-!
-! Total mass gained by graupel in wet mode
- ZRWETG(:) = MAX( 0.0, &
- ( ZZW(:) * ( X0DEPG* PLBDG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG ) + &
- ( ZZW5(:)+ZZW6(:) ) * &
- ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
-END WHERE
-!
-! 1.f Wet mode and partial conversion to hail
-! -------------------------------------------
-!
-ZZW(:) = 0.0
-NHAIL = 0.
-IF (LHAIL_LIMA) NHAIL = 1.
-WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PT(:)<XTT &
- .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 )
-!
-! Mass of rain and cloud droplets frozen by graupel in wet mode : RCWETG + RRWETG = RWETG - RIWETG - RSWETG
- ZZW7(:) = ZRWETG(:) - ZZW5(:) - ZZW6(:)
-!
-! assume a linear percent of conversion of graupel into hail
-! ZZW = percentage of graupel transformed
-!
- ZZW(:) = ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
-!
- P_RC_WETG(:) = - ZZW1(:)
- P_CC_WETG(:) = P_RC_WETG(:) * PCCT(:)/MAX(PRCT(:),XRTMIN(2))
- P_RR_WETG(:) = - ZZW7(:) + ZZW1(:)
- P_CR_WETG(:) = P_RR_WETG(:) * PCRT(:)/MAX(PRRT(:),XRTMIN(3))
- P_RI_WETG(:) = - ZZW5(:)
- P_CI_WETG(:) = P_RI_WETG(:) * PCIT(:)/MAX(PRIT(:),XRTMIN(4))
- P_RS_WETG(:) = - ZZW6(:)
- P_RG_WETG(:) = - PRGT(:)/PTSTEP * ZZW(:) + ZRWETG(:) * (1.-ZZW(:))
- P_RH_WETG(:) = PRGT(:)/PTSTEP * ZZW(:) + ZRWETG(:) * ZZW(:)
- !
- P_TH_WETG(:) = ZZW7(:) * (PLSFACT(:)-PLVFACT(:))
-END WHERE
-!
-! 1.g Dry mode
-! ------------
-!
-WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PT(:)<XTT &
- .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 )
- !
- P_RC_DRYG(:) = - ZZW1(:)
- P_CC_DRYG(:) = P_RC_DRYG(:) * PCCT(:)/MAX(PRCT(:),XRTMIN(2))
- P_RR_DRYG(:) = - ZZW4(:)
- P_CR_DRYG(:) = P_RR_DRYG(:) * PCRT(:)/MAX(PRRT(:),XRTMIN(3))
- P_RI_DRYG(:) = - ZZW2(:)
- P_CI_DRYG(:) = P_RI_DRYG(:) * PCIT(:)/MAX(PRIT(:),XRTMIN(4))
- P_RS_DRYG(:) = - ZZW3(:)
- P_RG_DRYG(:) = ZRDRYG(:)
- !
- P_TH_DRYG(:) = (ZZW1(:) + ZZW4(:)) * (PLSFACT(:)-PLVFACT(:))
-END WHERE
-!
-!
-!* 2. Hallett-Mossop process (HMG)
-! --------------------------------
-!
-! BVIE test ZRDRYG<ZZW ?????????????????????????
-!GDRY(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
-GDRY(:) = (PT(:)<XHMTMAX) .AND. (PT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))&
- .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRCT(:)>XRTMIN(2)) .AND. LDCOMPUTE(:)
-
-WHERE( GDRY )
-!
- ZVEC1(:) = PLBDC(:)
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
- XHMLINTP1 * LOG( ZVEC1(:) ) + XHMLINTP2 ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
- ZVEC1(:) = XGAMINC_HMC( IVEC2(:)+1 )* ZVEC2(:) &
- - XGAMINC_HMC( IVEC2(:) )*(ZVEC2(:) - 1.0)
- ZZX(:) = ZVEC1(:) ! Large droplets
-!
- WHERE ( ZZX(:)<0.99 ) ! Dry case
- P_CI_HMG(:) = ZZW1(:)*(PCCT(:)/PRCT(:))*(1.0-ZZX(:))*XHM_FACTG* &
- MAX( 0.0, MIN( (PT(:)-XHMTMIN)/3.0,(XHMTMAX-PT(:))/2.0 ) )
- P_RI_HMG(:) = P_CI_HMG(:) * XMNU0
- P_RG_HMG(:) = - P_RI_HMG(:)
- END WHERE
-END WHERE
-!
-!
-!* 3. Graupel Melting
-! -------------------
-!
-ZZX(:) = 0.0
-WHERE( (PRGT(:)>XRTMIN(6)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
- ZZX(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- ZZX(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZZX(:))/(XRV*PT(:)) )
-!
-! compute RGMLTR
-!
- ZZX(:) = MAX( 0.0,( -ZZX(:) * &
- ( X0DEPG* PLBDG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG ) - &
- ( ZZW1(:)+ZZW4(:) ) * &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- P_RR_GMLT(:) = ZZX(:)
- P_CR_GMLT(:) = ZZX(:) * 5.0E6 ! obtained after averaging, Dshed=1mm and 500 microns
- !
- P_TH_GMLT(:) = - P_RR_GMLT(:) * (PLSFACT(:)-PLVFACT(:))
-END WHERE
-!
-!
-!
-!
-PA_RC(:) = PA_RC(:) + P_RC_WETG(:) + P_RC_DRYG(:)
-PA_CC(:) = PA_CC(:) + P_CC_WETG(:) + P_CC_DRYG(:)
-PA_RR(:) = PA_RR(:) + P_RR_WETG(:) + P_RR_DRYG(:) + P_RR_GMLT(:)
-PA_CR(:) = PA_CR(:) + P_CR_WETG(:) + P_CR_DRYG(:) + P_CR_GMLT(:)
-PA_RI(:) = PA_RI(:) + P_RI_WETG(:) + P_RI_DRYG(:) + P_RI_HMG(:)
-PA_CI(:) = PA_CI(:) + P_CI_WETG(:) + P_CI_DRYG(:) + P_CI_HMG(:)
-PA_RS(:) = PA_RS(:) + P_RS_WETG(:) + P_RS_DRYG(:)
-PA_RG(:) = PA_RG(:) + P_RG_WETG(:) + P_RG_DRYG(:) + P_RG_HMG(:) - P_RR_GMLT(:)
-PA_RH(:) = PA_RH(:) + P_RH_WETG(:)
-PA_TH(:) = PA_TH(:) + P_TH_WETG(:) + P_TH_DRYG(:) + P_TH_GMLT(:)
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
- FUNCTION GET_XKER_SDRYG(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
- REAL, DIMENSION(SIZE(SNOW)) :: RET
- !
- INTEGER I
- !
- DO I=1,SIZE(GRAUPEL)
- RET(I) = XKER_SDRYG(MAX(MIN(GRAUPEL(I),SIZE(XKER_SDRYG,1)),1),MAX(MIN(SNOW(I),SIZE(XKER_SDRYG,2)),1))
- END DO
- END FUNCTION GET_XKER_SDRYG
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION GET_XKER_RDRYG(GRAUPEL,RAIN) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: RAIN
- REAL, DIMENSION(SIZE(RAIN)) :: RET
- !
- INTEGER I
- !
- DO I=1,SIZE(GRAUPEL)
- RET(I) = XKER_RDRYG(MAX(MIN(GRAUPEL(I),SIZE(XKER_RDRYG,1)),1),MAX(MIN(RAIN(I),SIZE(XKER_RDRYG,2)),1))
- END DO
- END FUNCTION GET_XKER_RDRYG
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_GRAUPEL
diff --git a/src/arome/micro/lima_graupel_deposition.F90 b/src/arome/micro/lima_graupel_deposition.F90
deleted file mode 100644
index c7b61b1c851f08848e3e01061d83af3f4c0c269c..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_graupel_deposition.F90
+++ /dev/null
@@ -1,115 +0,0 @@
-! #################################
- MODULE MODI_LIMA_GRAUPEL_DEPOSITION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!!
-END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL_DEPOSITION
-!
-! ######################################################################
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
-USE MODD_PARAM_LIMA_MIXED, ONLY : X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 Declarations of local variables :
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-P_TH_DEPG(:) = 0.0
-P_RG_DEPG(:) = 0.0
-WHERE ( (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:) )
- !Correction BVIE RHODREF
- ! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
- P_RG_DEPG(:) = ( PSSI(:)/(PAI(:)) ) * &
- ( X0DEPG*PLBDG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDG(:)**XEX1DEPG )
- P_TH_DEPG(:) = P_RG_DEPG(:)*PLSFACT(:)
-END WHERE
-!
-PA_RV(:) = PA_RV(:) - P_RG_DEPG(:)
-PA_RG(:) = PA_RG(:) + P_RG_DEPG(:)
-PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
diff --git a/src/arome/micro/lima_ice_aggregation_snow.F90 b/src/arome/micro/lima_ice_aggregation_snow.F90
deleted file mode 100644
index e35ddfa09c6e27ff19153287d5bb61033bce9b6c..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_ice_aggregation_snow.F90
+++ /dev/null
@@ -1,144 +0,0 @@
-! #################################
- MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PT, &
- PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-!
-END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
-!
-! ######################################################################
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PT, &
- PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_COLD, ONLY : XBI, XCCS, XCXS, XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRIT)) :: ZZW1, ZZW2, ZZW3 ! work arrays
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
-! ---------------------------------------------------
-!
-ZZW1(:) = 0.
-ZZW2(:) = 0.
-ZZW3(:) = 0.
-!
-P_RI_AGGS(:) = 0.
-P_CI_AGGS(:) = 0.
-!
-!!$print *, "aggregation of i on s"
-!!$print *, "ri", PRIT(156,2,22)
-!!$print *, "Ni", PCIT(156,2,22)
-!!$print *, "rs", PRST(156,2,22)
-!!$print *, "lambda i", PLBDI(156,2,22)
-!!$print *, "lambda s", PLBDS(156,2,22)
-!!$print *, "T", PT(156,2,22)
-!!$print *, "C1", XAGGS_CLARGE1
-!!$print *, "C2", XAGGS_CLARGE2
-!!$print *, "R1", XAGGS_RLARGE1
-!!$print *, "R2", XAGGS_RLARGE2
-!
-WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) )
- ZZW1(:) = (PLBDI(:) / PLBDS(:))**3
- ZZW2(:) = (PCIT(:)*(XCCS*PLBDS(:)**XCXS)*EXP( XCOLEXIS*(PT(:)-XTT) )) &
- / (PLBDI(:)**3)
- ZZW3(:) = ZZW2(:)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:))
-!
- P_CI_AGGS(:) = - ZZW3(:)
-!
- ZZW2(:) = ZZW2(:) / PLBDI(:)**XBI
- ZZW2(:) = ZZW2(:)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:))
-!
- P_RI_AGGS(:) = - ZZW2(:)
-END WHERE
-!
-!!$print *, "tendance ci", P_CI_AGGS(156,2,22)
-!!$print *, "tendance ri", P_RI_AGGS(156,2,22)
-!
-PA_RI(:) = PA_RI(:) + P_RI_AGGS(:)
-PA_CI(:) = PA_CI(:) + P_CI_AGGS(:)
-PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
diff --git a/src/arome/micro/lima_ice_melting.F90 b/src/arome/micro/lima_ice_melting.F90
deleted file mode 100644
index 88ea17f0ede09beb2c4d801224c49e0d0a532aba..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_ice_melting.F90
+++ /dev/null
@@ -1,169 +0,0 @@
-! #################################
- MODULE MODI_LIMA_ICE_MELTING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
-!
-END SUBROUTINE LIMA_ICE_MELTING
-END INTERFACE
-END MODULE MODI_LIMA_ICE_MELTING
-!
-! ######################################################################
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XP00, XRD, XCPD, XCPV, XCL, XCI, XTT, XLSTT, XLVTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, NMOD_IFN
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PTHT)) :: &
- ZW, &
- ZT, &
- ZTCELSIUS,&
- ZLSFACT, &
- ZLVFACT, &
- ZMASK
-!
-INTEGER :: JMOD_IFN
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-P_TH_IMLT(:) = 0.
-P_RC_IMLT(:) = 0.
-P_CC_IMLT(:) = 0.
-!
-! Temperature
-ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
-ZTCELSIUS(:) = ZT(:)-XTT
-!
-ZW(:) = PEXNREF(:)*( XCPD+XCPV*PRVT(:)+XCL*(PRCT(:)+PRRT(:)) &
- +XCI*(PRIT(:)+PRST(:)+PRGT(:)) )
-ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZW(:) ! L_s/(Pi_ref*C_ph)
-ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZW(:) ! L_v/(Pi_ref*C_ph)
-!
-ZW(:) = 0.0
-!
-ZMASK(:) = 0.
-!
-WHERE( (ZT(:)<XTT-35.0) .AND. (PRIT(:)>XRTMIN(3)) .AND. LDCOMPUTE(:) )
- P_TH_IMLT(:) = - PRIT(:)*(ZLSFACT(:)-ZLVFACT(:))
- P_RC_IMLT(:) = PRIT(:)
- P_CC_IMLT(:) = PCIT(:)
- PB_TH(:) = PB_TH(:) + P_TH_IMLT(:)
- PB_RC(:) = PB_RC(:) + PRIT(:)
- PB_CC(:) = PB_CC(:) + PCIT(:)
- PB_RI(:) = PB_RI(:) - PRIT(:)
- PB_CI(:) = PB_CI(:) - PCIT(:)
- ZMASK(:) = 1.
-ENDWHERE
-!
-DO JMOD_IFN = 1,NMOD_IFN
-! Correction BVIE aerosols not released but in droplets
-! ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) + ZINS(:,JMOD_IFN)*(1.-ZMASK(:))
- PB_IFNN(:,JMOD_IFN) = PB_IFNN(:,JMOD_IFN) - PINT(:,JMOD_IFN)* ZMASK(:)
-ENDDO
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_ICE_MELTING
diff --git a/src/arome/micro/lima_ice_snow_deposition.F90 b/src/arome/micro/lima_ice_snow_deposition.F90
deleted file mode 100644
index 8768b9e6cdfcfd1a971127d8926bbe131cfd18b0..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_ice_snow_deposition.F90
+++ /dev/null
@@ -1,242 +0,0 @@
-! #####################
- MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-!
-END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
-!
-! ######################################################################
-SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources
-!! for slow cold processes :
-!! - conversion of snow to ice
-!! - deposition of vapor on snow
-!! - conversion of ice to snow (Harrington 1995)
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI
-USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
- XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
- XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
- XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
- XDICNVS_LIM, XLBDAICNVS_LIM, &
- XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
- XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2
-
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
-!
-!
-!-------------------------------------------------------------------------------
-!
-P_RI_CNVI(:) = 0.
-P_CI_CNVI(:) = 0.
-P_TH_DEPS(:) = 0.
-P_RS_DEPS(:) = 0.
-P_RI_CNVS(:) = 0.
-P_CI_CNVS(:) = 0.
-!
-! Physical limitations
-!
-!
-! Looking for regions where computations are necessary
-!
-GMICRO(:) = .FALSE.
-GMICRO(:) = LDCOMPUTE(:) .AND. &
- (PRIT(:)>XRTMIN(4) .OR. &
- PRST(:)>XRTMIN(5))
-!
-!
-WHERE( GMICRO )
-!
-!* 2.1 Conversion of snow to r_i: RSCNVI
-! ----------------------------------------
-!
-!
- ZZW2(:) = 0.0
- ZZW(:) = 0.0
- WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) &
- .AND. (PSSI(:)<0.0) )
- ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS)
- ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS) * (ZZW(:)**XNUI) * EXP(-ZZW(:))
-!
-! Correction BVIE RHODREF
-! ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:)/ZRHODREF(:),ZRSS(:) )
- ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:)
-!
- ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) )
- END WHERE
-!
- P_RI_CNVI(:) = ZZW(:)
- P_CI_CNVI(:) = ZZW2(:)
-!
- PA_RI(:) = PA_RI(:) + P_RI_CNVI(:)
- PA_CI(:) = PA_CI(:) + P_CI_CNVI(:)
- PA_RS(:) = PA_RS(:) - P_RI_CNVI(:)
-!
-!
-!* 2.2 Deposition of water vapor on r_s: RVDEPS
-! -----------------------------------------------
-!
-!
- ZZW(:) = 0.0
- WHERE ( (PRST(:)>XRTMIN(5)) )
-!Correction BVIE rhodref
-! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
- ZZW(:) = ( PSSI(:)/(PAI(:)) ) * &
- ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS )
- ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:)))
- END WHERE
-!
- P_RS_DEPS(:) = ZZW(:)
- P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:)
-!
- PA_TH(:) = PA_TH(:) + P_TH_DEPS(:)
- PA_RV(:) = PA_RV(:) - P_RS_DEPS(:)
- PA_RS(:) = PA_RS(:) + P_RS_DEPS(:)
-!
-!
-!* 2.3 Conversion of pristine ice to r_s: RICNVS
-! ------------------------------------------------
-!
-!
- ZZW(:) = 0.0
- ZZW2(:) = 0.0
- WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) &
- .AND. (PSSI(:)>0.0) )
- ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI)
- ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
-!
-! Correction BVIE
-! ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:)/ZRHODREF(:) &
- ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:)
-!
- ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:))
- END WHERE
-!
-P_RI_CNVS(:) = - ZZW(:)
-P_CI_CNVS(:) = - ZZW2(:)
-!
-PA_RI(:) = PA_RI(:) + P_RI_CNVS(:)
-PA_CI(:) = PA_CI(:) + P_CI_CNVS(:)
-PA_RS(:) = PA_RS(:) - P_RI_CNVS(:)
-!
-!
-END WHERE
-!
-
-!
-END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
diff --git a/src/arome/micro/lima_inst_procs.F90 b/src/arome/micro/lima_inst_procs.F90
deleted file mode 100644
index afad8c32497150caa08e6521388b03ac351a1266..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_inst_procs.F90
+++ /dev/null
@@ -1,164 +0,0 @@
-! ###############################
- MODULE MODI_LIMA_INST_PROCS
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_INST_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN)
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
-!
- END SUBROUTINE LIMA_INST_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_INST_PROCS
-! #############################################################################
-SUBROUTINE LIMA_INST_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN)
-! #############################################################################
-!
-USE MODD_PARAM_LIMA, ONLY : LCOLD_LIMA, LNUCL_LIMA, LMEYERS_LIMA, LSNOW_LIMA, LWARM_LIMA, LACTI_LIMA, LRAIN_LIMA, LHHONI_LIMA, NMOD_CCN, NMOD_IFN
-!
-USE MODI_LIMA_DROPS_BREAK_UP
-USE MODI_LIMA_DROPS_HOM_FREEZING
-USE MODI_LIMA_ICE_MELTING
-
-IMPLICIT NONE
-
-
-
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_DROPS_BREAK_UP (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD_LIMA .AND. LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD_LIMA .AND. LWARM_LIMA) THEN
- CALL LIMA_ICE_MELTING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_INST_PROCS
diff --git a/src/arome/micro/lima_meyers.F90 b/src/arome/micro/lima_meyers.F90
deleted file mode 100644
index a10953731a448a6cfd393e63f7e94bff6eb4629a..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_meyers.F90
+++ /dev/null
@@ -1,486 +0,0 @@
-! #######################
- MODULE MODI_LIMA_MEYERS
-! #######################
-!
-INTERFACE
- SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCCS, PCIS, PINS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
- !for IMMERSION
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_MEYERS
-END INTERFACE
-END MODULE MODI_LIMA_MEYERS
-!
-! ######################################################################
- SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCCS, PCIS, PINS, &
- YDDDH, YDLDDH, YDMDDH )
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the heterogeneous nucleation
-!! following Phillips (2008).
-!!
-!!
-!!** METHOD
-!! ------
-!! The parameterization of Phillips (2008) is based on observed nucleation
-!! in the CFDC for a range of T and Si values. Phillips therefore defines a
-!! reference activity spectrum, that is, for given T and Si values, the
-!! reference concentration of primary ice crystals.
-!!
-!! The activation of IFN is closely related to their total surface. Thus,
-!! the activable fraction of each IFN specie is determined by an integration
-!! over the particle size distributions.
-!!
-!! Subroutine organisation :
-!!
-!! 1- Preliminary computations
-!! 2- Check where computations are necessary, and pack variables
-!! 3- Compute the saturation over water and ice
-!! 4- Compute the reference activity spectrum
-!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
-!! Integrate over the size distributions to compute the IFN activable fraction
-!! -> CALL LIMA_PHILLIPS_INTEG
-!! 5- Heterogeneous nucleation of insoluble IFN
-!! 6- Heterogeneous nucleation of coated IFN
-!! 7- Unpack variables & deallocations
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_COLD
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL ! Loop index
-INTEGER :: INEGT ! Case number of nucleation
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the nucleation
-!
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
- ! by Deposition/Contact
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZSSI
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-! Temperature
-!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Saturation over ice
-!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
-!
-!
-!-------------------------------------------------------------------------------
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
- ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-IF( INEGT >= 1 ) THEN
- ALLOCATE(ZRVT(INEGT))
- ALLOCATE(ZRCT(INEGT))
- ALLOCATE(ZRRT(INEGT))
- ALLOCATE(ZRIT(INEGT))
- ALLOCATE(ZRST(INEGT))
- ALLOCATE(ZRGT(INEGT))
-!
- ALLOCATE(ZCCT(INEGT))
-!
- ALLOCATE(ZRVS(INEGT))
- ALLOCATE(ZRCS(INEGT))
- ALLOCATE(ZRIS(INEGT))
-!
- ALLOCATE(ZTHS(INEGT))
-!
- ALLOCATE(ZCCS(INEGT))
- ALLOCATE(ZINS(INEGT,1))
- ALLOCATE(ZCIS(INEGT))
-!
- ALLOCATE(ZRHODREF(INEGT))
- ALLOCATE(ZZT(INEGT))
- ALLOCATE(ZPRES(INEGT))
- ALLOCATE(ZEXNREF(INEGT))
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
-!
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
-!
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(INEGT))
- ALLOCATE(ZZX(INEGT))
- ALLOCATE(ZZY(INEGT))
- ALLOCATE(ZLSFACT(INEGT))
- ALLOCATE(ZLVFACT(INEGT))
- ALLOCATE(ZSSI(INEGT))
- ALLOCATE(ZTCELSIUS(INEGT))
-!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
- ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
- ! Supersaturation over ice
-!
-!* compute the heterogeneous nucleation by deposition: RVHNDI
-!
- DO JL=1,INEGT
- ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
- END DO
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZZY(:) = 0.0
-!
- WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/(PTSTEP*ZRHODREF(:))
- ZZX(:) = MAX( ZZY(:)-ZINS(:,1) , 0.0 )
- ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
- END WHERE
-!
- ZINS(:,1) = ZINS(:,1) + ZZX(:)
- ZW(:,:,:) = PINS(:,:,:,1)
- PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
-!
- ZRVS(:) = ZRVS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNDI))
- ZCIS(:) = ZCIS(:) + ZZX(:)
-!
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-!* compute the heterogeneous nucleation by contact: RVHNCI
-!
- DO JL=1,INEGT
- ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
- END DO
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZZY(:) = 0.0
-!
- WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
- ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
- /(PTSTEP*ZRHODREF(:)) , ZCCS(:) )
- ZZX(:) = MAX( ZZY(:)-ZINS(:,1),0.0 )
- ZZW(:) = MIN( (ZRCT(:)/ZCCT(:))*ZZX(:),ZRCS(:) )
- END WHERE
-!
- ZINS(:,1) = ZINS(:,1) + ZZX(:)
- ZW(:,:,:) = PINS(:,:,:,1)
- PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
-!
- ZRCS(:) = ZRCS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNCI))
- ZCCS(:) = ZCCS(:) - ZZX(:)
- ZCIS(:) = ZCIS(:) + ZZX(:)
-!
-!* unpack variables
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCCS(:,:,:)
- PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIS(:,:,:)
- PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:), 4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:), 7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:), 9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
-!
- DEALLOCATE(ZCCT)
-!
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZRIS)
-!
- DEALLOCATE(ZTHS)
-!
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZINS)
- DEALLOCATE(ZCIS)
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZTCELSIUS)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZSSI)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-END IF
-
-
-
-
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_MEYERS
diff --git a/src/arome/micro/lima_meyers_nucleation.F90 b/src/arome/micro/lima_meyers_nucleation.F90
deleted file mode 100644
index 2b90ca08c6b59dc50f8de755ce8a782755b420f6..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_meyers_nucleation.F90
+++ /dev/null
@@ -1,370 +0,0 @@
-! ##################################
- MODULE MODI_LIMA_MEYERS_NUCLEATION
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_RC_HINC, P_CC_HINC )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
-!
-END SUBROUTINE LIMA_MEYERS_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_MEYERS_NUCLEATION
-!
-! ######################################################################
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_RC_HINC, P_CC_HINC )
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the heterogeneous nucleation
-!! following Phillips (2008).
-!!
-!!
-!!** METHOD
-!! ------
-!! The parameterization of Phillips (2008) is based on observed nucleation
-!! in the CFDC for a range of T and Si values. Phillips therefore defines a
-!! reference activity spectrum, that is, for given T and Si values, the
-!! reference concentration of primary ice crystals.
-!!
-!! The activation of IFN is closely related to their total surface. Thus,
-!! the activable fraction of each IFN specie is determined by an integration
-!! over the particle size distributions.
-!!
-!! Subroutine organisation :
-!!
-!! 1- Preliminary computations
-!! 2- Check where computations are necessary, and pack variables
-!! 3- Compute the saturation over water and ice
-!! 4- Compute the reference activity spectrum
-!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
-!! Integrate over the size distributions to compute the IFN activable fraction
-!! -> CALL LIMA_PHILLIPS_INTEG
-!! 5- Heterogeneous nucleation of insoluble IFN
-!! 6- Heterogeneous nucleation of coated IFN
-!! 7- Unpack variables & deallocations
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_COLD
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
-!
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL ! Loop index
-INTEGER :: INEGT ! Case number of nucleation
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the nucleation
-!
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Theta source
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINT ! Nucleated Ice nuclei conc. source
- ! by Deposition/Contact
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZSSI
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-P_TH_HIND(:,:,:) = 0.
-P_RI_HIND(:,:,:) = 0.
-P_CI_HIND(:,:,:) = 0.
-P_RC_HINC(:,:,:) = 0.
-P_CC_HINC(:,:,:) = 0.
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PTHT,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PTHT,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PTHT,3) - JPVEXT
-!
-! Temperature
-!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Saturation over ice
-!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
-!
-!
-!-------------------------------------------------------------------------------
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
- ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-IF( INEGT >= 1 ) THEN
- ALLOCATE(ZRVT(INEGT))
- ALLOCATE(ZRCT(INEGT))
- ALLOCATE(ZRRT(INEGT))
- ALLOCATE(ZRIT(INEGT))
- ALLOCATE(ZRST(INEGT))
- ALLOCATE(ZRGT(INEGT))
-!
- ALLOCATE(ZTHT(INEGT))
-!
- ALLOCATE(ZCCT(INEGT))
- ALLOCATE(ZINT(INEGT,1))
- ALLOCATE(ZCIT(INEGT))
-!
- ALLOCATE(ZRHODREF(INEGT))
- ALLOCATE(ZZT(INEGT))
- ALLOCATE(ZPRES(INEGT))
- ALLOCATE(ZEXNREF(INEGT))
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
-!
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
-!
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
-!
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(INEGT))
- ALLOCATE(ZZX(INEGT))
- ALLOCATE(ZZY(INEGT))
- ALLOCATE(ZLSFACT(INEGT))
- ALLOCATE(ZLVFACT(INEGT))
- ALLOCATE(ZSSI(INEGT))
- ALLOCATE(ZTCELSIUS(INEGT))
-!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
- ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
- ! Supersaturation over ice
-!
-!---------------------------------------------------------------------------
-!
-!* compute the heterogeneous nucleation by deposition: RVHNDI
-!
- DO JL=1,INEGT
- ZINT(JL,1) = PINT(I1(JL),I2(JL),I3(JL),1)
- END DO
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZZY(:) = 0.0
-!
- WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/ZRHODREF(:)
- ZZX(:) = MAX( ZZY(:)-ZINT(:,1) , 0.0 ) ! number of ice crystals formed at this time step #/kg
- ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVT(:) ) ! mass of ice formed at this time step (kg/kg)
- END WHERE
- !
- P_CI_HIND(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
- P_RI_HIND(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
- P_TH_HIND(:,:,:) = UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HIND(:,:,:)
- PRVT(:,:,:) = PRVT(:,:,:) - P_RI_HIND(:,:,:)
- PRIT(:,:,:) = PRIT(:,:,:) + P_RI_HIND(:,:,:)
- PCIT(:,:,:) = PCIT(:,:,:) + P_CI_HIND(:,:,:)
- PINT(:,:,:,1) = PINT(:,:,:,1) + P_CI_HIND(:,:,:)
-!
-!---------------------------------------------------------------------------
-!
-!* compute the heterogeneous nucleation by contact: RVHNCI
-!
-!
- DO JL=1,INEGT
- ZINT(JL,1) = PINT(I1(JL),I2(JL),I3(JL),1)
- END DO
- ZZW(:) = 0.0
- ZZX(:) = 0.0
- ZZY(:) = 0.0
-!
- WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
- ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
- /ZRHODREF(:) , ZCCT(:) )
- ZZX(:) = MAX( ZZY(:)-ZINT(:,1),0.0 )
- ZZW(:) = MIN( (ZRCT(:)/ZCCT(:))*ZZX(:),ZRCT(:) )
- END WHERE
-!
- P_RC_HINC(:,:,:) = - UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
- P_CC_HINC(:,:,:) = - UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
- PRCT(:,:,:) = PRCT(:,:,:) + P_RC_HINC(:,:,:)
- PRIT(:,:,:) = PRIT(:,:,:) - P_RC_HINC(:,:,:)
- PCCT(:,:,:) = PCCT(:,:,:) + P_CC_HINC(:,:,:)
- PCIT(:,:,:) = PCIT(:,:,:) - P_CC_HINC(:,:,:)
- PINT(:,:,:,1) = PINT(:,:,:,1) - P_CC_HINC(:,:,:)
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
-!
- DEALLOCATE(ZTHT)
-!
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZINT)
- DEALLOCATE(ZCIT)
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZTCELSIUS)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZSSI)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_MEYERS_NUCLEATION
diff --git a/src/arome/micro/lima_mixed.F90 b/src/arome/micro/lima_mixed.F90
deleted file mode 100644
index 000b503761054740e5f1279e7f1f093d8c4c13c1..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_mixed.F90
+++ /dev/null
@@ -1,816 +0,0 @@
-! ######################
- MODULE MODI_LIMA_MIXED
-! ######################
-!
-INTERFACE
- SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHM, PPABSM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integration for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_MIXED
-END INTERFACE
-END MODULE MODI_LIMA_MIXED
-!
-! #######################################################################
- SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHM, PPABSM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- YDDDH, YDLDDH, YDMDDH )
-! #######################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the mixed-phase
-!! microphysical processes
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Most of the parameterizations come from the ICE3 scheme, described in
-!! the MESO-NH scientific documentation.
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMLUN , ONLY : NULOUT
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
- XCL, XCI, XTT, XLSTT, XLVTT, &
- XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, XRTMIN, XCTMIN, LWARM_LIMA, LCOLD_LIMA, &
- NMOD_CCN, NMOD_IMM, LRAIN_LIMA, LHAIL_LIMA
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC
-USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH
-!USE MODD_BUDGET, ONLY : LBU_ENABLE, NBUMOD
-!
-USE MODD_NSV
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_MIXED_SLOW_PROCESSES
-USE MODI_LIMA_MIXED_FAST_PROCESSES
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integration for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-!3D microphysical variables
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: PRVT, & ! Water vapor m.r. at t
- PRCT, & ! Cloud water m.r. at t
- PRRT, & ! Rain water m.r. at t
- PRIT, & ! Cloud ice m.r. at t
- PRST, & ! Snow/aggregate m.r. at t
- PRGT, & ! Graupel m.r. at t
- PRHT, & ! Hail m.r. at t
- !
- PRVS, & ! Water vapor m.r. source
- PRCS, & ! Cloud water m.r. source
- PRRS, & ! Rain water m.r. source
- PRIS, & ! Pristine ice m.r. source
- PRSS, & ! Snow/aggregate m.r. source
- PRGS, & ! Graupel m.r. source
- PRHS, & ! Hail m.r. source
- !
- PCCT, & ! Cloud water C. at t
- PCRT, & ! Rain water C. at t
- PCIT, & ! Ice crystal C. at t
- !
- PCCS, & ! Cloud water C. source
- PCRS, & ! Rain water C. source
- PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Hom. freezing of CCN
-!
-! Replace PACK
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
-INTEGER :: IMICRO
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed microphysical variables
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! Rain water conc. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
-!
-! Other packed variables
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZSSI, & ! Supersaturation over ice
- ZLBDAC, & ! Slope parameter of the cloud droplet distr.
- ZLBDAR, & ! Slope parameter of the raindrop distr.
- ZLBDAI, & ! Slope parameter of the ice crystal distr.
- ZLBDAS, & ! Slope parameter of the aggregate distr.
- ZLBDAG, & ! Slope parameter of the graupel distr.
- ZLBDAH, & ! Slope parameter of the hail distr.
- ZAI, & ! Thermodynamical function
- ZCJ, & ! used to compute the ventilation coefficient
- ZKA, & ! Thermal conductivity of the air
- ZDV ! Diffusivity of water vapor in the air
-!
-! 3D Temperature
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZT, ZW
-!
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JMOD_IFN ! Loop index
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. 3D MICROPHYSCAL VARIABLES
-! -------------------------
-!
-!
-! Prepare 3D water mixing ratios
-PRVT(:,:,:) = PRT(:,:,:,1)
-PRVS(:,:,:) = PRS(:,:,:,1)
-!
-PRCT(:,:,:) = 0.
-PRCS(:,:,:) = 0.
-PRRT(:,:,:) = 0.
-PRRS(:,:,:) = 0.
-PRIT(:,:,:) = 0.
-PRIS(:,:,:) = 0.
-PRST(:,:,:) = 0.
-PRSS(:,:,:) = 0.
-PRGT(:,:,:) = 0.
-PRGS(:,:,:) = 0.
-PRHT(:,:,:) = 0.
-PRHS(:,:,:) = 0.
-!
-IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
-IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
-IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
-IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
-IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
-IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
-IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
-IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
-IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
-IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
-IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
-IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
-!
-! Prepare 3D number concentrations
-PCCT(:,:,:) = 0.
-PCRT(:,:,:) = 0.
-PCIT(:,:,:) = 0.
-PCCS(:,:,:) = 0.
-PCRS(:,:,:) = 0.
-PCIS(:,:,:) = 0.
-!
-IF ( LWARM_LIMA ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD_LIMA ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
-!
-IF ( LWARM_LIMA ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD_LIMA ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-ELSE
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
-END IF
-!
-IF ( NMOD_IFN .GE. 1 ) THEN
- ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
- PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
- PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-ELSE
- ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PIFS(:,:,:,:) = 0.
- PINS(:,:,:,:) = 0.
-END IF
-!
-IF ( NMOD_IMM .GE. 1 ) THEN
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
- PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-ELSE
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNIS(:,:,:,:) = 0.0
-END IF
-!
-IF ( OHHONI ) THEN
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
-ELSE
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = 0.0
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. Pack variables, computations only where necessary
-! -------------------------------------------------
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Looking for regions where computations are necessary
-GMICRO(:,:,:) = .FALSE.
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
- PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) .OR. &
- PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
- PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5) .OR. &
- PRGT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(6) .OR. &
- PRHT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(7)
-!
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-!
-IF( IMICRO >= 1 ) THEN
-!
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRCT(IMICRO))
- ALLOCATE(ZRRT(IMICRO))
- ALLOCATE(ZRIT(IMICRO))
- ALLOCATE(ZRST(IMICRO))
- ALLOCATE(ZRGT(IMICRO))
- ALLOCATE(ZRHT(IMICRO))
- !
- ALLOCATE(ZCCT(IMICRO))
- ALLOCATE(ZCRT(IMICRO))
- ALLOCATE(ZCIT(IMICRO))
- !
- ALLOCATE(ZRVS(IMICRO))
- ALLOCATE(ZRCS(IMICRO))
- ALLOCATE(ZRRS(IMICRO))
- ALLOCATE(ZRIS(IMICRO))
- ALLOCATE(ZRSS(IMICRO))
- ALLOCATE(ZRGS(IMICRO))
- ALLOCATE(ZRHS(IMICRO))
- ALLOCATE(ZTHS(IMICRO))
- !
- ALLOCATE(ZCCS(IMICRO))
- ALLOCATE(ZCRS(IMICRO))
- ALLOCATE(ZCIS(IMICRO))
- ALLOCATE(ZIFS(IMICRO,NMOD_IFN))
- ALLOCATE(ZINS(IMICRO,NMOD_IFN))
- !
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZEXNREF(IMICRO))
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- !
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- !
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
- ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
- ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
- !
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
- DO JMOD_IFN = 1, NMOD_IFN
- ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ENDDO
- !
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- ALLOCATE(ZRHODJ(IMICRO))
- ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
- END IF
-!
-! Atmospheric parameters
-!
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZLSFACT(IMICRO))
- ALLOCATE(ZLVFACT(IMICRO))
- ALLOCATE(ZSSI(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
-!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
-!
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
- ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
- ! Supersaturation over ice
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
-!
-! Thermodynamical function ZAI = A_i(T,P)
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
- + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
-! ZCJ = c^prime_j (in the ventilation factor)
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
-!
-!
-! Particle distribution parameters
-!
- ALLOCATE(ZLBDAC(IMICRO))
- ALLOCATE(ZLBDAR(IMICRO))
- ALLOCATE(ZLBDAI(IMICRO))
- ALLOCATE(ZLBDAS(IMICRO))
- ALLOCATE(ZLBDAG(IMICRO))
- ALLOCATE(ZLBDAH(IMICRO))
- ZLBDAC(:) = 1.E10
- WHERE (ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2))
- ZLBDAC(:) = ( XLBC*ZCCT(:) / ZRCT(:) )**XLBEXC
- END WHERE
- ZLBDAR(:) = 1.E10
- WHERE (ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3))
- ZLBDAR(:) = ( XLBR*ZCRT(:) / ZRRT(:) )**XLBEXR
- END WHERE
- ZLBDAI(:) = 1.E10
- WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
- ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
- END WHERE
- ZLBDAS(:) = 1.E10
- WHERE (ZRST(:)>XRTMIN(5) )
- ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
- END WHERE
- ZLBDAG(:) = 1.E10
- WHERE (ZRGT(:)>XRTMIN(6) )
- ZLBDAG(:) = XLBG*( ZRHODREF(:)*ZRGT(:) )**XLBEXG
- END WHERE
- ZLBDAH(:) = 1.E10
- WHERE (ZRHT(:)>XRTMIN(7) )
- ZLBDAH(:) = XLBH*( ZRHODREF(:)*ZRHT(:) )**XLBEXH
- END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. Compute the slow processes involving cloud water and graupel
-! ------------------------------------------------------------
-!
- CALL LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
- ZLSFACT, ZLVFACT, ZAI, ZCJ, &
- ZRGT, ZCIT, &
- ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
- ZCCS, ZCIS, ZIFS, ZINS, &
- ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
- PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-!-------------------------------------------------------------------------------
-!
-!
-! 3. Compute the fast RS and RG processes
-! ------------------------------------
-!
- CALL LIMA_MIXED_FAST_PROCESSES(ZRHODREF, ZZT, ZPRES, PTSTEP, &
- ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
- ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZRHT, ZCCT, ZCRT, ZCIT, &
- ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
- ZTHS, ZCCS, ZCRS, ZCIS, &
- ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
- PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCS, PCRS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-! 4. Unpack variables
-! ----------------
-!
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRSS(:,:,:)
- PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRGS(:,:,:)
- PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRHS(:,:,:)
- PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = PCCS(:,:,:)
- PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCRS(:,:,:)
- PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIS(:,:,:)
- PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DO JMOD_IFN = 1, NMOD_IFN
- ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
- PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
- FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
- PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
- FIELD=ZW(:,:,:) )
- ENDDO
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
- DEALLOCATE(ZRHT)
-!
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZCRT)
- DEALLOCATE(ZCIT)
-!
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZRIS)
- DEALLOCATE(ZRSS)
- DEALLOCATE(ZRGS)
- DEALLOCATE(ZRHS)
- DEALLOCATE(ZTHS)
-!
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZCRS)
- DEALLOCATE(ZCIS)
- DEALLOCATE(ZIFS)
- DEALLOCATE(ZINS)
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
-!
- DEALLOCATE(ZZW)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZSSI)
- DEALLOCATE(ZAI)
- DEALLOCATE(ZCJ)
- DEALLOCATE(ZKA)
- DEALLOCATE(ZDV)
-!
- DEALLOCATE(ZLBDAC)
- DEALLOCATE(ZLBDAR)
- DEALLOCATE(ZLBDAI)
- DEALLOCATE(ZLBDAS)
- DEALLOCATE(ZLBDAG)
- DEALLOCATE(ZLBDAH)
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
-!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LHAIL_LIMA) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'COHG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'COHG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ENDIF
-
- ENDIF
-!
-END IF ! IMICRO >= 1
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 5. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
-! -------------------------------------------------
-!
-PRS(:,:,:,1) = PRVS(:,:,:)
-IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
-IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
-IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
-IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
-IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
-IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
-!
-! Prepare 3D number concentrations
-!
-PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LRAIN_LIMA ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
-PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
-END IF
-!
-IF ( NMOD_IFN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
-END IF
-!
-IF ( NMOD_IMM .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
-END IF
-!
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
-IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
-IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
-IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_MIXED
diff --git a/src/arome/micro/lima_mixed_fast_processes.F90 b/src/arome/micro/lima_mixed_fast_processes.F90
deleted file mode 100644
index 9bcfa9bb67e4266f3bfc89f07fe31e47027889c8..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_mixed_fast_processes.F90
+++ /dev/null
@@ -1,1341 +0,0 @@
-! #####################################
- MODULE MODI_LIMA_MIXED_FAST_PROCESSES
-! #####################################
-!
-INTERFACE
- SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
- ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
- ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZRHT, ZCCT, ZCRT, ZCIT, &
- ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
- ZTHS, ZCCS, ZCRS, ZCIS, &
- ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
- PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCS, PCRS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
-REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
-!
-! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-INTEGER, INTENT(IN) :: KMI
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
-END INTERFACE
-END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
-!
-! #######################################################################
- SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
- ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
- ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZRHT, ZCCT, ZCRT, ZCIT, &
- ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
- ZTHS, ZCCS, ZCRS, ZCIS, &
- ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
- PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCS, PCRS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-! #######################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the mixed-phase
-!! fast processes :
-!!
-!! - Fast RS processes :
-!! - Cloud droplet riming of the aggregates
-!! - Hallett-Mossop ice multiplication process due to snow riming
-!! - Rain accretion onto the aggregates
-!! - Conversion-Melting of the aggregates
-!!
-!! - Fast RG processes :
-!! - Rain contact freezing
-!! - Wet/Dry growth of the graupel
-!! - Hallett-Mossop ice multiplication process due to graupel riming
-!! - Melting of the graupeln
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Most of the parameterizations come from the ICE3 scheme, described in
-!! the MESO-NH scientific documentation.
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMLUN , ONLY : NULOUT
-!
-USE MODD_CST
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_COLD
-USE MODD_PARAM_LIMA_MIXED
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
-REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
-!
-! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-INTEGER, INTENT(IN) :: KMI
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
-
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(ZZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute
-INTEGER :: IGRIM, IGACC, IGDRY, IGWET, IHAIL
-INTEGER :: JJ
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
-REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZZX
-REAL, DIMENSION(SIZE(ZZT)) :: ZRDRYG, ZRWETG
-REAL, DIMENSION(SIZE(ZZT),7) :: ZZW1
-REAL :: NHAIL
-REAL :: ZTHRH, ZTHRC
-!
-!-------------------------------------------------------------------------------
-!
-! #################
-! FAST RS PROCESSES
-! #################
-!
-IF (LSNOW_LIMA) THEN
-!
-!
-!* 1.1 Cloud droplet riming of the aggregates
-! -------------------------------------------
-!
-!
-ZZW1(:,:) = 0.0
-!
-GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT)
-IGRIM = COUNT( GRIM(:) )
-!
-IF( IGRIM>0 ) THEN
-!
-! 1.1.0 allocations
-!
- ALLOCATE(ZVEC1(IGRIM))
- ALLOCATE(ZVEC2(IGRIM))
- ALLOCATE(IVEC1(IGRIM))
- ALLOCATE(IVEC2(IGRIM))
-!
-! 1.1.1 select the ZLBDAS
-!
- ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
-!
-! 1.1.2 find the next lower indice for the ZLBDAS 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) )
-!
-! 1.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(:),MASK=GRIM,FIELD=0.0 )
-!
-! 1.1.4 riming of the small sized aggregates
-!
- WHERE ( GRIM(:) )
- ZZW1(:,1) = MIN( ZRCS(:), &
- XCRIMSS * ZZW(:) * ZRCT(:) & ! RCRIMSS
- * ZLBDAS(:)**XEXCRIMSS &
- * ZRHODREF(:)**(-XCEXVT) )
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRSS(:) = ZRSS(:) + ZZW1(:,1)
- ZTHS(:) = ZTHS(:) + ZZW1(:,1)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSS))
-!
- ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
- END WHERE
-!
-! 1.1.5 perform the linear interpolation of the normalized
-! "XBS"-moment of the incomplete gamma function
-!
- 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(:),MASK=GRIM,FIELD=0.0 )
-!
-! 1.1.6 riming-conversion of the large sized aggregates into graupeln
-!
-!
- WHERE ( GRIM(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
- ZZW1(:,2) = MIN( ZRCS(:), &
- XCRIMSG * ZRCT(:) & ! RCRIMSG
- * ZLBDAS(:)**XEXCRIMSG &
- * ZRHODREF(:)**(-XCEXVT) &
- - ZZW1(:,1) )
- ZZW1(:,3) = MIN( ZRSS(:), &
- XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG
- * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:)))
- ZRCS(:) = ZRCS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) - ZZW1(:,3)
- ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3)
- ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSG))
-!
- ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,2)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
-! -----------------------------------------------------------------
-!
-!
-GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) &
- .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2))
-IGRIM = COUNT( GRIM(:) )
-IF( IGRIM>0 ) THEN
- ALLOCATE(ZVEC1(IGRIM))
- ALLOCATE(ZVEC2(IGRIM))
- ALLOCATE(IVEC2(IGRIM))
-!
- ZVEC1(:) = PACK( ZLBDAC(:),MASK=GRIM(:) )
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
- XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) )
- ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets
-!
- WHERE ( GRIM(:) .AND. ZZX(:)<0.99 )
- ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))* &
- XHM_FACTS* &
- MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMSI
- ZCIS(:) = ZCIS(:) + ZZW1(:,5)
-!
- ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI
- ZRIS(:) = ZRIS(:) + ZZW1(:,6)
- ZRSS(:) = ZRSS(:) - ZZW1(:,6)
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO,FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-END IF
-!
-!
-!* 1.3 Rain accretion onto the aggregates
-! ---------------------------------------
-!
-!
-ZZW1(:,2:3) = 0.0
-GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) .AND. (ZZT(:)<XTT)
-IGACC = COUNT( GACC(:) )
-!
-IF( IGACC>0 ) THEN
-!
-! 1.3.0 allocations
-!
- ALLOCATE(ZVEC1(IGACC))
- ALLOCATE(ZVEC2(IGACC))
- ALLOCATE(ZVEC3(IGACC))
- ALLOCATE(IVEC1(IGACC))
- ALLOCATE(IVEC2(IGACC))
-!
-! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet
-!
- ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
- ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
-!
-! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
-! 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) )
-!
-! 1.3.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(:),MASK=GACC,FIELD=0.0 )
-!
-! 1.3.4 raindrop accretion on the small sized aggregates
-!
- WHERE ( GACC(:) )
- ZZW1(:,2) = & !! coef of RRACCS
- XFRACCSS*( ZLBDAS(:)**XCXS )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/((ZLBDAS(:)**2) ) + &
- XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + &
- XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**3
- ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
- ZRRS(:) = ZRRS(:) - ZZW1(:,4)
- ZRSS(:) = ZRSS(:) + ZZW1(:,4)
- ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
-!
- ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
- END WHERE
-!
-! 1.3.4b perform the bilinear interpolation of the normalized
-! RACCS-kernel
-!
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
- ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS
-!
-! 1.3.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(:),MASK=GACC,FIELD=0.0 )
-!
-! 1.3.6 raindrop accretion-conversion of the large sized aggregates
-! into graupeln
-!
- WHERE ( GACC(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
- ZZW1(:,2) = MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) ! RRACCSG
- ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
- ( ZLBDAS(:)**(XCXS-XBS) )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((ZLBDAR(:)**2) ) + &
- XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + &
- XLBSACCR3/( (ZLBDAS(:)**2)) ) )
- ZRRS(:) = ZRRS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) - ZZW1(:,3)
- ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3)
- ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG))
-!
- ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,2)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!* 1.4 Conversion-Melting of the aggregates
-! -----------------------------------------
-!
-!
-ZZW(:) = 0.0
-WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RSMLT
-!
- ZZW(:) = MIN( ZRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
- ( X0DEPS* ZLBDAS(:)**XEX0DEPS + &
- X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
- ( ZRHODREF(:)*XLMTT ) ) )
-!
-! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
-! because the graupeln produced by this process are still icy!!!
-!
- ZRSS(:) = ZRSS(:) - ZZW(:)
- ZRGS(:) = ZRGS(:) + ZZW(:)
-END WHERE
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-END IF
-!
-END IF ! LSNOW_LIMA
-!
-!------------------------------------------------------------------------------
-!
-! #################
-! FAST RG PROCESSES
-! #################
-!
-!
-!* 2.1 Rain contact freezing
-! --------------------------
-!
-!
-ZZW1(:,3:4) = 0.0
-WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
- ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
- * ZLBDAR(:)**XEXICFRR &
- * ZRHODREF(:)**(-XCEXVT-1.0) )
-!
- ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) * ZCRT(:) & ! RRCFRIG
- * ZLBDAR(:)**XEXRCFRI &
- * ZRHODREF(:)**(-XCEXVT-2.0) )
- ZRIS(:) = ZRIS(:) - ZZW1(:,3)
- ZRRS(:) = ZRRS(:) - ZZW1(:,4)
- ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4)
- ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG)
-!
- ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG
- ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG
-END WHERE
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!* 2.2 Compute the Dry growth case
-! --------------------------------
-!
-!
-ZZW1(:,:) = 0.0
-WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. &
- ((ZRIT(:)>XRTMIN(4)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP)) )
- ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
- ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
- * ZRIT(:) * ZZW(:) ) ! RIDRYG
-END WHERE
-!
-!* 2.2.1 accretion of aggregates on the graupeln
-! ----------------------------------------------
-!
-GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP)
-IGDRY = COUNT( GDRY(:) )
-!
-IF( IGDRY>0 ) THEN
-!
-!* 2.2.2 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!
-!* 2.2.3 select the (ZLBDAG,ZLBDAS) couplet
-!
- ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
-!
-!* 2.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
-! 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) )
-!
-!* 2.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(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
- * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
- *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
- XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
- XLBSDRYG3/( ZLBDAS(:)**2) ) )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-!* 2.2.6 accretion of raindrops on the graupeln
-! ---------------------------------------------
-!
-GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>XRTMIN(3))
-IGDRY = COUNT( GDRY(:) )
-!
-IF( IGDRY>0 ) THEN
-!
-!* 2.2.7 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!
-!* 2.2.8 select the (ZLBDAG,ZLBDAR) couplet
-!
- ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
-!
-!* 2.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
-! 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) )
-!
-!* 2.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(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
- *( ZLBDAR(:)**(-3) )*( ZLBDAG(:)**XCXG ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
- XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
- XLBRDRYG3/( ZLBDAR(:)**2) ) )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
-!
-!
-!* 2.3 Compute the Wet growth case
-! --------------------------------
-!
-!
-ZZW(:) = 0.0
-ZRWETG(:) = 0.0
-WHERE( ZRGT(:)>XRTMIN(6) )
- ZZW1(:,5) = MIN( ZRIS(:), &
- ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
- ZZW1(:,6) = MIN( ZRSS(:), &
- ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
-!
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RWETG
-!
- ZRWETG(:) = MAX( 0.0, &
- ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
- X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + &
- ( ZZW1(:,5)+ZZW1(:,6) ) * &
- ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
- ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
-END WHERE
-!
-!
-!* 2.4 Select Wet or Dry case
-! ---------------------------
-!
-!
-! Wet case and partial conversion to hail
-!
-ZZW(:) = 0.0
-NHAIL = 0.
-IF (LHAIL_LIMA) NHAIL = 1.
-WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
- .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 )
-!
- ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
-!
-! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
-!
- ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
- ZZX(:) = ZZW1(:,7) / ZZW(:)
- ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
- ZZW1(:,6) = ZZW1(:,6)*ZZX(:)
- ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
-!
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,5)
- ZRSS(:) = ZRSS(:) - ZZW1(:,6)
-!
-! assume a linear percent of conversion of graupel into hail
-!
- ZRGS(:) = ZRGS(:) + ZRWETG(:)
- ZZW(:) = ZRGS(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
- ZRGS(:) = ZRGS(:) - ZZW(:)
- ZRHS(:) = ZRHS(:) + ZZW(:)
- ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
- ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
- ! f(L_f*(RCWETG+RRWETG))
-!
- ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
- ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,5)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
- ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) &
- *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
-END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-! Dry case
-!
-WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
- .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) - ZZW1(:,3)
- ZRRS(:) = ZRRS(:) - ZZW1(:,4)
- ZRGS(:) = ZRGS(:) + ZRDRYG(:)
- ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) !
- ! f(L_f*(RCDRYG+RRDRYG))
-!
- ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
- ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
- ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
- ! Approximate rates
-END WHERE
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming
-! --------------------------------------------------------------------
-!
-!
-GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
- .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2))
-IGDRY = COUNT( GDRY(:) )
-IF( IGDRY>0 ) THEN
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!
- ZVEC1(:) = PACK( ZLBDAC(:),MASK=GDRY(:) )
- ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
- XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) )
- IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
- ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
- ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) &
- - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0)
- ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets
-!
- WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case
- ZZW1(:,5) = ZZW1(:,1)*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))*XHM_FACTG* &
- MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMGI
- ZCIS(:) = ZCIS(:) + ZZW1(:,5)
-!
- ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI
- ZRIS(:) = ZRIS(:) + ZZW1(:,6)
- ZRGS(:) = ZRGS(:) - ZZW1(:,6)
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
-END IF
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO,FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-END IF
-!
-!
-!* 2.6 Melting of the graupeln
-! ----------------------------
-!
-!
-ZZW(:) = 0.0
-WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RGMLTR
-!
- ZZW(:) = MIN( ZRGS(:), MAX( 0.0,( -ZZW(:) * &
- ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
- X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
- ( ZRHODREF(:)*XLMTT ) ) )
- ZRRS(:) = ZRRS(:) + ZZW(:)
- ZRGS(:) = ZRGS(:) - ZZW(:)
- ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR))
-!
-! ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCG*ZLBDAG(:)**XCXG/ZRGT(:)),0.0 )
- ZCRS(:) = ZCRS(:) + ZZW(:)*5.0E6 ! obtained after averaging
- ! Dshed=1mm and 500 microns
-END WHERE
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!------------------------------------------------------------------------------
-!
-! #################
-! FAST RH PROCESSES
-! #################
-!
-!
-IF (LHAIL_LIMA) THEN
-!
-GHAIL(:) = ZRHT(:)>XRTMIN(7)
-IHAIL = COUNT(GHAIL(:))
-!
-IF( IHAIL>0 ) THEN
-!
-!* 3.1 Wet growth of hail
-! ----------------------------
-!
- ZZW1(:,:) = 0.0
- WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. &
- (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) )
- ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
- ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
- END WHERE
-!
-!* 3.1.1 accretion of aggregates on the hailstones
-! ------------------------------------------------
-!
- GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>XRTMIN(5)/PTSTEP)
- IGWET = COUNT( GWET(:) )
-!
- IF( IGWET>0 ) THEN
-!
-!* 3.1.2 allocations
-!
- ALLOCATE(ZVEC1(IGWET))
- ALLOCATE(ZVEC2(IGWET))
- ALLOCATE(ZVEC3(IGWET))
- ALLOCATE(IVEC1(IGWET))
- ALLOCATE(IVEC2(IGWET))
-!
-!* 3.1.3 select the (ZLBDAH,ZLBDAS) couplet
-!
- ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
-!
-!* 3.1.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
-! 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) )
-!
-!* 3.1.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(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
- ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH
- *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
- XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
- XLBSWETH3/( ZLBDAS(:)**2) ) )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-!* 3.1.6 accretion of graupeln on the hailstones
-! ----------------------------------------------
-!
- GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>XRTMIN(6)/PTSTEP)
- IGWET = COUNT( GWET(:) )
-!
- IF( IGWET>0 ) THEN
-!
-!* 3.1.7 allocations
-!
- ALLOCATE(ZVEC1(IGWET))
- ALLOCATE(ZVEC2(IGWET))
- ALLOCATE(ZVEC3(IGWET))
- ALLOCATE(IVEC1(IGWET))
- ALLOCATE(IVEC2(IGWET))
-!
-!* 3.1.8 select the (ZLBDAH,ZLBDAG) couplet
-!
- ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
-!
-!* 3.1.9 find the next lower indice for the ZLBDAH and for the ZLBDAG
-! 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) )
-!
-!* 3.1.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(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
- ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
- *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
- XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
- XLBGWETH3/( ZLBDAG(:)**2) ) ),0. )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-!* 3.2 compute the Wet growth of hail
-! -------------------------------------
-!
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. ZZT(:)<XTT )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RWETH
-!
- ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
- X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) + &
- ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
- ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
- ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
-!
- ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
- END WHERE
- WHERE ( GHAIL(:) .AND. ZZT(:)<XTT .AND. ZZW1(:,6)/=0.)
-!
-! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
-!
- ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
- ZZX(:) = ZZW1(:,4) / ZZW1(:,6)
- ZZW1(:,2) = ZZW1(:,2)*ZZX(:)
- ZZW1(:,3) = ZZW1(:,3)*ZZX(:)
- ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
- ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
-!
-!* 3.2.1 integrate the Wet growth of hail
-!
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) - ZZW1(:,3)
- ZRGS(:) = ZRGS(:) - ZZW1(:,5)
- ZRHS(:) = ZRHS(:) + ZZW(:)
- ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
- ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:))
- ! f(L_f*(RCWETH+RRWETH))
-!
- ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
- ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
- ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
- *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
- END WHERE
-!
-END IF ! IHAIL>0
-!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET_DDH ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-! Partial reconversion of hail to graupel when rc and rh are small
-!
-!
-!* 3.3 Conversion of the hailstones into graupel
-! -----------------------------------------------
-!
-IF ( IHAIL>0 ) THEN
- ZTHRH=0.01E-3
- ZTHRC=0.001E-3
- ZZW(:) = 0.0
- WHERE( ZRHT(:)<ZTHRH .AND. ZRCT(:)<ZTHRC .AND. ZZT(:)<XTT )
- ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(ZRCT(:)/ZTHRC) ) )
-!
-! assume a linear percent conversion rate of hail into graupel
-!
- ZZW(:) = ZRHS(:)*ZZW(:)
- ZRGS(:) = ZRGS(:) + ZZW(:) ! partial conversion
- ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
-!
- END WHERE
-END IF
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'COHG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'COHG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-END IF
-!
-!
-!* 3.4 Melting of the hailstones
-!
-IF ( IHAIL>0 ) THEN
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RHMLTR
-!
- ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * &
- ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
- X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - &
- ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
- ( ZRHODREF(:)*XLMTT ) ) )
- ZRRS(:) = ZRRS(:) + ZZW(:)
- ZRHS(:) = ZRHS(:) - ZZW(:)
- ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RHMLTR))
-!
- ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 )
-!
- END WHERE
-END IF
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET_DDH ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'HMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-END IF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
diff --git a/src/arome/micro/lima_mixed_slow_processes.F90 b/src/arome/micro/lima_mixed_slow_processes.F90
deleted file mode 100644
index ff8f782ce2387307ec721362792d2b6bd29273cf..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_mixed_slow_processes.F90
+++ /dev/null
@@ -1,297 +0,0 @@
-! #####################################
- MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
-! #####################################
-!
-INTERFACE
- SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
- ZLSFACT, ZLVFACT, ZAI, ZCJ, &
- ZRGT, ZCIT, &
- ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
- ZCCS, ZCIS, ZIFS, ZINS, &
- ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
- PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
-REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
-!
-! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-INTEGER, INTENT(IN) :: KMI
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
-END INTERFACE
-END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
-!
-! #######################################################################
- SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
- ZLSFACT, ZLVFACT, ZAI, ZCJ, &
- ZRGT, ZCIT, &
- ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
- ZCCS, ZCIS, ZIFS, ZINS, &
- ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
- PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS, &
- YDDDH, YDLDDH, YDMDDH )
-! #######################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the mixed-phase
-!! slow processes :
-!!
-!! Deposition of water vapor on graupeln
-!! Cloud ice Melting
-!! Bergeron-Findeisen effect
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Most of the parameterizations come from the ICE3 scheme, described in
-!! the MESO-NH scientific documentation.
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN
-USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
-USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
- X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
-REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
-REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
-!
-! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-INTEGER, INTENT(IN) :: KMI
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZMASK ! Work vectors
-!
-INTEGER :: JMOD_IFN
-!
-!-------------------------------------------------------------------------------
-!
-!* 1 Deposition of water vapor on r_g: RVDEPG
-! ---------------------------------------------
-!
-!
- ZZW(:) = 0.0
- WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) )
-!Correction BVIE RHODREF
-! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
- ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
- ( X0DEPG*ZLBDAG(:)**XEX0DEPG + X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG )
- ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
- - MIN( ZRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
- ZRGS(:) = ZRGS(:) + ZZW(:)
- ZRVS(:) = ZRVS(:) - ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET_DDH ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!* 2 cloud ice Melting: RIMLTC and CIMLTC
-! -----------------------------------------
-!
-!
- ZMASK(:) = 1.0
- WHERE( (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZZT(:)>XTT) )
- ZRCS(:) = ZRCS(:) + ZRIS(:)
- ZTHS(:) = ZTHS(:) - ZRIS(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RIMLTC))
- ZRIS(:) = 0.0
-!
- ZCCS(:) = ZCCS(:) + ZCIS(:)
- ZCIS(:) = 0.0
- ZMASK(:)= 0.0
- END WHERE
- DO JMOD_IFN = 1,NMOD_IFN
-! Correction BVIE aerosols not released but in droplets
-! ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) + ZINS(:,JMOD_IFN)*(1.-ZMASK(:))
- ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) * ZMASK(:)
- ENDDO
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-!
-!* 3 Bergeron-Findeisen effect: RCBERI
-! --------------------------------------
-!
-!
- ZZW(:) = 0.0
- WHERE( (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZCIT(:)>XCTMIN(4)) )
- ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
- - (XGAMW-XGAMI)*ALOG(ZZT(:)) ) -1.0
- ! supersaturation of saturated water over ice
- ZZW(:) = MIN( ZRCS(:),( ZZW(:) / ZAI(:) ) * ZCIT(:) * &
- ( X0DEPI/ZLBDAI(:)+X2DEPI*ZCJ(:)*ZCJ(:)/ZLBDAI(:)**(XDI+2.0) ) )
- ZRCS(:) = ZRCS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
- END WHERE
-!
-! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
diff --git a/src/arome/micro/lima_nucleation_procs.F90 b/src/arome/micro/lima_nucleation_procs.F90
deleted file mode 100644
index 9b23d62f2eecc0767c22e64df6a43f57820fce37..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_nucleation_procs.F90
+++ /dev/null
@@ -1,297 +0,0 @@
-! ###############################
- MODULE MODI_LIMA_NUCLEATION_PROCS
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_NUCLEATION_PROCS
-! #############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, HFMFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- YDDDH, YDLDDH, YDMDDH )
-! #############################################################################
-!
-USE MODD_PARAM_LIMA, ONLY : LCOLD_LIMA, LNUCL_LIMA, LMEYERS_LIMA, LSNOW_LIMA, LWARM_LIMA, LACTI_LIMA, LRAIN_LIMA, LHHONI_LIMA, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM
-USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR,&
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, &
- NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODI_LIMA_MEYERS_NUCLEATION
-USE MODI_LIMA_CCN_HOM_FREEZING
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!-------------------------------------------------------------------------------
-!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZCCT, ZCRT, ZCIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_CCN) :: ZNFT, ZNAT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IFN) :: ZIFT, ZINT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IMM) :: ZNIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZNHT
-!
-INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-ZTHT(:,:,:) = PTHT(:,:,:)
-ZRVT(:,:,:) = PRVT(:,:,:)
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZCCT(:,:,:) = PCCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZCRT(:,:,:) = PCRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZCIT(:,:,:) = PCIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-ZNFT(:,:,:,:) = PNFT(:,:,:,:)
-ZNAT(:,:,:,:) = PNAT(:,:,:,:)
-ZIFT(:,:,:,:) = PIFT(:,:,:,:)
-ZINT(:,:,:,:) = PINT(:,:,:,:)
-ZNIT(:,:,:,:) = PNIT(:,:,:,:)
-ZNHT(:,:,:) = PNHT(:,:,:)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LWARM_LIMA .AND. LACTI_LIMA) THEN
- CALL LIMA_CCN_ACTIVATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZCCT, ZRRT, ZNFT, ZNAT)
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PNFT(:,:,:,:) = ZNFT(:,:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 7, 'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NC, 'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH (PNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD_LIMA .AND. LNUCL_LIMA .AND. .NOT.LMEYERS_LIMA .AND. NMOD_IFN.GE.1) THEN
- CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZNAT, ZIFT, ZINT, ZNIT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI, 'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET_DDH ((ZIFT(:,:,:,JL))*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
-!
- IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PRIT(:,:,:) = ZRIT(:,:,:)
- PCIT(:,:,:) = ZCIT(:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
- PIFT(:,:,:,:) = ZIFT(:,:,:,:)
- PINT(:,:,:,:) = ZINT(:,:,:,:)
- PNIT(:,:,:,:) = ZNIT(:,:,:,:)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD_LIMA .AND. LNUCL_LIMA .AND. LMEYERS_LIMA) THEN
- CALL LIMA_MEYERS_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZINT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
- IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRCT(:,:,:) = ZRCT(:,:,:)
-PCCT(:,:,:) = ZCCT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PINT(:,:,:,:) = ZINT(:,:,:,:)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD_LIMA .AND. LHHONI_LIMA .AND. NMOD_CCN.GE.1) THEN
- CALL LIMA_CCN_HOM_FREEZING (HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, ZNFT, ZNHT )
-!
-! Call budgets
-!
- IF (LBU_ENABLE .AND. LHHONI_LIMA) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (ZRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 9, 'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NI, 'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH (ZNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PNHT(:,:,:) = ZNHT(:,:,:)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/arome/micro/lima_phillips.F90 b/src/arome/micro/lima_phillips.F90
deleted file mode 100644
index 6791798d429ba2196f73325c46c47259d27773a5..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_phillips.F90
+++ /dev/null
@@ -1,675 +0,0 @@
-! #########################
- MODULE MODI_LIMA_PHILLIPS
-! #########################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCIT, PCCS, PCIS, &
- PNAS, PIFS, PINS, PNIS, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_PHILLIPS
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS
-!
-! ######################################################################
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRIS, &
- PCIT, PCCS, PCIS, &
- PNAS, PIFS, PINS, PNIS, &
- YDDDH, YDLDDH, YDMDDH )
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the heterogeneous nucleation
-!! following Phillips (2008).
-!!
-!!
-!!** METHOD
-!! ------
-!! The parameterization of Phillips (2008) is based on observed nucleation
-!! in the CFDC for a range of T and Si values. Phillips therefore defines a
-!! reference activity spectrum, that is, for given T and Si values, the
-!! reference concentration of primary ice crystals.
-!!
-!! The activation of IFN is closely related to their total surface. Thus,
-!! the activable fraction of each IFN specie is determined by an integration
-!! over the particle size distributions.
-!!
-!! Subroutine organisation :
-!!
-!! 1- Preliminary computations
-!! 2- Check where computations are necessary, and pack variables
-!! 3- Compute the saturation over water and ice
-!! 4- Compute the reference activity spectrum
-!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
-!! Integrate over the size distributions to compute the IFN activable fraction
-!! -> CALL LIMA_PHILLIPS_INTEG
-!! 5- Heterogeneous nucleation of insoluble IFN
-!! 6- Heterogeneous nucleation of coated IFN
-!! 7- Unpack variables & deallocations
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
- XDSI0, XRTMIN, XCTMIN, NPHILLIPS
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-USE MODI_LIMA_PHILLIPS_INTEG
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
- !for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
-INTEGER :: INEGT ! Case number of sedimentation, nucleation,
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the nucleation
-!
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! Cloud Cond. nuclei conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
- !by Deposition/Contact
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
- !by Immersion
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZLBDAC, & ! Slope parameter of the cloud droplet distr.
- ZSI, &
- ZSW, &
- ZSI_W
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSI0, & ! Si threshold in H_X for X={DM,BC,O}
- Z_FRAC_ACT ! Activable frac. of each AP species
-REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-! Physical limitations
-!
-ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-ZCTMIN(:) = XCTMIN(:) / PTSTEP
-!
-! Temperature
-!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Saturation over ice
-!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. COMPUTATIONS ONLY WHERE NECESSARY : PACK
-! ----------------------------------------
-!
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
- ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-!
-IF (INEGT > 0) THEN
-!
-ALLOCATE(ZRVT(INEGT))
-ALLOCATE(ZRCT(INEGT))
-ALLOCATE(ZRRT(INEGT))
-ALLOCATE(ZRIT(INEGT))
-ALLOCATE(ZRST(INEGT))
-ALLOCATE(ZRGT(INEGT))
-!
-ALLOCATE(ZCIT(INEGT))
-!
-ALLOCATE(ZRVS(INEGT))
-ALLOCATE(ZRCS(INEGT))
-ALLOCATE(ZRIS(INEGT))
-!
-ALLOCATE(ZTHS(INEGT))
-!
-ALLOCATE(ZCCS(INEGT))
-ALLOCATE(ZCIS(INEGT))
-!
-ALLOCATE(ZNAS(INEGT,NMOD_CCN))
-ALLOCATE(ZIFS(INEGT,NMOD_IFN))
-ALLOCATE(ZINS(INEGT,NMOD_IFN))
-ALLOCATE(ZNIS(INEGT,NMOD_IMM))
-!
-ALLOCATE(ZRHODREF(INEGT))
-ALLOCATE(ZZT(INEGT))
-ALLOCATE(ZPRES(INEGT))
-ALLOCATE(ZEXNREF(INEGT))
-!
-DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
-!
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
-!
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
-!
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
-!
- DO JMOD_CCN = 1, NMOD_CCN
- ZNAS(JL,JMOD_CCN) = PNAS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
- ENDDO
- DO JMOD_IFN = 1, NMOD_IFN
- ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ENDDO
- DO JMOD_IMM = 1, NMOD_IMM
- ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
- ENDDO
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
-ENDDO
-!
-! PACK : done
-! Prepare computations
-!
-ALLOCATE( ZLSFACT (INEGT) )
-ALLOCATE( ZLVFACT (INEGT) )
-ALLOCATE( ZSI (INEGT) )
-ALLOCATE( ZTCELSIUS (INEGT) )
-ALLOCATE( ZZT_SI0_BC (INEGT) )
-ALLOCATE( ZLBDAC (INEGT) )
-ALLOCATE( ZSI0 (INEGT,NSPECIE) )
-ALLOCATE( Z_FRAC_ACT (INEGT,NSPECIE) ) ; Z_FRAC_ACT(:,:) = 0.0
-ALLOCATE( ZSW (INEGT) )
-ALLOCATE( ZSI_W (INEGT) )
-!
-ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
-ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
-ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. COMPUTE THE SATURATION OVER WATER AND ICE
-! -----------------------------------------
-!
-!
-ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
-ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
-ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
-ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
-ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
-ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
-!
-ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
-ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
-!
-ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
-!
-! Saturation parameters for H_X, with X={Dust/Metallic (2 modes), Black Carbon, Organic}
-!
-ZSI0(:,1) = 1.0 + 10.0**( -1.0261 + 3.1656E-3* ZTCELSIUS(:) &
- + 5.3938E-4*(ZTCELSIUS(:)**2) &
- + 8.2584E-6*(ZTCELSIUS(:)**3) ) ! with T [°C]
-ZSI0(:,2) = ZSI0(:,1) ! DM2 = DM1
-ZSI0(:,3) = 0.0 ! BC
-ZZT_SI0_BC(:) = MAX( 198.0, MIN( 239.0,ZZT(:) ) )
-ZSI0(:,3) = (-3.118E-5*ZZT_SI0_BC(:)+1.085E-2)*ZZT_SI0_BC(:)+0.5652 - XDSI0(3)
-IF (NPHILLIPS == 8) THEN
- ZSI0(:,4) = ZSI0(:,3) ! O = BC
-ELSE IF (NPHILLIPS == 13) THEN
- ZSI0(:,4) = 1.15 ! BIO
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. COMPUTE THE ACTIVABLE FRACTION OF EACH IFN SPECIE
-! -------------------------------------------------
-!
-!
-! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
-!
-CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
-!
-! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
-! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
-!
-CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
-! -----------------------------------------------------
-!
-!
-!
-DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
- ZZX(:)=0.
- DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
- ZZX(:)=ZZX(:)+XFRAC(JSPECIE,JMOD_IFN)*(ZIFS(:,JMOD_IFN)+ZINS(:,JMOD_IFN))* &
- Z_FRAC_ACT(:,JSPECIE)
- END DO
-! Now : ZZX(:) = number of activable AP.
-! Activated AP at this time step = activable AP - already activated AP
- ZZX(:) = MIN( ZIFS(:,JMOD_IFN), MAX( (ZZX(:)-ZINS(:,JMOD_IFN)),0.0 ))
-! Correction BVIE division by PTSTEP ?
-! ZZW(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
- ZZW(:) = MIN( XMNU0*ZZX(:), ZRVS(:) )
-!
-! Update the concentrations and MMR
-!
- ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) - ZZX(:)
- ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
- PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
- FIELD=ZW(:,:,:) )
-!
- ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) + ZZX(:)
- ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
- PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
- FIELD=ZW(:,:,:) )
-!
- ZRVS(:) = ZRVS(:) - ZZW(:)
- ZRIS(:) = ZRIS(:) + ZZW(:)
- ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNDI))
- ZCIS(:) = ZCIS(:) + ZZX(:)
-END DO
-!
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET_DDH ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
-! --------------------------------------------------
-!
-!
-! Heterogeneous nucleation by immersion of the activated CCN
-! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
-!
-!
-DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
- JMOD_CCN = NINDICE_CCN_IMM(JMOD_IMM) ! Corresponding CCN mode
- IF (JMOD_CCN .GT. 0) THEN
-!
-! OLD LIMA : Compute the appropriate mean diameter and sigma
-! XMDIAM_IMM = MIN( XMDIAM_IFN(NIND_SPECIE) , XR_MEAN_CCN(JMOD_CCN)*2. )
-! XSIGMA_IMM = MIN( XSIGMA_IFN(JSPECIE) , EXP(XLOGSIG_CCN(JMOD_CCN)) )
-!
- ZZW(:) = MIN( ZCCS(:) , ZNAS(:,JMOD_CCN) )
- ZZX(:)= ( ZZW(:)+ZNIS(:,JMOD_IMM) ) * Z_FRAC_ACT(:,NIND_SPECIE)
-! Now : ZZX(:) = number of activable AP.
-! Activated AP at this time step = activable AP - already activated AP
- ZZX(:) = MIN( ZZW(:), MAX( (ZZX(:)-ZNIS(:,JMOD_IMM)),0.0 ) )
-! Correction BVIE division by PTSTEP ?
-! ZZY(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
- ZZY(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
-!
-! Update the concentrations and MMR
-!
- ZNAS(:,JMOD_CCN) = ZNAS(:,JMOD_CCN) - ZZX(:)
- ZW(:,:,:) = PNAS(:,:,:,JMOD_CCN)
- PNAS(:,:,:,JMOD_CCN) = UNPACK(ZNAS(:,JMOD_CCN),MASK=GNEGT(:,:,:), &
- FIELD=ZW(:,:,:))
- ZNIS(:,JMOD_IMM) = ZNIS(:,JMOD_IMM) + ZZX(:)
- ZW(:,:,:) = PNIS(:,:,:,JMOD_IMM)
- PNIS(:,:,:,JMOD_IMM) = UNPACK(ZNIS(:,JMOD_IMM),MASK=GNEGT(:,:,:), &
- FIELD=ZW(:,:,:))
-!
- ZRCS(:) = ZRCS(:) - ZZY(:)
- ZRIS(:) = ZRIS(:) + ZZY(:)
- ZTHS(:) = ZTHS(:) + ZZY(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNCI))
- ZCCS(:) = ZCCS(:) - ZZX(:)
- ZCIS(:) = ZCIS(:) + ZZX(:)
- END IF
-END DO
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- 7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 7. UNPACK VARIABLES AND CLEAN
-! --------------------------
-!
-!
-! End of the heterogeneous nucleation following Phillips 08
-! Unpack variables, deallocate...
-!
-!
-ZW(:,:,:) = PRVS(:,:,:)
-PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-ZW(:,:,:) = PRCS(:,:,:)
-PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-ZW(:,:,:) = PRIS(:,:,:)
-PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-ZW(:,:,:) = PTHS(:,:,:)
-PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-ZW(:,:,:) = PCCS(:,:,:)
-PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-ZW(:,:,:) = PCIS(:,:,:)
-PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
-!
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
-DEALLOCATE(ZRVT)
-DEALLOCATE(ZRCT)
-DEALLOCATE(ZRRT)
-DEALLOCATE(ZRIT)
-DEALLOCATE(ZRST)
-DEALLOCATE(ZRGT)
-DEALLOCATE(ZCIT)
-DEALLOCATE(ZRVS)
-DEALLOCATE(ZRCS)
-DEALLOCATE(ZRIS)
-DEALLOCATE(ZTHS)
-DEALLOCATE(ZCCS)
-DEALLOCATE(ZCIS)
-DEALLOCATE(ZNAS)
-DEALLOCATE(ZIFS)
-DEALLOCATE(ZINS)
-DEALLOCATE(ZNIS)
-DEALLOCATE(ZRHODREF)
-DEALLOCATE(ZZT)
-DEALLOCATE(ZPRES)
-DEALLOCATE(ZEXNREF)
-DEALLOCATE(ZLSFACT)
-DEALLOCATE(ZLVFACT)
-DEALLOCATE(ZSI)
-DEALLOCATE(ZTCELSIUS)
-DEALLOCATE(ZZT_SI0_BC)
-DEALLOCATE(ZLBDAC)
-DEALLOCATE(ZSI0)
-DEALLOCATE(Z_FRAC_ACT)
-DEALLOCATE(ZSW)
-DEALLOCATE(ZZW)
-DEALLOCATE(ZZX)
-DEALLOCATE(ZZY)
-DEALLOCATE(ZSI_W)
-!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- !print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET_DDH ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
-
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- !print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
- END IF
-!
-!
-END IF ! INEGT > 0
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_PHILLIPS
diff --git a/src/arome/micro/lima_phillips_ifn_nucleation.F90 b/src/arome/micro/lima_phillips_ifn_nucleation.F90
deleted file mode 100644
index 068d15cfc3be0c89f61b485641cf7720f87848b6..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_phillips_ifn_nucleation.F90
+++ /dev/null
@@ -1,500 +0,0 @@
-! ########################################
- MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-! ########################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_RC_HINC, P_CC_HINC )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
-!
-END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-!
-! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, HFMFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_RC_HINC, P_CC_HINC )
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the heterogeneous nucleation
-!! following Phillips (2008).
-!!
-!!
-!!** METHOD
-!! ------
-!! The parameterization of Phillips (2008) is based on observed nucleation
-!! in the CFDC for a range of T and Si values. Phillips therefore defines a
-!! reference activity spectrum, that is, for given T and Si values, the
-!! reference concentration of primary ice crystals.
-!!
-!! The activation of IFN is closely related to their total surface. Thus,
-!! the activable fraction of each IFN specie is determined by an integration
-!! over the particle size distributions.
-!!
-!! Subroutine organisation :
-!!
-!! 1- Preliminary computations
-!! 2- Check where computations are necessary, and pack variables
-!! 3- Compute the saturation over water and ice
-!! 4- Compute the reference activity spectrum
-!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
-!! Integrate over the size distributions to compute the IFN activable fraction
-!! -> CALL LIMA_PHILLIPS_INTEG
-!! 5- Heterogeneous nucleation of insoluble IFN
-!! 6- Heterogeneous nucleation of coated IFN
-!! 7- Unpack variables & deallocations
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
- XDSI0, XRTMIN, XCTMIN, NPHILLIPS
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-USE MODI_LIMA_PHILLIPS_INTEG
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
-!
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
-INTEGER :: INEGT ! Case number of sedimentation, nucleation,
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the nucleation
-!
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! Cloud Cond. nuclei conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFT ! Free Ice nuclei conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINT ! Nucleated Ice nuclei conc. source
- !by Deposition/Contact
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIT ! Nucleated Ice nuclei conc. source
- !by Immersion
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZX, & ! Work array
- ZZY, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZLBDAC, & ! Slope parameter of the cloud droplet distr.
- ZSI, &
- ZSW, &
- ZSI_W
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSI0, & ! Si threshold in H_X for X={DM,BC,O}
- Z_FRAC_ACT ! Activable frac. of each AP species
-REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-P_TH_HIND(:,:,:) = 0.
-P_RI_HIND(:,:,:) = 0.
-P_CI_HIND(:,:,:) = 0.
-P_RC_HINC(:,:,:) = 0.
-P_CC_HINC(:,:,:) = 0.
-!
-! Physical domain
-!
-IIB=1+JPHEXT
-IIE=SIZE(PTHT,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PTHT,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PTHT,3) - JPVEXT
-!
-! Temperature
-!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Saturation over ice
-!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. COMPUTATIONS ONLY WHERE NECESSARY : PACK
-! ----------------------------------------
-!
-!
-GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
- ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
-!
-INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-!
-IF (INEGT > 0) THEN
-!
- ALLOCATE(ZRVT(INEGT))
- ALLOCATE(ZRCT(INEGT))
- ALLOCATE(ZRRT(INEGT))
- ALLOCATE(ZRIT(INEGT))
- ALLOCATE(ZRST(INEGT))
- ALLOCATE(ZRGT(INEGT))
-!
- ALLOCATE(ZCCT(INEGT))
-!
- ALLOCATE(ZNAT(INEGT,NMOD_CCN))
- ALLOCATE(ZIFT(INEGT,NMOD_IFN))
- ALLOCATE(ZINT(INEGT,NMOD_IFN))
- ALLOCATE(ZNIT(INEGT,NMOD_IMM))
-!
- ALLOCATE(ZRHODREF(INEGT))
- ALLOCATE(ZZT(INEGT))
- ALLOCATE(ZPRES(INEGT))
- ALLOCATE(ZEXNREF(INEGT))
-!
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
-!
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
-!
- DO JMOD_CCN = 1, NMOD_CCN
- ZNAT(JL,JMOD_CCN) = PNAT(I1(JL),I2(JL),I3(JL),JMOD_CCN)
- ENDDO
- DO JMOD_IFN = 1, NMOD_IFN
- ZIFT(JL,JMOD_IFN) = PIFT(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ZINT(JL,JMOD_IFN) = PINT(I1(JL),I2(JL),I3(JL),JMOD_IFN)
- ENDDO
- DO JMOD_IMM = 1, NMOD_IMM
- ZNIT(JL,JMOD_IMM) = PNIT(I1(JL),I2(JL),I3(JL),JMOD_IMM)
- ENDDO
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
-!
-! PACK : done
-! Prepare computations
-!
- ALLOCATE( ZLSFACT (INEGT) )
- ALLOCATE( ZLVFACT (INEGT) )
- ALLOCATE( ZSI (INEGT) )
- ALLOCATE( ZTCELSIUS (INEGT) )
- ALLOCATE( ZZT_SI0_BC (INEGT) )
- ALLOCATE( ZLBDAC (INEGT) )
- ALLOCATE( ZSI0 (INEGT,NSPECIE) )
- ALLOCATE( Z_FRAC_ACT (INEGT,NSPECIE) ) ; Z_FRAC_ACT(:,:) = 0.0
- ALLOCATE( ZSW (INEGT) )
- ALLOCATE( ZSI_W (INEGT) )
-!
- ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
- ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
- ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. COMPUTE THE SATURATION OVER WATER AND ICE
-! -----------------------------------------
-!
-!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
-!
- ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
-!
- ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
-!
-! Saturation parameters for H_X, with X={Dust/Metallic (2 modes), Black Carbon, Organic}
-!
- ZSI0(:,1) = 1.0 + 10.0**( -1.0261 + 3.1656E-3* ZTCELSIUS(:) &
- + 5.3938E-4*(ZTCELSIUS(:)**2) &
- + 8.2584E-6*(ZTCELSIUS(:)**3) ) ! with T [°C]
- ZSI0(:,2) = ZSI0(:,1) ! DM2 = DM1
- ZSI0(:,3) = 0.0 ! BC
- ZZT_SI0_BC(:) = MAX( 198.0, MIN( 239.0,ZZT(:) ) )
- ZSI0(:,3) = (-3.118E-5*ZZT_SI0_BC(:)+1.085E-2)*ZZT_SI0_BC(:)+0.5652 - XDSI0(3)
- IF (NPHILLIPS == 8) THEN
- ZSI0(:,4) = ZSI0(:,3) ! O = BC
- ELSE IF (NPHILLIPS == 13) THEN
- ZSI0(:,4) = 1.15 ! BIO
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. COMPUTE THE ACTIVABLE FRACTION OF EACH IFN SPECIE
-! -------------------------------------------------
-!
-!
-! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
-!
- CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
-!
-! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
-! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
-!
- CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
-! -----------------------------------------------------
-!
-!
-!
- DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
- ZZX(:)=0.
- DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
- ZZX(:)=ZZX(:)+XFRAC(JSPECIE,JMOD_IFN)*(ZIFT(:,JMOD_IFN)+ZINT(:,JMOD_IFN))* &
- Z_FRAC_ACT(:,JSPECIE)
- END DO
-! Now : ZZX(:) = number conc. of activable AP.
-! Activated AP at this time step = activable AP - already activated AP
- ZZX(:) = MIN( ZIFT(:,JMOD_IFN), MAX( (ZZX(:)-ZINT(:,JMOD_IFN)),0.0 ))
- ZZW(:) = MIN( XMNU0*ZZX(:), ZRVT(:) )
-! Now : ZZX(:) = number conc. of AP activated at this time step (#/kg) from IFN mode JMOD_IFN
-! Now : ZZW(:) = mmr of ice nucleated at this time step (kg/kg) from IFN mode JMOD_IFN
-!
-! Update the concentrations and MMR
-!
- ZW(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PIFT(:,:,:,JMOD_IFN) = PIFT(:,:,:,JMOD_IFN) - ZW(:,:,:)
- PINT(:,:,:,JMOD_IFN) = PINT(:,:,:,JMOD_IFN) + ZW(:,:,:)
-!
- P_CI_HIND(:,:,:) = P_CI_HIND(:,:,:) + ZW(:,:,:)
- PCIT(:,:,:) = PCIT(:,:,:) + ZW(:,:,:)
-!
- ZW(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
- P_RI_HIND(:,:,:) = P_RI_HIND(:,:,:) + ZW(:,:,:)
- PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
- PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
-!
- P_TH_HIND(:,:,:) = UNPACK( ZZW(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HIND(:,:,:)
- END DO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
-! --------------------------------------------------
-!
-!
-! Heterogeneous nucleation by immersion of the activated CCN
-! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
-!
-!
- DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
- JMOD_CCN = NINDICE_CCN_IMM(JMOD_IMM) ! Corresponding CCN mode
- IF (JMOD_CCN .GT. 0) THEN
-!
-! OLD LIMA : Compute the appropriate mean diameter and sigma
-! XMDIAM_IMM = MIN( XMDIAM_IFN(NIND_SPECIE) , XR_MEAN_CCN(JMOD_CCN)*2. )
-! XSIGMA_IMM = MIN( XSIGMA_IFN(JSPECIE) , EXP(XLOGSIG_CCN(JMOD_CCN)) )
-!
- ZZW(:) = MIN( ZCCT(:) , ZNAT(:,JMOD_CCN) )
- ZZX(:)= ( ZZW(:)+ZNIT(:,JMOD_IMM) ) * Z_FRAC_ACT(:,NIND_SPECIE)
-! Now : ZZX(:) = number of activable AP.
-! Activated AP at this time step = activable AP - already activated AP
- ZZX(:) = MIN( ZZW(:), MAX( (ZZX(:)-ZNIT(:,JMOD_IMM)),0.0 ) )
- ZZY(:) = MIN( XMNU0*ZZX(:) , ZRVT(:) )
-!
-! Update the concentrations and MMR
-!
- ZW(:,:,:) = UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PNIT(:,:,:,JMOD_IMM) = PNIT(:,:,:,JMOD_IMM) + ZW(:,:,:)
- PNAT(:,:,:,JMOD_CCN) = PNAT(:,:,:,JMOD_CCN) - ZW(:,:,:)
-!
- P_CC_HINC(:,:,:) = P_CC_HINC(:,:,:) - ZW(:,:,:)
- PCCT(:,:,:) = PCCT(:,:,:) - ZW(:,:,:)
- PCIT(:,:,:) = PCIT(:,:,:) + ZW(:,:,:)
-!
- ZW(:,:,:) = UNPACK( ZZY(:), MASK=GNEGT(:,:,:), FIELD=0. )
- P_RC_HINC(:,:,:) = P_RC_HINC(:,:,:) - ZW(:,:,:)
- PRCT(:,:,:) = PRCT(:,:,:) - ZW(:,:,:)
- PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
- PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZY(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
- END IF
- END DO
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 7. CLEAN
-! -----
-!
-!
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZNAT)
- DEALLOCATE(ZIFT)
- DEALLOCATE(ZINT)
- DEALLOCATE(ZNIT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZLSFACT)
- DEALLOCATE(ZLVFACT)
- DEALLOCATE(ZSI)
- DEALLOCATE(ZTCELSIUS)
- DEALLOCATE(ZZT_SI0_BC)
- DEALLOCATE(ZLBDAC)
- DEALLOCATE(ZSI0)
- DEALLOCATE(Z_FRAC_ACT)
- DEALLOCATE(ZSW)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZX)
- DEALLOCATE(ZZY)
- DEALLOCATE(ZSI_W)
-!
-END IF ! INEGT > 0
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
diff --git a/src/arome/micro/lima_rain_accr_snow.F90 b/src/arome/micro/lima_rain_accr_snow.F90
deleted file mode 100644
index b6c2db3d750c8bbe2ba57de7b344572e3027e8aa..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_rain_accr_snow.F90
+++ /dev/null
@@ -1,315 +0,0 @@
-! #################################
- MODULE MODI_LIMA_RAIN_ACCR_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-END SUBROUTINE LIMA_RAIN_ACCR_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_ACCR_SNOW
-!
-! ######################################################################
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
-USE MODD_PARAM_LIMA_COLD, ONLY : XBS, XCXS
-USE MODD_PARAM_LIMA_MIXED, ONLY : NACCLBDAS, XACCINTP1S, XACCINTP2S, &
- NACCLBDAR, XACCINTP1R, XACCINTP2R, &
- XKER_RACCSS, XKER_RACCS, XKER_SACCRG, &
- XFRACCSS, XLBRACCS1, XLBRACCS2, XLBRACCS3, &
- XFSACCRG, XLBSACCR1, XLBSACCR2, XLBSACCR3
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 Declarations of local variables :
-!
-LOGICAL, DIMENSION(SIZE(PRRT)) :: GACC
-!
-REAL, DIMENSION(SIZE(PRRT)) :: Z1, Z2, Z3, Z4
-REAL, DIMENSION(SIZE(PRRT)) :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5
-!
-INTEGER, DIMENSION(SIZE(PRRT)) :: IVEC1,IVEC2 ! Vectors of indices
-REAL, DIMENSION(SIZE(PRRT)) :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors
-!
-!-------------------------------------------------------------------------------
-!
-!
-P_TH_ACC(:) = 0.
-P_RR_ACC(:) = 0.
-P_CR_ACC(:) = 0.
-P_RS_ACC(:) = 0.
-P_RG_ACC(:) = 0.
-!
-ZZW1(:) = 0.
-ZZW2(:) = 0.
-ZZW3(:) = 0.
-ZZW4(:) = 0.
-ZZW5(:) = 0.
-!
-IVEC1(:) = 0
-IVEC2(:) = 0
-ZVEC1(:) = 0.
-ZVEC2(:) = 0.
-ZVEC3(:) = 0.
-!
-!* Cloud droplet riming of the aggregates
-! -------------------------------------------
-!
-!
-GACC(:) = .False.
-GACC(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PT(:)<XTT) .AND. LDCOMPUTE(:)
-!
-WHERE( GACC )
-!
-! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet
-!
- ZVEC1(:) = PLBDS(:)
- ZVEC2(:) = PLBDR(:)
-!
-! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
-! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
-! tabulate the RACCSS-kernel
-!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(:) ) + XACCINTP2S ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
-!
- ZVEC2(:) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(:) ) + XACCINTP2R ) )
- IVEC2(:) = INT( ZVEC2(:) )
- ZVEC2(:) = ZVEC2(:) - FLOAT( IVEC2(:) )
-!
-! 1.3.3 perform the bilinear interpolation of the normalized
-! RACCSS-kernel : for small rain drops transformed into snow
- !
- Z1(:) = GET_XKER_RACCSS(IVEC1(:)+1,IVEC2(:)+1)
- Z2(:) = GET_XKER_RACCSS(IVEC1(:)+1,IVEC2(:) )
- Z3(:) = GET_XKER_RACCSS(IVEC1(:) ,IVEC2(:)+1)
- Z4(:) = GET_XKER_RACCSS(IVEC1(:) ,IVEC2(:) )
- ZVEC3(:) = ( Z1(:)* ZVEC2(:) &
- - Z2(:)*(ZVEC2(:) - 1.0) ) &
- * ZVEC1(:) &
- - ( Z3(:)* ZVEC2(:) &
- - Z4(:)*(ZVEC2(:) - 1.0) ) &
- * (ZVEC1(:) - 1.0)
- ZZW1(:) = ZVEC3(:)
-!
-! 1.3.4b perform the bilinear interpolation of the normalized
-! RACCS-kernel : total frozen rain drops
-!
- Z1(:) = GET_XKER_RACCS(IVEC2(:)+1,IVEC1(:)+1)
- Z2(:) = GET_XKER_RACCS(IVEC2(:)+1,IVEC1(:) )
- Z3(:) = GET_XKER_RACCS(IVEC2(:) ,IVEC1(:)+1)
- Z4(:) = GET_XKER_RACCS(IVEC2(:) ,IVEC1(:) )
- ZVEC3(:) = ( Z1(:)* ZVEC1(:) &
- - Z2(:)*(ZVEC1(:) - 1.0) ) &
- * ZVEC2(:) &
- - ( Z3(:)* ZVEC1(:) &
- - Z4(:)*(ZVEC1(:) - 1.0) ) &
- * (ZVEC2(:) - 1.0)
- ZZW2(:) = ZVEC3(:)
-!
-! 1.3.5 perform the bilinear interpolation of the normalized
-! SACCRG-kernel : snow transformed into graupel
-!
- Z1(:) = GET_XKER_SACCRG(IVEC2(:)+1,IVEC1(:)+1)
- Z2(:) = GET_XKER_SACCRG(IVEC2(:)+1,IVEC1(:) )
- Z3(:) = GET_XKER_SACCRG(IVEC2(:) ,IVEC1(:)+1)
- Z4(:) = GET_XKER_SACCRG(IVEC2(:) ,IVEC1(:) )
- ZVEC3(:) = ( Z1(:)* ZVEC1(:) &
- - Z2(:)*(ZVEC1(:) - 1.0) ) &
- * ZVEC2(:) &
- - ( Z3(:)* ZVEC1(:) &
- - Z4(:)*(ZVEC1(:) - 1.0) ) &
- * (ZVEC2(:) - 1.0)
- ZZW3(:) = ZVEC3(:)
-!
-! 1.3.4 raindrop accretion on the small sized aggregates
-!
-! BVIE manque PCRT ???????????????????????????????????
-! ZZW4(:) = & !! coef of RRACCS and RRACCS
- ZZW4(:) = PCRT(:) & !! coef of RRACCS and RRACCS
- * XFRACCSS *( PLBDS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/( PLBDS(:)**2 ) + &
- XLBRACCS2/( PLBDS(:) * PLBDR(:) ) + &
- XLBRACCS3/( PLBDR(:)**2 ) ) / PLBDR(:)**3
-
-! ZRRS(:) = ZRRS(:) - ZZW1(:,4)
-! ZRSS(:) = ZRSS(:) + ZZW1(:,4)
-! ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
-!
-! ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
-!
-! 1.3.6 raindrop accretion-conversion of the large sized aggregates
-! into graupeln
-!
- ZZW5(:) = XFSACCRG*ZZW3(:) * & ! RSACCRG
- ( PLBDS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((PLBDR(:)**2) ) + &
- XLBSACCR2/( PLBDR(:) * PLBDS(:) ) + &
- XLBSACCR3/( (PLBDS(:)**2)) )
- !
-! P_RR_ACC(:) = - ZZW4(:) * ZZW1(:) ! RRACCSS
-! P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:) ! Lambda_r**3
-! P_RS_ACC(:) = - P_RR_ACC(:)
- !
-! P_RR_ACC(:) = P_RR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) )
-! P_CR_ACC(:) = P_CR_ACC(:) - ( ZZW2(:)-P_RS_ACC(:) ) * PCRT(:)/PRRT(:) ! Lambda_r**3
-! P_RS_ACC(:) = P_RS_ACC(:) - ZZW5(:)
-! P_RG_ACC(:) = ( ZZW2(:)-P_RS_ACC(:) ) + ZZW5(:)
- !
- P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
- P_CR_ACC(:) = P_RR_ACC(:) * PCRT(:)/PRRT(:)
- P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
- P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
- P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
- !
-END WHERE
-!
-!
-PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
-PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
-PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
-PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
-PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
- FUNCTION GET_XKER_RACCSS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
- REAL, DIMENSION(SIZE(I1)) :: RET
- !
- INTEGER I
- !
- DO I=1,SIZE(I1)
- RET(I) = XKER_RACCSS(MAX(MIN(I1(I),SIZE(XKER_RACCSS,1)),1),MAX(MIN(I2(I),SIZE(XKER_RACCSS,2)),1))
- END DO
- END FUNCTION GET_XKER_RACCSS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION GET_XKER_RACCS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
- REAL, DIMENSION(SIZE(I1)) :: RET
- !
- INTEGER I
- !
- DO I=1,SIZE(I1)
- RET(I) = XKER_RACCS(MAX(MIN(I1(I),SIZE(XKER_RACCS,1)),1),MAX(MIN(I2(I),SIZE(XKER_RACCS,2)),1))
- END DO
- END FUNCTION GET_XKER_RACCS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION GET_XKER_SACCRG(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
- REAL, DIMENSION(SIZE(I1)) :: RET
- !
- INTEGER I
- !
- DO I=1,SIZE(I1)
- RET(I) = XKER_SACCRG(MAX(MIN(I1(I),SIZE(XKER_SACCRG,1)),1),MAX(MIN(I2(I),SIZE(XKER_SACCRG,2)),1))
- END DO
- END FUNCTION GET_XKER_SACCRG
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_RAIN_ACCR_SNOW
diff --git a/src/arome/micro/lima_rain_evaporation.F90 b/src/arome/micro/lima_rain_evaporation.F90
deleted file mode 100644
index 8ba146e256d9544bd6b8d9b11d04d2efb9e7a9d8..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_rain_evaporation.F90
+++ /dev/null
@@ -1,161 +0,0 @@
-! ##########################
- MODULE MODI_LIMA_RAIN_EVAPORATION
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
- PEVAP3D )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT !
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: PLV !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
-REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-END SUBROUTINE LIMA_RAIN_EVAPORATION
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_EVAPORATION
-! #############################################################################
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
- PEVAP3D )
-! #############################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the raindrop evaporation
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XRHOLW, XRV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : X0EVAR, XEX0EVAR, X1EVAR, XEX2EVAR, XEX1EVAR, XTHCO, XDIVA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT !
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: PLV !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
-REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-!* 0.1 Declarations of local variables :
-!
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GEVAP
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW1, ZZW2
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PREPARE COMPUTATIONS - PACK
-! ---------------------------
-!
-P_TH_EVAP(:) = 0.
-P_RR_EVAP(:) = 0.
-!
-GEVAP(:) = .FALSE.
-GEVAP(:) = LDCOMPUTE(:) .AND. &
- PRRT(:)>XRTMIN(3) .AND. &
- PRVT(:)<PRVSAT(:)
-!
-WHERE ( GEVAP )
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. compute the evaporation of rain drops
-! ----------------------------------------
-!
-!
- ZZW1(:) = MAX((1.0 - PRVT(:)/PRVSAT(:)),0.0) ! Subsaturation
-!
-! Compute the function G(T)
-!
- ZZW2(:) = 1. / ( XRHOLW*((((PLV(:)/PT(:))**2)/(XTHCO*XRV)) + & ! G
- (XRV*PT(:))/(XDIVA*PEVSAT(:))))
-!
-! Compute the evaporation tendency
-!
- ZZW2(:) = ZZW2(:) * ZZW1(:) * PRRT(:) * &
- (X0EVAR * PLBDR(:)**XEX0EVAR + X1EVAR * PRHODREF(:)**XEX2EVAR * PLBDR(:)**XEX1EVAR)
- ZZW2(:) = MAX(ZZW2(:),0.0)
-!
- P_RR_EVAP(:) = - ZZW2(:)
- P_TH_EVAP(:) = P_RR_EVAP(:) * PLVFACT(:)
- PEVAP3D(:) = - P_RR_EVAP(:)
-!
-PA_TH(:) = PA_TH(:) + P_TH_EVAP(:)
-PA_RV(:) = PA_RV(:) - P_RR_EVAP(:)
-PA_RR(:) = PA_RR(:) + P_RR_EVAP(:)
-END WHERE
-!
-!-----------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_RAIN_EVAPORATION
diff --git a/src/arome/micro/lima_rain_freezing.F90 b/src/arome/micro/lima_rain_freezing.F90
deleted file mode 100644
index c0e1bd384199fe79f966c45dc58ea22481c3e54b..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_rain_freezing.F90
+++ /dev/null
@@ -1,162 +0,0 @@
-! #################################
- MODULE MODI_LIMA_RAIN_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_FREEZING (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-END SUBROUTINE LIMA_RAIN_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_FREEZING
-!
-! ######################################################################
- SUBROUTINE LIMA_RAIN_FREEZING (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
-! ######################################################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the cold-phase homogeneous
-!! freezing of CCN, droplets and drops (T<-35°C)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy* jan. 2014 add budgets
-!! B.Vie 10/2016 Bug zero division
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCEXVT
-USE MODD_PARAM_LIMA_MIXED, ONLY : XICFRR, XEXICFRR, XRCFRI, XEXRCFRI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRRT)) :: ZW1, ZW2 ! work arrays
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-P_TH_CFRZ(:)=0.
-P_RR_CFRZ(:)=0.
-P_CR_CFRZ(:)=0.
-P_RI_CFRZ(:)=0.
-P_CI_CFRZ(:)=0.
-!
-ZW1(:)=0.
-ZW2(:)=0.
-!
-WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
-!
- ZW1(:) = XICFRR * PRIT(:) * PCRT(:) & ! RICFRRG
- * PLBDR(:)**XEXICFRR &
- * PRHODREF(:)**(-XCEXVT-1.0)
-!
- ZW2(:) = XRCFRI * PCIT(:) * PCRT(:) & ! RRCFRIG
- * PLBDR(:)**XEXRCFRI &
-!!! BVIE correction RHODREF
-! * PRHODREF(:)**(-XCEXVT-2.0)
- * PRHODREF(:)**(-XCEXVT-1.0)
-!
- P_RR_CFRZ(:) = - ZW2(:)
- P_CR_CFRZ(:) = - ZW2(:) * (PCRT(:)/PRRT(:))
- P_RI_CFRZ(:) = - ZW1(:)
- P_CI_CFRZ(:) = - ZW1(:) * (PCIT(:)/PRIT(:))
- P_TH_CFRZ(:) = - P_RR_CFRZ(:) * (PLSFACT(:)-PLVFACT(:))
-!
-END WHERE
-!
-PA_TH(:) = PA_TH(:) + P_TH_CFRZ(:)
-PA_RR(:) = PA_RR(:) + P_RR_CFRZ(:)
-PA_CR(:) = PA_CR(:) + P_CR_CFRZ(:)
-PA_RI(:) = PA_RI(:) + P_RI_CFRZ(:)
-PA_CI(:) = PA_CI(:) + P_CI_CFRZ(:)
-PA_RG(:) = PA_RG(:) - P_RR_CFRZ(:) - P_RI_CFRZ(:)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_RAIN_FREEZING
diff --git a/src/arome/micro/lima_tendencies.F90 b/src/arome/micro/lima_tendencies.F90
deleted file mode 100644
index 50b68870b0c2841a0abe1de787f21110b094a67b..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_tendencies.F90
+++ /dev/null
@@ -1,634 +0,0 @@
-!###############################
-MODULE MODI_LIMA_TENDENCIES
-!###############################
- INTERFACE
- SUBROUTINE LIMA_TENDENCIES (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- P_RI_AGGS, P_CI_AGGS, &
- P_TH_DEPG, P_RG_DEPG, &
- P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- P_RS_CMEL, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
-!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
-!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
- PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
- PEVAP3D )
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Number concentrations (/kg)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL ! conversion-melting (CMEL) : rs, rg=-rs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
-!
- END SUBROUTINE LIMA_TENDENCIES
- END INTERFACE
-END MODULE MODI_LIMA_TENDENCIES
-!#####################################################################
-!
-!#####################################################################
-SUBROUTINE LIMA_TENDENCIES (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- P_RI_AGGS, P_CI_AGGS, &
- P_TH_DEPG, P_RG_DEPG, &
- P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- P_RS_CMEL, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
-!!! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
-!!! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
-!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
- PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
- PEVAP3D )
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! AUTHOR
-!! ------
-!! MODIFICATIONS
-!! -------------
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, &
- XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, &
- LCOLD_LIMA, LNUCL_LIMA, LSNOW_LIMA, LHAIL_LIMA, LWARM_LIMA, LACTI_LIMA, LRAIN_LIMA
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR
-USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH
-USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS
-!
-USE MODI_LIMA_DROPLETS_HOM_FREEZING
-USE MODI_LIMA_DROPLETS_SELF_COLLECTION
-USE MODI_LIMA_DROPLETS_AUTOCONVERSION
-USE MODI_LIMA_DROPLETS_ACCRETION
-USE MODI_LIMA_DROPS_SELF_COLLECTION
-USE MODI_LIMA_RAIN_EVAPORATION
-USE MODI_LIMA_ICE_SNOW_DEPOSITION
-USE MODI_LIMA_ICE_AGGREGATION_SNOW
-USE MODI_LIMA_GRAUPEL_DEPOSITION
-USE MODI_LIMA_BERGERON
-USE MODI_LIMA_DROPLETS_RIMING_SNOW
-USE MODI_LIMA_RAIN_ACCR_SNOW
-USE MODI_LIMA_CONVERSION_MELTING_SNOW
-USE MODI_LIMA_RAIN_FREEZING
-USE MODI_LIMA_GRAUPEL
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE
-LOGICAL, INTENT(IN) :: OCLOSE_OUT
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Number concentrations (/kg)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP ! evaporation of rain drops (EVAP) : rr, rv=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL ! conversion-melting (CMEL) : rs, rg=-rs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, rg, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZT
-
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDC
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDC3
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDR
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDR3
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDI
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDS
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDG
-REAL, DIMENSION(SIZE(PRCT)) :: ZLBDH
-
-REAL, DIMENSION(SIZE(PRCT)) :: ZAI
-REAL, DIMENSION(SIZE(PRCT)) :: ZKA
-REAL, DIMENSION(SIZE(PRCT)) :: ZDV
-REAL, DIMENSION(SIZE(PRCT)) :: ZCJ
-
-REAL, DIMENSION(SIZE(PRCT)) :: ZEPS
-REAL, DIMENSION(SIZE(PRCT)) :: ZEVSAT
-REAL, DIMENSION(SIZE(PRCT)) :: ZEISAT
-REAL, DIMENSION(SIZE(PRCT)) :: ZRVSAT
-REAL, DIMENSION(SIZE(PRCT)) :: ZRISAT
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZSSI
-REAL, DIMENSION(SIZE(PRCT)) :: ZSSIW
-
-REAL, DIMENSION(SIZE(PRCT)) :: ZLV
-REAL, DIMENSION(SIZE(PRCT)) :: ZLS
-REAL, DIMENSION(SIZE(PRCT)) :: ZLVFACT
-REAL, DIMENSION(SIZE(PRCT)) :: ZLSFACT
-!
-REAL, DIMENSION(SIZE(PRCT)) :: ZW
-!
-!-------------------------------------------------------------------------------
-! Pre-compute quantities
-!
-WHERE (LDCOMPUTE(:))
- ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
-!
- ZW(:) = PEXNREF(:)*( XCPD &
- +XCPV*PRVT(:) &
- +XCL*(PRCT(:)+PRRT(:)) &
- +XCI*(PRIT(:)+PRST(:)+PRGT(:)+PRHT(:)) )
-!
- ZLV(:) = XLVTT + (XCPV-XCL)*(ZT(:)-XTT)
- ZLVFACT(:) = ZLV(:)/ZW(:) ! L_v/(Pi_ref*C_ph)
- ZLS(:) = XLSTT + (XCPV-XCI)*(ZT(:)-XTT)
- ZLSFACT(:) = ZLS(:)/ZW(:) ! L_s/(Pi_ref*C_ph)
-!
- ZEVSAT(:) = EXP( XALPW - XBETAW/ZT(:) - XGAMW*ALOG(ZT(:) ) )
- ZEISAT(:) = EXP( XALPI - XBETAI/ZT(:) - XGAMI*ALOG(ZT(:) ) )
- !
- ZEPS= XMV / XMD
- ZRVSAT(:) = ZEPS * ZEVSAT(:) / (PPABST(:) - ZEVSAT(:))
- ZRISAT(:) = ZEPS * ZEISAT(:) / (PPABST(:) - ZEISAT(:))
- !
- ZSSI(:) = PRVT(:)/ZRISAT(:) - 1.0 ! Si = rv/rsi - 1
- ZSSIW(:) = ZRVSAT(:)/ZRISAT(:) - 1.0 ! Siw = rsw/rsi - 1
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZT(:) - XTT )
-!
- ZDV(:) = 0.211E-4 * (ZT(:)/XTT)**1.94 * (XP00/PPABST(:))
-!
- ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZT(:)**2) &
- + ( XRV*ZT(:) ) / (ZDV(:)*ZEISAT(:))
-!
- ZCJ(:) = XSCFAC * PRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZT(:)-XTT) )
-!
-END WHERE
-!
-!
-ZLBDC(:) = 1.E10
-ZLBDC3(:) = 1.E30
-WHERE (PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:))
- ZLBDC3(:) = XLBC*PCCT(:) / PRCT(:)
- ZLBDC(:) = ZLBDC3(:)**XLBEXC
-END WHERE
-ZLBDR(:) = 1.E10
-ZLBDR3(:) = 1.E30
-WHERE (PRRT(:)>XRTMIN(3) .AND. PCRT(:)>XCTMIN(3) .AND. LDCOMPUTE(:))
- ZLBDR3(:) = XLBR*PCRT(:) / PRRT(:)
- ZLBDR(:) = ZLBDR3(:)**XLBEXR
-END WHERE
-ZLBDI(:) = 1.E10
-WHERE (PRIT(:)>XRTMIN(4) .AND. PCIT(:)>XCTMIN(4) .AND. LDCOMPUTE(:))
- ZLBDI(:) = ( XLBI*PCIT(:) / PRIT(:) )**XLBEXI
-END WHERE
-ZLBDS(:) = 1.E10
-WHERE (PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) )
- ZLBDS(:) = XLBS*( PRHODREF(:)*PRST(:) )**XLBEXS
-END WHERE
-ZLBDG(:) = 1.E10
-WHERE (PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) )
- ZLBDG(:) = XLBG*( PRHODREF(:)*PRGT(:) )**XLBEXG
-END WHERE
-ZLBDH(:) = 1.E10
-WHERE (PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:) )
- ZLBDH(:) = XLBH*( PRHODREF(:)*PRHT(:) )**XLBEXH
-END WHERE
-!
-!-------------------------------------------------------------------------------
-! Call microphysical processes
-!
-IF (LCOLD_LIMA .AND. LWARM_LIMA) THEN
- CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- ZT, ZLVFACT, ZLSFACT, &
- PRCT, PCCT, ZLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
-END IF
-!
-IF (LWARM_LIMA) THEN
- CALL LIMA_DROPLETS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCCT, ZLBDC3, &
- P_CC_SELF, &
- PA_CC )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_DROPLETS_AUTOCONVERSION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, ZLBDC, ZLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO,&
- PA_RC, PA_CC, PA_RR, PA_CR )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_DROPLETS_ACCRETION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- ZLBDC, ZLBDC3, ZLBDR, ZLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_DROPS_SELF_COLLECTION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, &
- PCRT, ZLBDR, ZLBDR3, &
- P_CR_SCBU, &
- PA_CR )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
- CALL LIMA_RAIN_EVAPORATION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
- PRVT, PRCT, PRRT, ZLBDR, &
- P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
- PEVAP3D )
-END IF
-!
-IF (LCOLD_LIMA .AND. LSNOW_LIMA) THEN
- !
- ! Includes vapour deposition on snow, ice -> snow and snow -> ice exchanges
- !
- CALL LIMA_ICE_SNOW_DEPOSITION (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
- PRIT, PRST, PCIT, ZLBDI, ZLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
-END IF
-!
-IF (LCOLD_LIMA .AND. LSNOW_LIMA) THEN
- CALL LIMA_ICE_AGGREGATION_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- ZT, &
- PRIT, PRST, PCIT, ZLBDI, ZLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA) THEN
- CALL LIMA_GRAUPEL_DEPOSITION (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRGT, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA) THEN
- CALL LIMA_BERGERON (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRCT, PRIT, PCIT, ZLBDI, &
- ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
- P_TH_BERFI, P_RC_BERFI, &
- PA_TH, PA_RC, PA_RI )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA .AND. LSNOW_LIMA) THEN
- !
- ! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
- ! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
- !
- CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, ZT, &
- PRCT, PCCT, PRST, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA .AND. LCOLD_LIMA .AND. LSNOW_LIMA) THEN
- CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, ZT, &
- PRRT, PCRT, PRST, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA .AND. LSNOW_LIMA) THEN
- !
- ! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
- ! Some thermodynamical computations inside, to externalize ?
- !
- CALL LIMA_CONVERSION_MELTING_SNOW (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
- PRVT, PRST, ZLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
-END IF
-!
-IF (LWARM_LIMA .AND. LRAIN_LIMA .AND. LCOLD_LIMA ) THEN
- CALL LIMA_RAIN_FREEZING (HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, ZT, ZLVFACT, ZLSFACT, &
- PRRT, PCRT, PRIT, PCIT, ZLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA) THEN
- !
- ! Melting of graupel should account for collected droplets and drops where T>0C, but does not !
- ! Collection and water shedding should also happen where T>0C, but do not !
- ! Hail production as tendency (should be instant to stick to the previous version ?)
- ! Includes Hallett-Mossop process for riming of droplets by graupel (HMG)
- ! Some thermodynamical computations inside, to externalize ?
- !
- CALL LIMA_GRAUPEL (PTSTEP, HFMFILE, OCLOSE_OUT, LDCOMPUTE, &
- PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- ZLBDC, ZLBDR, ZLBDS, ZLBDG, &
- ZLVFACT, ZLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_RG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_RG, PA_RH )
-END IF
-!
-IF (LWARM_LIMA .AND. LCOLD_LIMA .AND. LHAIL_LIMA) THEN
-! CALL LIMA_HAIL_GROWTH
-
-! CALL LIMA_HAIL_CONVERSION
-
-! CALL LIMA_HAIL_MELTING
-END IF
- !
-END SUBROUTINE LIMA_TENDENCIES
diff --git a/src/arome/micro/lima_warm.F90 b/src/arome/micro/lima_warm.F90
deleted file mode 100644
index bcec122552a41bac0f997294e159a62349e92f1a..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_warm.F90
+++ /dev/null
@@ -1,459 +0,0 @@
-! #####################
- MODULE MODI_LIMA_WARM
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
- PTHM, PRCM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- YDDDH, YDLDDH, YDMDDH )
-
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation by radiative
- ! tendency
-LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
- ! cloud droplet sedimentation
-LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
- ! rain formation by coalescence
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! for sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-!
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_WARM
-END INTERFACE
-END MODULE MODI_LIMA_WARM
-! #####################################################################
- SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
- PTHM, PRCM, &
- PTHT, PRT, PSVT, &
- PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- YDDDH, YDLDDH, YDMDDH )
-! #####################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the warm microphysical
-!! sources: nucleation, sedimentation, autoconversion, accretion,
-!! self-collection and vaporisation which are parameterized according
-!! to Cohard and Pinty, QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration. Then assuming a
-!! generalized gamma distribution law for the cloud droplets and the
-!! raindrops, the zeroth and third order moments tendencies are evaluated
-!! for all the coalescence terms by integrating the Stochastic Collection
-!! Equation. As autoconversion is a process that cannot be resolved
-!! analytically, the Berry-Reinhardt parameterisation is employed with
-!! modifications to initiate the raindrop spectrum mode. The integration
-!! of the raindrop evaporation below clouds is straightforward.
-!!
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMLUN , ONLY : NULOUT
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CONF
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-USE MODD_NSV
-!
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE MODI_LIMA_WARM_SEDIMENTATION
-USE MODI_LIMA_WARM_NUCL
-USE MODI_LIMA_WARM_COAL
-USE MODI_LIMA_WARM_EVAP
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation by radiative
- ! tendency
-LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
- ! cloud droplet sedimentation
-LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
- ! rain formation by coalescence
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! for sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
-!
-!
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: PRVT, & ! Water vapor m.r. at t
- PRCT, & ! Cloud water m.r. at t
- PRRT, & ! Rain water m.r. at t
- !
- PRVS, & ! Water vapor m.r. source
- PRCS, & ! Cloud water m.r. source
- PRRS, & ! Rain water m.r. source
- !
- PCCT, & ! Cloud water C. at t
- PCRT, & ! Rain water C. at t
- !
- PCCS, & ! Cloud water C. source
- PCRS ! Rain water C. source
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
-!
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZT, ZTM
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
-INTEGER :: JL
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. 3D MICROPHYSCAL VARIABLES
-! -------------------------
-!
-!
-! Prepare 3D water mixing ratios
-PRVT(:,:,:) = PRT(:,:,:,1)
-PRVS(:,:,:) = PRS(:,:,:,1)
-!
-PRCT(:,:,:) = 0.
-PRCS(:,:,:) = 0.
-PRRT(:,:,:) = 0.
-PRRS(:,:,:) = 0.
-!
-IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
-IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
-IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
-IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
-!
-! Prepare 3D number concentrations
-PCCT(:,:,:) = 0.
-PCRT(:,:,:) = 0.
-PCCS(:,:,:) = 0.
-PCRS(:,:,:) = 0.
-!
-IF ( LWARM_LIMA ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-!
-IF ( LWARM_LIMA ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-ELSE
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. COMPUTE THE SLOPE PARAMETERS ZLBDC,ZLBDR
-! ----------------------------------------
-!
-!
-ZWLBDC3(:,:,:) = 1.E45
-ZWLBDC(:,:,:) = 1.E15
-!
-WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
- ZWLBDC3(:,:,:) = XLBC * PCCT(:,:,:) / PRCT(:,:,:)
- ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
-END WHERE
-!
-ZWLBDR3(:,:,:) = 1.E30
-ZWLBDR(:,:,:) = 1.E10
-WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
- ZWLBDR3(:,:,:) = XLBR * PCRT(:,:,:) / PRRT(:,:,:)
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
-END WHERE
-ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-IF( OACTIT ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!
-CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODREF, PPABST, ZT, &
- ZWLBDC, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PINPRC, PINPRR, &
- PINPRR3D )
-!
-IF (LBUDGET_RC .AND. OSEDC) &
- CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,&
- &'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- IF (ORAIN) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
- &'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCR
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTES THE NUCLEATION PROCESS SOURCES
-! --------------------------------------
-!
-!
-IF (LACTI_LIMA) THEN
-!
- CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-!
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) THEN
- CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCN
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- END IF
-!
-END IF ! LACTI_LIMA
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 3. COALESCENCE PROCESSES
-! ---------------------
-!
-!
- CALL LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PRHODJ,YDDDH, YDLDDH, YDMDDH )
-!
-!
-!-------------------------------------------------------------------------------
-!
-! 4. EVAPORATION OF RAINDROPS
-! ------------------------
-!
-!
-IF (ORAIN) THEN
-!
- CALL LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, &
- ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRVT, PRCT, PRRT, PCRT, &
- PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
- PEVAP3D )
-!
- IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
-!
-!-------------------------------------------------------------------------------
-!
-! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
-! --------------------
-!
- ZWLBDR(:,:,:) = 1.E10
- WHERE (PRRS(:,:,:)>XRTMIN(3)/PTSTEP.AND.PCRS(:,:,:)>XCTMIN(3)/PTSTEP )
- ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
- END WHERE
- WHERE (ZWLBDR(:,:,:)<(XACCR1/XSPONBUD1))
- PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
- (XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
- END WHERE
-!
-! Budget storage
- IF (LBUDGET_SV) &
- CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
- &'BRKU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
-!
-ENDIF ! ORAIN
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 6. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
-! -------------------------------------------------
-!
-PRS(:,:,:,1) = PRVS(:,:,:)
-IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
-IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
-!
-! Prepare 3D number concentrations
-!
-IF ( LWARM_LIMA ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM_LIMA .AND. LRAIN_LIMA ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
-!
-IF ( NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
-END IF
-!
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_WARM
diff --git a/src/arome/micro/lima_warm_coal.F90 b/src/arome/micro/lima_warm_coal.F90
deleted file mode 100644
index cf7ade8f31605d5dc667bf75c58b1d6798437965..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_warm_coal.F90
+++ /dev/null
@@ -1,513 +0,0 @@
-! ##########################
- MODULE MODI_LIMA_WARM_COAL
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PRHODJ, &
- YDDDH, YDLDDH, YDMDDH )
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
- END SUBROUTINE LIMA_WARM_COAL
-END INTERFACE
-END MODULE MODI_LIMA_WARM_COAL
-! #############################################################################
- SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PRHODJ, &
- YDDDH, YDLDDH, YDMDDH )
-! #############################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources:
-!! nucleation, sedimentation, autoconversion, accretion, self-collection
-!! and vaporisation which are parameterized according to Cohard and Pinty
-!! QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! Assuming a generalized gamma distribution law for the cloud droplets
-!! and the raindrops, the zeroth and third order moments tendencies
-!! are evaluated for all the coalescence terms by integrating the
-!! Stochastic Collection Equation. As autoconversion is a process that
-!! cannot be resolved analytically, the Berry-Reinhardt parameterisation
-!! is employed with modifications to initiate the raindrop spectrum mode.
-!!
-!! Computation steps :
-!! 1- Check where computations are necessary, pack variables
-!! 2- Self collection of cloud droplets
-!! 3- Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-!! 4- Accretion sources
-!! 5- Self collection - Coalescence/Break-up
-!! 6- Unpack variables, clean
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! C. Barthe * LACy * jan. 2014 add budgets
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-!
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.1 Declarations of local variables :
-!
-! Packing variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
-INTEGER :: IMICRO
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed micophysical variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
-!
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
-!
-! Other packed variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC3
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR3
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
-!
-! Work arrays
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZW
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZSCBU
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GSELF, &
- GACCR, &
- GSCBU, &
- GENABLE_ACCR_SCBU
-!
-!
-INTEGER :: ISELF, IACCR, ISCBU
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PREPARE COMPUTATIONS - PACK
-! ---------------------------
-!
-!
-IIB=1+JPHEXT
-IIE=SIZE(PRHODREF,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PRHODREF,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PRHODREF,3) - JPVEXT
-!
-GMICRO(:,:,:) = .FALSE.
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
- PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3)
-!
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-!
-IF( IMICRO >= 1 ) THEN
- ALLOCATE(ZRCT(IMICRO))
- ALLOCATE(ZRRT(IMICRO))
- ALLOCATE(ZCCT(IMICRO))
- ALLOCATE(ZCRT(IMICRO))
-!
- ALLOCATE(ZRCS(IMICRO))
- ALLOCATE(ZRRS(IMICRO))
- ALLOCATE(ZCCS(IMICRO))
- ALLOCATE(ZCRS(IMICRO))
-!
- ALLOCATE(ZLBDC(IMICRO))
- ALLOCATE(ZLBDC3(IMICRO))
- ALLOCATE(ZLBDR(IMICRO))
- ALLOCATE(ZLBDR3(IMICRO))
-!
- ALLOCATE(ZRHODREF(IMICRO))
- DO JL=1,IMICRO
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
- ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
- ZLBDR3(JL) = ZWLBDR3(I1(JL),I2(JL),I3(JL))
- ZLBDC(JL) = ZWLBDC(I1(JL),I2(JL),I3(JL))
- ZLBDC3(JL) = ZWLBDC3(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- END DO
-!
- ALLOCATE(GSELF(IMICRO))
- ALLOCATE(GACCR(IMICRO))
- ALLOCATE(GSCBU(IMICRO))
- ALLOCATE(ZZW1(IMICRO))
- ALLOCATE(ZZW2(IMICRO))
- ALLOCATE(ZZW3(IMICRO))
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. Self-collection of cloud droplets
-! ------------------------------------
-!
-!
- GSELF(:) = ZCCT(:)>XCTMIN(2)
- ISELF = COUNT(GSELF(:))
- IF( ISELF>0 ) THEN
- ZZW1(:) = XSELFC*(ZCCT(:)/ZLBDC3(:))**2 * ZRHODREF(:) ! analytical integration
- WHERE( GSELF(:) )
- ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
- END WHERE
- END IF
-!
-!
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
- &*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-! ----------------------------------------------------------------------
-!
-!
-IF (LRAIN_LIMA) THEN
-!
- ZZW2(:) = 0.0
- ZZW1(:) = 0.0
- WHERE( ZRCT(:)>XRTMIN(2) )
- ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* &
- (XAUTO1/ZLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
-!
- ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* &
- (XAUTO2/ZLBDC(:)-XITAUTR_THRESHOLD) ) ) ! L/tau
-!
- ZRCS(:) = ZRCS(:) - ZZW3(:)
- ZRRS(:) = ZRRS(:) + ZZW3(:)
-!
- ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), &
- ZLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
- ! switching the autoconversion regimes
- ! min (80 microns, D_h, D_r)
- ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC
- ZCRS(:) = ZCRS(:) + ZZW3(:)
- END WHERE
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCRS(:,:,:)
- CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- ZW(:,:,:) = PCCS(:,:,:)
- CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. Accretion sources
-! --------------------
-!
-!
- GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
- IACCR = COUNT(GACCR(:))
- IF( IACCR>0 ) THEN
- ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
- ALLOCATE(GENABLE_ACCR_SCBU(IMICRO))
- GENABLE_ACCR_SCBU(:) = ZRRT(:)>1.2*ZZW2(:)/ZRHODREF(:) .OR. &
- ZZW4(:)>=MAX( XACCR2,XACCR3/(XACCR4/ZLBDC(:)-XACCR5) )
- GACCR(:) = GACCR(:) .AND. ZRCT(:)>XRTMIN(2) .AND. GENABLE_ACCR_SCBU(:)
- END IF
-!
- IACCR = COUNT(GACCR(:))
- IF( IACCR>0 ) THEN
- WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
- ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
- ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
- ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) )
- ZCCS(:) = ZCCS(:) - ZZW2(:)
-!
- ZZW1(:) = ( ZZW1(:) / ZLBDC3(:) )*ZRHODREF(:)
- ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)),ZRCS(:) )
- ZRCS(:) = ZRCS(:) - ZZW2(:)
- ZRRS(:) = ZRRS(:) + ZZW2(:)
- END WHERE
- WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m
- ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
- ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:)**2 )*ZRHODREF(:)
- ZZW3(:) = ZZW3(:)**2
- ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) )
- ZCCS(:) = ZCCS(:) - ZZW2(:)
-!
- ZZW1(:) = ZZW1(:) / ZLBDC3(:)
- ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) &
- *ZRHODREF(:),ZRCS(:) )
- ZRCS(:) = ZRCS(:) - ZZW2(:)
- ZRRS(:) = ZRRS(:) + ZZW2(:)
- END WHERE
- END IF
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET_DDH ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET_DDH ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. Self collection - Coalescence/Break-up
-! -----------------------------------------
-!
-!
- IF( IACCR>0 ) THEN
- GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
- ISCBU = COUNT(GSCBU(:))
- ELSE
- ISCBU = 0.0
- END IF
- IF( ISCBU>0 ) THEN
-!
-!* 5.1 efficiencies
-!
- IF (.NOT.ALLOCATED(ZZW4)) ALLOCATE(ZZW4(IMICRO))
- ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean diameter
- ALLOCATE(ZSCBU(IMICRO))
- ZSCBU(:) = 1.0
- WHERE (ZZW4(:)>=XSCBU_EFF1 .AND. GSCBU(:)) ZSCBU(:) = & ! Coalescence
- EXP(XSCBUEXP1*(ZZW4(:)-XSCBU_EFF1)) ! efficiency
- WHERE (ZZW4(:)>=XSCBU_EFF2) ZSCBU(:) = 0.0 ! Break-up
-!
-!* 5.2 integration
-!
- ZZW1(:) = 0.0
- ZZW2(:) = 0.0
- ZZW3(:) = 0.0
- ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean volume drop diameter
- WHERE (GSCBU(:).AND.(ZZW4(:)>1.E-4)) ! analytical integration
- ZZW1(:) = XSCBU2 * ZCRT(:)**2 / ZLBDR3(:) ! D>100 10-6 m
- ZZW3(:) = ZZW1(:)*ZSCBU(:)
- END WHERE
- WHERE (GSCBU(:).AND.(ZZW4(:)<=1.E-4))
- ZZW2(:) = XSCBU3 *(ZCRT(:) / ZLBDR3(:))**2 ! D<100 10-6 m
- ZZW3(:) = ZZW2(:)
- END WHERE
- ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) * ZRHODREF(:) )
- DEALLOCATE(ZSCBU)
- END IF
-!
-!
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET_DDH ( &
- UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
-END IF ! LRAIN_LIMA
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. Unpack and clean
-! -------------------
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCCS(:,:,:)
- PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCRS(:,:,:)
- PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZCRT)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZCRS)
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(GSELF)
- DEALLOCATE(GACCR)
- DEALLOCATE(GSCBU)
- IF( ALLOCATED(GENABLE_ACCR_SCBU) ) DEALLOCATE(GENABLE_ACCR_SCBU)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- IF( ALLOCATED(ZZW4) ) DEALLOCATE(ZZW4)
- DEALLOCATE(ZLBDR3)
- DEALLOCATE(ZLBDC3)
- DEALLOCATE(ZLBDR)
- DEALLOCATE(ZLBDC)
-!
-!
-!-------------------------------------------------------------------------------
-!
-ELSE
-!* 7. Budgets are forwarded
-! ------------------------
-!
-!
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
- IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
- IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-
-END IF ! IMICRO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_WARM_COAL
diff --git a/src/arome/micro/lima_warm_evap.F90 b/src/arome/micro/lima_warm_evap.F90
deleted file mode 100644
index a7674a41eb30951d187ca89fac202d02907e3c59..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_warm_evap.F90
+++ /dev/null
@@ -1,350 +0,0 @@
-! ##########################
- MODULE MODI_LIMA_WARM_EVAP
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, &
- ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRVT, PRCT, PRRT, PCRT, &
- PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
- PEVAP3D)
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
- END SUBROUTINE LIMA_WARM_EVAP
-END INTERFACE
-END MODULE MODI_LIMA_WARM_EVAP
-! #############################################################################
- SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, &
- ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
- PRVT, PRCT, PRRT, PCRT, &
- PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
- PEVAP3D)
-! #############################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the raindrop evaporation
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-!* 0.1 Declarations of local variables :
-!
-! Packing variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GEVAP, GMICRO
-INTEGER :: IEVAP, IMICRO
-INTEGER , DIMENSION(SIZE(GEVAP)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed micophysical variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
-!
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZTHS ! Theta source
-!
-! Other packed variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR ! Lambda(rain)
-!
-! Work arrays
-REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
- ZRTMIN, ZCTMIN, &
- ZZLV ! Latent heat of vaporization at T
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZW2, ZRVSAT
-!
-!
-REAL :: ZEPS, ZFACT
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PREPARE COMPUTATIONS - PACK
-! ---------------------------
-!
-!
-IIB=1+JPHEXT
-IIE=SIZE(PRHODREF,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PRHODREF,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PRHODREF,3) - JPVEXT
-!
-ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-ZCTMIN(:) = XCTMIN(:) / PTSTEP
-!
-ZEPS= XMV / XMD
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
-
-!
-GEVAP(:,:,:) = .FALSE.
-GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. &
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
-!
-IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:))
-!
-IF( IEVAP >= 1 ) THEN
- ALLOCATE(ZRVT(IEVAP))
- ALLOCATE(ZRCT(IEVAP))
- ALLOCATE(ZRRT(IEVAP))
- ALLOCATE(ZCRT(IEVAP))
-!
- ALLOCATE(ZRVS(IEVAP))
- ALLOCATE(ZRRS(IEVAP))
- ALLOCATE(ZTHS(IEVAP))
-!
- ALLOCATE(ZLBDR(IEVAP))
-!
- ALLOCATE(ZRHODREF(IEVAP))
- ALLOCATE(ZEXNREF(IEVAP))
-!
- ALLOCATE(ZZT(IEVAP))
- ALLOCATE(ZZLV(IEVAP))
- ALLOCATE(ZZW1(IEVAP))
- DO JL=1,IEVAP
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
- ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- END DO
- ZZLV(:) = XLVTT + (XCPV-XCL)*(ZZT(:)-XTT)
-!
- ALLOCATE(ZZW2(IEVAP))
- ALLOCATE(ZZW3(IEVAP))
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. compute the evaporation of rain drops
-! ----------------------------------------
-!
-!
- ZZW3(:) = MAX((1.0 - ZRVT(:)/ZZW1(:)),0.0) ! Subsaturation
-!
-! Compute the function G(T)
-!
- ZZW2(:) = 1. / ( XRHOLW*((((ZZLV(:)/ZZT(:))**2)/(XTHCO*XRV)) + & ! G
- (XRV*ZZT(:))/(XDIVA*EXP(XALPW-XBETAW/ZZT(:)-XGAMW*ALOG(ZZT(:))))))
-!
-! Compute the evaporation tendency
-!
- ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * &
- (X0EVAR*ZLBDR(:)**XEX0EVAR + X1EVAR*ZRHODREF(:)**XEX2EVAR* &
- ZLBDR(:)**XEX1EVAR),ZRRS(:) )
- ZZW2(:) = MAX(ZZW2(:),0.0)
-!
-! Adjust sources
-!
- ZRVS(:) = ZRVS(:) + ZZW2(:)
- ZRRS(:) = ZRRS(:) - ZZW2(:)
- ZTHS(:) = ZTHS(:) - ZZW2(:)*ZZLV(:) / &
- ( ZEXNREF(:)*(XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:) + ZRRT(:)) ) )
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Unpack and clean
-! -------------------
-!
-!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:)= PEVAP3D(:,:,:)
- PEVAP3D(:,:,:) = UNPACK( ZZW2(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
-!
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZCRT)
- DEALLOCATE(ZRVS)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZTHS)
- DEALLOCATE(ZZLV)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZEXNREF)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- DEALLOCATE(ZLBDR)
-!
-!
-!-----------------------------------------------------------------------------
-!
-!
-!* 4. Update Nr if: 80 microns < Dr < D_h
-! ---------------------------------------
-!
-!
- GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3) .AND. &
- PRCS(:,:,:)>ZRTMIN(2) .AND. PCCS(:,:,:)>ZCTMIN(2)
- WHERE (GEVAP(:,:,:))
- ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
-!
- ZWLBDC3(:,:,:) = XLBC * PCCS(:,:,:) / PRCS(:,:,:)
- ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
- ZWLBDC3(:,:,:) = (XACCR1/XACCR3)*(XACCR4/ZWLBDC(:,:,:)-XACCR5) ! 1/D_h, not "Lambda_h"
- END WHERE
-!
- GMICRO(:,:,:) = GEVAP(:,:,:) .AND. ZWLBDR(:,:,:)>ZWLBDC3(:,:,:)
- ! the raindrops are too small, that is lower than D_h
- ZFACT = 1.2E4*XACCR1
- WHERE (GMICRO(:,:,:))
- ZWLBDC(:,:,:) = XLBR / MIN( ZFACT,ZWLBDC3(:,:,:) )**3
- ZW(:,:,:) = MIN( MAX( &
- (PRHODREF(:,:,:)*PRRS(:,:,:) - ZWLBDC(:,:,:)*PCRS(:,:,:)) / &
- (PRHODREF(:,:,:)*PRCS(:,:,:)/PCCS(:,:,:) - ZWLBDC(:,:,:)) , &
- 0.0 ),PCRS(:,:,:), &
- PCCS(:,:,:)*PRRS(:,:,:)/(PRCS(:,:,:)))
-!
-! Compute the percent (=1 if (ZWLBDR/XACCR1) >= 1.2E4
-! of transfer with (=0 if (ZWLBDR/XACCR1) <= (XACCR4/ZWLBDC-XACCR5)/XACCR3
-!
- ZW(:,:,:) = ZW(:,:,:)*( (MIN(ZWLBDR(:,:,:),1.2E4*XACCR1)-ZWLBDC3(:,:,:)) / &
- ( 1.2E4*XACCR1 -ZWLBDC3(:,:,:)) )
-!
- ZW2(:,:,:) = PCCS(:,:,:) !temporary storage
- PCCS(:,:,:) = PCCS(:,:,:)+ZW(:,:,:)
- PCRS(:,:,:) = PCRS(:,:,:)-ZW(:,:,:)
- ZW(:,:,:) = ZW(:,:,:) * (PRHODREF(:,:,:)*PRCS(:,:,:)/ZW2(:,:,:))
- PRCS(:,:,:) = PRCS(:,:,:)+ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:)-ZW(:,:,:)
- END WHERE
-!
- GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .OR. PCRS(:,:,:)<ZCTMIN(3)
- WHERE (GEVAP(:,:,:))
- PCRS(:,:,:) = 0.0
- PRRS(:,:,:) = 0.0
- END WHERE
-!
-END IF ! IEVAP
-!
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
-!
-!-----------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_WARM_EVAP
diff --git a/src/arome/micro/lima_warm_nucl.F90 b/src/arome/micro/lima_warm_nucl.F90
deleted file mode 100644
index a82de8ba9c7c8ecb2c63df42847532098fd5b939..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_warm_nucl.F90
+++ /dev/null
@@ -1,817 +0,0 @@
-! ##########################
- MODULE MODI_LIMA_WARM_NUCL
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-!
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation by radiative
- ! tendency
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-!
-REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
-!
-END SUBROUTINE LIMA_WARM_NUCL
-END INTERFACE
-END MODULE MODI_LIMA_WARM_NUCL
-! #############################################################################
- SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-! #############################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the activation of CCN
-!! according to Cohard and Pinty, QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration.
-!!
-!! Computation steps :
-!! 1- Check where computations are necessary
-!! 2- and 3- Compute the maximum of supersaturation using the iterative
-!! Ridder algorithm
-!! 4- Compute the nucleation source
-!! 5- Deallocate local variables
-!!
-!! Contains :
-!! 6- Functions : Ridder algorithm
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-!
-USE YOMLUN , ONLY : NULOUT
-
-USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation by radiative
- ! tendency
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-!
-REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
-!
-!
-!* 0.1 Declarations of local variables :
-!
-! Packing variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GNUCT
-INTEGER :: INUCT
-INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed micophysical variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! activated nucleus conc. source
-!
-! Other packed variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
-!
-! Work arrays
-REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
- ZRTMIN, ZCTMIN, &
- ZZTDT, & ! dT/dt
- ZSMAX, & ! Maximum supersaturation
- ZVEC1
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZTDT, ZDRC, ZRVSAT, ZW
-REAL, DIMENSION(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3)) &
- :: ZCONC_TOT ! total CCN C. available
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
- ! interpolations
-!
-!
-REAL :: ZEPS ! molar mass ratio
-REAL :: ZS1, ZS2, ZXACC
-INTEGER :: JMOD
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. PREPARE COMPUTATIONS - PACK
-! ---------------------------
-!
-!
-IIB=1+JPHEXT
-IIE=SIZE(PRHODREF,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PRHODREF,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PRHODREF,3) - JPVEXT
-!
-ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-ZCTMIN(:) = XCTMIN(:) / PTSTEP
-!
-! Saturation vapor mixing ratio and radiative tendency
-!
-ZEPS= XMV / XMD
-!
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
-ZTDT(:,:,:) = 0.
-ZDRC(:,:,:) = 0.
-IF (OACTIT) THEN
- ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
-!!! JPP
-!!! JPP
-!!! ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
- ZDRC(:,:,:) = PRCS(:,:,:)-(PRCT(:,:,:)/PTSTEP) ! drc/dt
-!!! JPP
-!!! JPP
-!!
-!! BV - W and drc/dt effect should not be included in ZTDT (already accounted for in the computations) ?
-!!
-!! ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
-!! (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
-END IF
-!
-! find locations where CCN are available
-!
-ZCONC_TOT(:,:,:) = 0.0
-DO JMOD = 1, NMOD_CCN
- ZCONC_TOT(:,:,:) = ZCONC_TOT(:,:,:) + PNFS(:,:,:,JMOD) ! sum over the free CCN
-ENDDO
-!
-! optimization by looking for locations where
-! the updraft velocity is positive!!!
-!
-GNUCT(:,:,:) = .FALSE.
-!
-! NEW : -22°C = limit sup for condensation freezing in Fridlin et al., 2007
-IF( OACTIT ) THEN
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
- ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
-ELSE
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
-END IF
-INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
-!
-!
-IF( INUCT >= 1 ) THEN
-!
- ALLOCATE(ZNFS(INUCT,NMOD_CCN))
- ALLOCATE(ZNAS(INUCT,NMOD_CCN))
- ALLOCATE(ZTMP(INUCT,NMOD_CCN))
- ALLOCATE(ZCCS(INUCT))
- ALLOCATE(ZZT(INUCT))
- ALLOCATE(ZZTDT(INUCT))
- ALLOCATE(ZZW1(INUCT))
- ALLOCATE(ZZW2(INUCT))
- ALLOCATE(ZZW3(INUCT))
- ALLOCATE(ZZW4(INUCT))
- ALLOCATE(ZZW5(INUCT))
- ALLOCATE(ZZW6(INUCT))
- ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
- ALLOCATE(ZVEC1(INUCT))
- ALLOCATE(IVEC1(INUCT))
- ALLOCATE(ZRHODREF(INUCT))
- ALLOCATE(ZEXNREF(INUCT))
- DO JL=1,INUCT
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
- ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
- ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- DO JMOD = 1,NMOD_CCN
- ZNFS(JL,JMOD) = PNFS(I1(JL),I2(JL),I3(JL),JMOD)
- ZNAS(JL,JMOD) = PNAS(I1(JL),I2(JL),I3(JL),JMOD)
- ZCHEN_MULTI(JL,JMOD) = (ZNFS(JL,JMOD)+ZNAS(JL,JMOD))*PTSTEP*ZRHODREF(JL) &
- / XLIMIT_FACTOR(JMOD)
- ENDDO
- ENDDO
-!
- ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
- + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. compute the constant term (ZZW3) relative to smax
-! ----------------------------------------------------
-!
-! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
-!
-!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NAHEN)-0.00001, &
- XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
- ALLOCATE(ZSMAX(INUCT))
-!
-!
- IF (OACTIT) THEN ! including a cooling rate
-!
-! Compute the tabulation of function of ZZW3 :
-!
-! (Psi1*w+Psi3*DT/Dt)**1.5
-! ZZW3 = XAHENG*(Psi1*w + Psi3*DT/Dt)**1.5 = ------------------------
-! 2*pi*rho_l*G**(3/2)
-!
-!
- ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZZTDT(:)
- ZZW5(:)=XPSI1( IVEC1(:) )*ZZW2(:)+XPSI3(IVEC1(:) )*ZZTDT(:)
- WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
- ZZW4(:) = 0.
- ZZW5(:) = 0.
- END WHERE
- ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
- - XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
- ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
-!
-!
- ELSE ! OACTIT , for clouds
-!
-!
-! Compute the tabulation of function of ZZW3 :
-!
-! (Psi1 * w)**1.5
-! ZZW3 = XAHENG * (Psi1 * w)**1.5 = -------------------------
-! 2 pi rho_l * G**(3/2)
-!
-!
- ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
- -XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
-!
- END IF ! OACTIT
-!
-!
-! (Psi1*w+Psi3*DT/Dt)**1.5 rho_air
-! ZZW3 = ------------------------ * -------
-! 2*pi*rho_l*G**(3/2) Psi2
-!
- ZZW5(:) = 1.
- ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
- ! for multiple aerosol modes
- WHERE (ZZW3(:) == 0.)
- ZZW5(:) = -1.
- END WHERE
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Compute the maximum of supersaturation
-! -----------------------------------------
-!
-!
-! estimate S_max for the CPB98 parameterization with SEVERAL aerosols mode
-! Reminder : Smax=0.01 for a 1% supersaturation
-!
-! Interval bounds to tabulate sursaturation Smax
-! Check with values used for tabulation in ini_lima_warm.f90
- ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
- ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
- ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
-!
- ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. Compute the nucleus source
-! -----------------------------
-!
-!
-! Again : Smax=0.01 for a 1% supersaturation
-! Modified values for Beta and C (see in init_aerosol_properties) account for that
-!
- WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
- IVEC1(:) = INT( ZVEC1(:) )
- ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
- END WHERE
- ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
-!
- ZTMP(:,:)=0.0
-!
-! Compute the concentration of activable aerosols for each mode
-! based on the max of supersaturation ( -> ZTMP )
-!
- DO JMOD = 1, NMOD_CCN ! iteration on mode number
- ZZW1(:) = 0.
- ZZW2(:) = 0.
- ZZW3(:) = 0.
- !
- WHERE( ZSMAX(:)>0.0 )
- ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
- - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
- !
- ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/ZRHODREF(:))*ZSMAX(:)**XKHEN_MULTI(JMOD) &
- *ZZW2(:)/PTSTEP
- ENDWHERE
- ENDDO
-!
-! Compute the concentration of aerosols activated at this time step
-! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
-!
- DO JMOD = 1, NMOD_CCN ! iteration on mode number
- ZZW1(:) = 0.
- ZZW2(:) = 0.
- ZZW3(:) = 0.
- !
- WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 25.E6/ZRHODREF(:) )
- ZZW1(:) = MIN( ZNFS(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAS(:,JMOD) , 0.0 ) )
- ENDWHERE
- !
- !* update the concentration of activated CCN = Na
- !
- PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
- UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
- !
- !* update the concentration of free CCN = Nf
- !
- PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) - &
- UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
- !
- !* prepare to update the cloud water concentration
- !
- ZZW6(:) = ZZW6(:) + ZZW1(:)
- ENDDO
-!
-! Update PRVS, PRCS, PCCS, and PTHS
-!
- ZZW1(:)=0.
- WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
- ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
- END WHERE
- ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
-!
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
- (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
-!
- ZW(:,:,:) = PCCS(:,:,:)
- PCCS(:,:,:) = UNPACK( ZZW6(:)+ZCCS(:),MASK=GNUCT(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. Cleaning
-! -----------
-!
-!
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC1)
- DEALLOCATE(ZNFS)
- DEALLOCATE(ZNAS)
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZSMAX)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- DEALLOCATE(ZZW4)
- DEALLOCATE(ZZW5)
- DEALLOCATE(ZZW6)
- DEALLOCATE(ZZTDT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZCHEN_MULTI)
- DEALLOCATE(ZEXNREF)
-!
-END IF ! INUCT
-!
-DEALLOCATE(ZCTMIN)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 6. Functions used to compute the maximum of supersaturation
-! -----------------------------------------------------------
-!
-!
-CONTAINS
-!------------------------------------------------------------------------------
-!
- FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,NPTS) RESULT(PZRIDDR)
-!
-!
-!!**** *ZRIDDR* - iterative algorithm to find root of a function
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this function is to find the root of a given function
-!! the arguments are the brackets bounds (the interval where to find the root)
-!! the accuracy needed and the input parameters of the given function.
-!! Using Ridders' method, return the root of a function known to lie between
-!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
-!! accuracy PXACC.
-!!
-!!** METHOD
-!! ------
-!! Ridders' method
-!!
-!! EXTERNAL
-!! --------
-!! FUNCSMAX
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
-!! (ISBN 0-521-43064-X)
-!! Copyright (C) 1986-1992 by Cambridge University Press.
-!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
-!!
-!! AUTHOR
-!! ------
-!! Frederick Chosson *CERFACS*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/07/07
-!! S.BERTHET 2008 vectorization
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: NPTS
-REAL, DIMENSION(:), INTENT(IN) :: PZZW3
-REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
-REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
-!
-!* 0.2 declarations of local variables
-!
-!
-INTEGER, PARAMETER :: MAXIT=60
-REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
-REAL, DIMENSION(:), ALLOCATABLE :: fh,fl, fm,fnew
-REAL :: s,xh,xl,xm,xnew
-REAL :: PX2
-INTEGER :: j, JL
-!
-ALLOCATE( fh(NPTS))
-ALLOCATE( fl(NPTS))
-ALLOCATE( fm(NPTS))
-ALLOCATE(fnew(NPTS))
-ALLOCATE(PZRIDDR(NPTS))
-!
-PZRIDDR(:)= UNUSED
-PX2 = PX2INIT
-fl(:) = FUNCSMAX(PX1,PZZW3(:),NPTS)
-fh(:) = FUNCSMAX(PX2,PZZW3(:),NPTS)
-!
-DO JL = 1, NPTS
- PX2 = PX2INIT
-100 if ((fl(JL) > 0.0 .and. fh(JL) < 0.0) .or. (fl(JL) < 0.0 .and. fh(JL) > 0.0)) then
- xl = PX1
- xh = PX2
- do j=1,MAXIT
- xm = 0.5*(xl+xh)
- fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),JL)
- s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
- if (s == 0.0) then
- GO TO 101
- endif
- xnew = xm+(xm-xl)*(sign(1.0,fl(JL)-fh(JL))*fm(JL)/s)
- if (abs(xnew - PZRIDDR(JL)) <= PXACC) then
- GO TO 101
- endif
- PZRIDDR(JL) = xnew
- fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),JL)
- if (fnew(JL) == 0.0) then
- GO TO 101
- endif
- if (sign(fm(JL),fnew(JL)) /= fm(JL)) then
- xl =xm
- fl(JL)=fm(JL)
- xh =PZRIDDR(JL)
- fh(JL)=fnew(JL)
- else if (sign(fl(JL),fnew(JL)) /= fl(JL)) then
- xh =PZRIDDR(JL)
- fh(JL)=fnew(JL)
- else if (sign(fh(JL),fnew(JL)) /= fh(JL)) then
- xl =PZRIDDR(JL)
- fl(JL)=fnew(JL)
- else if (PX2 .lt. 0.05) then
- PX2 = PX2 + 1.0E-2
- PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
- go to 100
- print*, 'PZRIDDR: never get here'
- STOP
- end if
- if (abs(xh-xl) <= PXACC) then
- GO TO 101
- endif
-!!SB
-!!$ if (j == MAXIT .and. (abs(xh-xl) > PXACC) ) then
-!!$ PZRIDDR(JL)=0.0
-!!$ go to 101
-!!$ endif
-!!SB
- end do
- print*, 'PZRIDDR: exceeded maximum iterations',j
- STOP
- else if (fl(JL) == 0.0) then
- PZRIDDR(JL)=PX1
- else if (fh(JL) == 0.0) then
- PZRIDDR(JL)=PX2
- else if (PX2 .lt. 0.05) then
- PX2 = PX2 + 1.0E-2
- PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
- go to 100
- else
-!!$ print*, 'PZRIDDR: root must be bracketed'
-!!$ print*,'npts ',NPTS,'jl',JL
-!!$ print*, 'PX1,PX2,fl,fh',PX1,PX2,fl(JL),fh(JL)
-!!$ print*, 'PX2 = 30 % of supersaturation, there is no solution for Smax'
-!!$ print*, 'try to put greater PX2 (upper bound for Smax research)'
-!!$ STOP
- PZRIDDR(JL)=0.0
- go to 101
- end if
-101 ENDDO
-!
-DEALLOCATE( fh)
-DEALLOCATE( fl)
-DEALLOCATE( fm)
-DEALLOCATE(fnew)
-!
-END FUNCTION ZRIDDR
-!
-!------------------------------------------------------------------------------
-!
- FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,NPTS) RESULT(PFUNCSMAX)
-!
-!
-!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
-!!
-!!
-!! PURPOSE
-!! -------
-!! This function describe the equilibrium between Smax and two aerosol mode
-!! acting as CCN. This function is derive from eq. (9) of CPB98 but for two
-!! aerosols mode described by their respective parameters C, k, Mu, Beta.
-!! the arguments are the supersaturation in "no unit" and the r.h.s. of this eq.
-!! and the ratio of concentration of injected aerosols on maximum concentration
-!! of injected aerosols ever.
-!!** METHOD
-!! ------
-!! This function is called by zriddr.f90
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAM_LIMA_WARM
-!! XHYPF32
-!!
-!! XHYPINTP1
-!! XHYPINTP2
-!!
-!! Module MODD_PARAM_C2R2
-!! XKHEN_MULTI()
-!! NMOD_CCN
-!!
-!! REFERENCE
-!! ---------
-!! Cohard, J.M., J.P.Pinty, K.Suhre, 2000:"On the parameterization of activation
-!! spectra from cloud condensation nuclei microphysical properties",
-!! J. Geophys. Res., Vol.105, N0.D9, pp. 11753-11766
-!!
-!! AUTHOR
-!! ------
-!! Frederick Chosson *CERFACS*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/07/07
-!! S.Berthet 19/03/08 Extension a une population multimodale d aerosols
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: NPTS
-REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
-REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
-REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
-!
-!* 0.2 declarations of local variables
-!
-REAL :: ZHYPF
-!
-REAL :: PZVEC1
-INTEGER :: PIVEC1
-!
-ALLOCATE(PFUNCSMAX(NPTS))
-!
-PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
-PIVEC1 = INT( PZVEC1 )
-PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
-DO JMOD = 1, NMOD_CCN
- ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
- ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
- - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
- ! sum of s**(ki+2) * F32 * Ci * ki * beta(ki/2,3/2)
- PFUNCSMAX(:) = PFUNCSMAX(:) + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
- * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(:,JMOD) &
- * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
- / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
-ENDDO
-! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PFUNCSMAX(:) = PFUNCSMAX(:) - PPZZW3(:)
-!
-END FUNCTION FUNCSMAX
-!
-!------------------------------------------------------------------------------
-!
- FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,KINDEX) RESULT(PSINGL_FUNCSMAX)
-!
-!
-!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
-!!
-!!
-!! PURPOSE
-!! -------
-! As for FUNCSMAX but for a scalar
-!!
-!!** METHOD
-!! ------
-!! This function is called by zriddr.f90
-!!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments and result
-!
-INTEGER, INTENT(IN) :: KINDEX
-REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
-REAL, INTENT(IN) :: PPZZW3 !
-REAL :: PSINGL_FUNCSMAX !
-!
-!* 0.2 declarations of local variables
-!
-REAL :: ZHYPF
-!
-REAL :: PZVEC1
-INTEGER :: PIVEC1
-!
-PSINGL_FUNCSMAX = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
- XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
-PIVEC1 = INT( PZVEC1 )
-PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
-DO JMOD = 1, NMOD_CCN
- ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
- ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
- - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
- ! sum of s**(ki+2) * F32 * Ci * ki * bêta(ki/2,3/2)
- PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
- * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(KINDEX,JMOD) &
- * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
- / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
-ENDDO
-! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PSINGL_FUNCSMAX = PSINGL_FUNCSMAX - PPZZW3
-!
-END FUNCTION SINGL_FUNCSMAX
-!
-!-----------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_WARM_NUCL
diff --git a/src/arome/micro/lima_warm_sedimentation.F90 b/src/arome/micro/lima_warm_sedimentation.F90
deleted file mode 100644
index 28a8fde5d75af1c47968fb2dae03ac3cfc441871..0000000000000000000000000000000000000000
--- a/src/arome/micro/lima_warm_sedimentation.F90
+++ /dev/null
@@ -1,425 +0,0 @@
-! ###################################
- MODULE MODI_LIMA_WARM_SEDIMENTATION
-! ###################################
-!
-INTERFACE
- SUBROUTINE LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODREF, PPABST, ZT, &
- ZWLBDC, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PINPRC, PINPRR, PINPRR3D )
-!
-LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
- ! cloud droplet sedimentation
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! for sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
-!
-END SUBROUTINE LIMA_WARM_SEDIMENTATION
-END INTERFACE
-END MODULE MODI_LIMA_WARM_SEDIMENTATION
-! #####################################################################
- SUBROUTINE LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
- HFMFILE, HLUOUT, OCLOSE_OUT, &
- PZZ, PRHODREF, PPABST, ZT, &
- ZWLBDC, &
- PRCT, PRRT, PCCT, PCRT, &
- PRCS, PRRS, PCCS, PCRS, &
- PINPRC, PINPRR, PINPRR3D )
-! #####################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation
-!! of cloud droplets and rain drops
-!!
-!!
-!!** METHOD
-!! ------
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAC, XNUC, XCEXVT
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR, &
- XFSEDRC, XFSEDCC, XFSEDRR, XFSEDCR,&
- XDC, XDR
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_GAMMA, ONLY : GAMMA_X0D
-!
-USE YOMLUN , ONLY : NULOUT
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
- ! cloud droplet sedimentation
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! for sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
-!
-!
-!* 0.2 Declarations of local variables :
-!
-! Packing variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GSEDIM
-INTEGER :: ISEDIM
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-! Packed micophysical variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
-!
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
-REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
-!
-! Other packed variables
-REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
-REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
-!
-! Work arrays
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, &
- ZWLBDA, & ! Mean free path
- ZRAY, & ! Mean volumic radius
- ZCC ! Terminal vertical velocity
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)+1) &
- :: ZWSEDR, ZWSEDC ! Sedim. fluxes
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
- ZTCC, &
- ZRTMIN, ZCTMIN
-!
-!
-INTEGER :: JK ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: IKMAX
-!
-!!!!!!!!!!! Entiers pour niveaux inversés dans AROME !!!!!!!!!!!!!!!!!!!!!!!!!!!
-INTEGER :: IBOTTOM, INVLVL
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Prepare computations
-! -----------------------
-!
-!
-ALLOCATE(ZRTMIN(SIZE(XCTMIN)))
-ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP
-ZCTMIN(:) = XCTMIN(:) / PTSTEP
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!!!!!!!!!!! Entiers pour niveaux inversés dans AROME !!!!!!!!!!!!!!!!!!!!!!!!!!!
-IBOTTOM=IKE
-INVLVL=-1
-!
-ZWSEDR(:,:,:)=0.
-ZWSEDC(:,:,:)=0.
-IKMAX=SIZE(PRHODREF,3)
-!
-ZTSPLITR= PTSTEP / FLOAT(KSPLITR)
-!
-PINPRC(:,:) = 0.
-PINPRR(:,:) = 0.
-PINPRR3D(:,:,:) = 0.
-!
-IF (OSEDC) THEN
- ZWLBDA(:,:,:) = 0.
- ZRAY(:,:,:) = 0.
- ZCC(:,:,:) = 1.
- DO JK=IKB,IKE
- ZWLBDA(:,:,JK) = 6.6E-8*(101325./PPABST(:,:,JK))*(ZT(:,:,JK)/293.15)
- END DO
- WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
- ZRAY(:,:,:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZWLBDC(:,:,:))
- ! ZCC : Corrective Cunningham term for the terminal velocity
- ZCC(:,:,:)=1.+1.26*ZWLBDA(:,:,:)/ZRAY(:,:,:)
- END WHERE
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-! 1. Computations only where necessary
-! ------------------------------------
-!
-!
-DO JN = 1 , KSPLITR
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) &
- .AND. PCRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(3)
- IF( OSEDC ) THEN
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
- (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) &
- .AND. PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
- END IF
-!
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
-!
- IF( JN==1 ) THEN
- IF( OSEDC ) THEN
- PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
- PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP
- END IF
- PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
- PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP
- DO JK = IKB , IKE
-!Dans AROME, PZZ = épaisseur de la couche
-! ZW(:,:,JK)=ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
- ZW(:,:,JK)=ZTSPLITR/(PZZ(:,:,JK))
- END DO
- END IF
-!
- ALLOCATE(ZRHODREF(ISEDIM))
- DO JL = 1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- END DO
-!
- ALLOCATE(ZZW1(ISEDIM))
- ALLOCATE(ZZW2(ISEDIM))
- ALLOCATE(ZZW3(ISEDIM))
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-! 2. Cloud droplets sedimentation
-! -------------------------------
-!
-!
- IF( OSEDC .AND. MAXVAL(PRCS(:,:,:))>ZRTMIN(2) ) THEN
- ZZW1(:) = 0.0
- ZZW2(:) = 0.0
- ZZW3(:) = 0.0
- ALLOCATE(ZRCS(ISEDIM))
- ALLOCATE(ZCCS(ISEDIM))
- ALLOCATE(ZRCT(ISEDIM))
- ALLOCATE(ZCCT(ISEDIM))
- ALLOCATE(ZTCC(ISEDIM))
- ALLOCATE(ZLBDC(ISEDIM))
- DO JL = 1,ISEDIM
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
- ZTCC(JL) = ZCC (I1(JL),I2(JL),I3(JL))
- END DO
- ZLBDC(:) = 1.E15
- WHERE (ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2))
- ZLBDC(:) = ( XLBC*ZCCT(:) / ZRCT(:) )**XLBEXC
- END WHERE
- WHERE( ZRCS(:)>ZRTMIN(2) )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDC(:)**(-XDC)
- ZZW1(:) = ZTCC(:) * XFSEDRC * ZRCS(:) * ZZW3(:) * ZRHODREF(:)
- ZZW2(:) = ZTCC(:) * XFSEDCC * ZCCS(:) * ZZW3(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,1:IKMAX) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- PCCS(:,:,JK) = PCCS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDC(:,:,JK+1*INVLVL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRCS(:,:,1) = PRCS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- PCCS(:,:,1) = PCCS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDC(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRCS)
- DEALLOCATE(ZCCS)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZCCT)
- DEALLOCATE(ZTCC)
- DEALLOCATE(ZLBDC)
-!
- PINPRC(:,:) = PINPRC(:,:) + ZWSEDR(:,:,IBOTTOM)/XRHOLW/KSPLITR ! in m/s
- ELSE
- ZWSEDR(:,:,IBOTTOM) = 0.0
- END IF ! OSEDC
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-! 2. Rain drops sedimentation
-! ---------------------------
-!
-!
- IF( MAXVAL(PRRS(:,:,:))>ZRTMIN(3) ) THEN
- ZZW1(:) = 0.0
- ZZW2(:) = 0.0
- ZZW3(:) = 0.0
- ALLOCATE(ZRRS(ISEDIM))
- ALLOCATE(ZCRS(ISEDIM))
- ALLOCATE(ZRRT(ISEDIM))
- ALLOCATE(ZCRT(ISEDIM))
- ALLOCATE(ZLBDR(ISEDIM))
- DO JL = 1,ISEDIM
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
- END DO
- ZLBDR(:) = 1.E10
- WHERE (ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3))
- ZLBDR(:) = ( XLBR*ZCRT(:) / ZRRT(:) )**XLBEXR
- END WHERE
- WHERE( ZRRS(:)>ZRTMIN(3) )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
- ZZW1(:) = XFSEDRR * ZRRS(:) * ZZW3(:) * ZRHODREF(:)
- ZZW2(:) = XFSEDCR * ZCRS(:) * ZZW3(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,1:IKMAX) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,1:IKMAX) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB+1 , IKE
- PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+1*INVLVL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
- PCRS(:,:,JK) = PCRS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDC(:,:,JK+1*INVLVL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
- END DO
- PRRS(:,:,1) = PRRS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDR(:,:,1))/PRHODREF(:,:,1)
- PCRS(:,:,1) = PCRS(:,:,1) + ZW(:,:,1)* &
- (0.-ZWSEDC(:,:,1))/PRHODREF(:,:,1)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZCRS)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZCRT)
- DEALLOCATE(ZLBDR)
- ELSE
- ZWSEDR(:,:,IBOTTOM) = 0.0
- END IF ! max PRRS > ZRTMIN(3)
-!
- PINPRR(:,:) = PINPRR(:,:) + ZWSEDR(:,:,IBOTTOM)/XRHOLW/KSPLITR ! in m/s
- PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSEDR(:,:,1:IKMAX)/XRHOLW/KSPLITR ! in m/s
-!
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- IF( JN==KSPLITR ) THEN
- IF( OSEDC ) THEN
- PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
- PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP
- END IF
- PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
- PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP
- END IF
- END IF ! ISEDIM
-END DO ! KSPLITR
-!
-!++cb++
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
-!--cb--
-
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_WARM_SEDIMENTATION
diff --git a/src/arome/micro/modd_lima_precip_scavengingn.F90 b/src/arome/micro/modd_lima_precip_scavengingn.F90
deleted file mode 100644
index a0866da9d6041ab3a6dedaef08223e9196d63d7a..0000000000000000000000000000000000000000
--- a/src/arome/micro/modd_lima_precip_scavengingn.F90
+++ /dev/null
@@ -1,59 +0,0 @@
-! ####################################
- MODULE MODD_LIMA_PRECIP_SCAVENGING_n
-! ####################################
-!
-!!**** *MODD_PRECIP_SCAVENGING$n* - declaration of scavenged aerosols
-!! precipitating fields
-!!
-!! PURPOSE
-!! -------
-! Stores the INstantaneous and ACcumulated PRecipitating fields of
-!! scavenged aerosol by rain
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY: JPMODELMAX
-!
-IMPLICIT NONE
-!
-TYPE LIMA_PRECIP_SCAVENGING_t
- REAL, DIMENSION(:,:), POINTER :: XINPAP=>NULL(), XACPAP=>NULL()
- ! Instant and cumul of ground
- ! precipitation fields of Scavenged
- ! Aerosol Particles
-END TYPE LIMA_PRECIP_SCAVENGING_t
-
-TYPE(LIMA_PRECIP_SCAVENGING_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PRECIP_SCAVENGING_MODEL
-
-REAL, DIMENSION(:,:), POINTER :: XINPAP=>NULL(), XACPAP=>NULL()
-
-CONTAINS
-
-SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL(KFROM, KTO)
- INTEGER, INTENT(IN) :: KFROM, KTO
- !
- ! Save current state for allocated arrays
- PRECIP_SCAVENGING_MODEL(KFROM)%XINPAP=>XINPAP
- PRECIP_SCAVENGING_MODEL(KFROM)%XACPAP=>XACPAP
- !
- ! Current model is set to model KTO
- XINPAP=>PRECIP_SCAVENGING_MODEL(KTO)%XINPAP
- XACPAP=>PRECIP_SCAVENGING_MODEL(KTO)%XACPAP
- !
-END SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL
-!
-!
-END MODULE MODD_LIMA_PRECIP_SCAVENGING_n
diff --git a/src/arome/micro/modd_param_lima.F90 b/src/arome/micro/modd_param_lima.F90
deleted file mode 100644
index bc29ea02e4bbe22e67b231f9afc9ae197b75cbb7..0000000000000000000000000000000000000000
--- a/src/arome/micro/modd_param_lima.F90
+++ /dev/null
@@ -1,185 +0,0 @@
-! ######################
- MODULE MODD_PARAM_LIMA
-! ######################
-!
-!!**** *MODD_PARAM_LIMA* - declaration of the control parameters
-!! for use in the LIMA scheme.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this declarative module is to declare the microphysical
-!! constants. This includes the descriptive parameters for the raindrop
-!! and the parameters relevant of the dimensional distributions.
-!!
-!!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX
-!
-IMPLICIT NONE
-!
-LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
-LOGICAL, SAVE :: LPTSPLIT ! time-splitting technique by S. Riette
-!
-!* 1. COLD SCHEME
-! -----------
-!
-! 1.1 Cold scheme configuration
-!
-LOGICAL, SAVE :: LCOLD_LIMA ! TRUE to enable the cold scheme
-LOGICAL, SAVE :: LNUCL_LIMA ! TRUE to enable ice nucleation
-LOGICAL, SAVE :: LSEDI_LIMA ! TRUE to enable pristine ice sedimentation
-LOGICAL, SAVE :: LHHONI_LIMA ! TRUE to enable freezing of haze particules
-LOGICAL, SAVE :: LSNOW_LIMA ! TRUE to enable snow and graupel
-LOGICAL, SAVE :: LHAIL_LIMA ! TRUE to enable hail
-LOGICAL, SAVE :: LMEYERS_LIMA ! TRUE to use Meyers nucleation
-!
-! 1.2 IFN initialisation
-!
-INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes
-REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L)
-LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations
-CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions
-CHARACTER(LEN=8), SAVE :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...)
-INTEGER, SAVE :: NMOD_IMM ! Number of CCN modes acting by immersion
-INTEGER, SAVE :: NIND_SPECIE ! CCN acting by immersion are considered pure
- ! IFN of either DM = 1, BC = 2 or O = 3
-INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NIMM ! Link between CCN and IMM modes
-INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NINDICE_CCN_IMM ! ??????????
-INTEGER, SAVE :: NSPECIE ! Internal mixing number of species
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_IFN ! Density of IFN modes
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XFRAC ! Composition of each IFN mode
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08
-!
-! 1.3 Ice characteristics
-!
-CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO
-CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL
-REAL,SAVE :: XALPHAI,XNUI ! Pristine ice distribution parameters
-REAL,SAVE :: XALPHAS,XNUS ! Snow/aggregate distribution parameters
-REAL,SAVE :: XALPHAG,XNUG ! Graupel distribution parameters
-!
-! 1.4 Phillips (2013) nucleation parameterization
-!
-INTEGER, SAVE :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13
-!
-REAL, DIMENSION(4), SAVE :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K]
-REAL, DIMENSION(4), SAVE :: XDT0 ! Range in T for transition of H_X near XT0 [K]
-REAL, DIMENSION(4), SAVE :: XDSI0 ! Range in Si for transition of H_X near XSI0
-REAL, SAVE :: XSW0 ! Threshold of Sw in H_X
-REAL, SAVE :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3]
-REAL, DIMENSION(4), SAVE :: XH ! Fraction<<1 of aerosol for X={DM,BC,O}
-REAL, DIMENSION(4), SAVE :: XAREA1 ! Total surface of all aerosols in group X with
- ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1]
-REAL, SAVE :: XGAMMA ! Factor boosting IN concentration due to
- ! bulk-liquid modes
-!
-REAL, DIMENSION(4), SAVE :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
-REAL, DIMENSION(4), SAVE :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
-!
-REAL,DIMENSION(:), SAVE, ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method
-INTEGER, SAVE :: NDIAM ! Gauss quadrature accuracy
-!
-! 1.5 Meyers (1992) nucleation parameterization
-!
-REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
- ! DEP refers to DEPosition mode
- ! CON refers to CONtact mode
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. WARM SCHEME
-! -----------
-!
-! 2.1 Warm scheme configuration
-!
-LOGICAL, SAVE :: LWARM_LIMA ! TRUE to enable the warm scheme
-LOGICAL, SAVE :: LACTI_LIMA ! TRUE to enable CCN activation
-LOGICAL, SAVE :: LRAIN_LIMA ! TRUE to enable the formation of rain
-LOGICAL, SAVE :: LSEDC_LIMA ! TRUE to enable the droplet sedimentation
-LOGICAL, SAVE :: LACTIT_LIMA ! TRUE to enable the usage of dT/dt in CCN activation
-!
-! 2.2 CCN initialisation
-!
-INTEGER, SAVE :: NMOD_CCN ! Number of CCN modes
-REAL, DIMENSION(JPLIMACCNMAX), SAVE :: XCCN_CONC ! CCN conc. (#/cm3)
-LOGICAL, SAVE :: LCCN_HOM ! True for z-homogeneous CCN concentrations
-CHARACTER(LEN=8),SAVE :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...)
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XR_MEAN_CCN ! Mean radius of CCN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLOGSIG_CCN ! Log of geometric dispersion of the CCN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_CCN ! Density of the CCN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XKHEN_MULTI ! Parameters defining the CCN activation
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMUHEN_MULTI ! spectra for a multimodal aerosol distribution
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XBETAHEN_MULTI ! spectra for a multimodal aerosol distribution
-REAL, DIMENSION(:,:,:) ,SAVE, ALLOCATABLE :: XCONC_CCN_TOT !* Total aerosol number concentration
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLIMIT_FACTOR !* compute CHEN ????????????
-!
-! 2.3 Water particles characteristics
-!
-REAL,SAVE :: XALPHAR,XNUR ! Raindrop distribution parameters
-REAL,SAVE :: XALPHAC,XNUC ! Cloud droplet distribution parameters
-!
-! 2.4 CCN activation
-!
-CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
-CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation
-CHARACTER(LEN=1), DIMENSION (JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
-REAL,SAVE :: XFSOLUB_CCN ! Fractionnal solubility of the CCN
-REAL,SAVE :: XACTEMP_CCN ! Expected temperature of CCN activation
-REAL,SAVE ::XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. BELOW CLOUD SCAVENGING
-! ----------------------
-!
-LOGICAL, SAVE :: LSCAV ! TRUE for aerosol scavenging by precipitations
-LOGICAL, SAVE :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate
-!
-INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method
-INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method
-!
-REAL, SAVE :: XT0SCAV = 293.15 ! [K]
-REAL, SAVE :: XTREF = 273.15 ! [K]
-REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4]
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 4. ATMOSPHERIC & OTHER PARAMETERS
-! ------------------------------
-!
-REAL, SAVE :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K
-REAL, SAVE :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air
-REAL, SAVE :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions
-!
-REAL, SAVE :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C
-! Correction
-!REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
-REAL, SAVE :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C
-!
-REAL,SAVE :: XCEXVT ! air density fall speed correction
-!
-REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios
-REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations
-!
-END MODULE MODD_PARAM_LIMA
diff --git a/src/arome/micro/modd_param_lima_cold.F90 b/src/arome/micro/modd_param_lima_cold.F90
deleted file mode 100644
index 2df3032ba305cac20467c695bd73119ccb42ad43..0000000000000000000000000000000000000000
--- a/src/arome/micro/modd_param_lima_cold.F90
+++ /dev/null
@@ -1,122 +0,0 @@
-! ###########################
- MODULE MODD_PARAM_LIMA_COLD
-! ###########################
-!
-!!**** *MODD_PARAM_LIMA_COLD* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
-!! the LIMA cold scheme.
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!* 1. DESCRIPTIVE PARAMETERS
-! ----------------------
-!
-! Declaration of microphysical constants, including the descriptive
-! parameters for the raindrop and the ice crystal habits, and the
-! parameters relevant of the dimensional distributions.
-!
-! m(D) = XAx * D**XBx : Mass-MaxDim relationship
-! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
-! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
-! XF0x, XF1x, XF2x : Ventilation factors
-! XC1x : Shape parameter for deposition
-!
-! and
-!
-! XALPHAx, XNUx : Generalized GAMMA law
-! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
-! distribution law
-!
-REAL,SAVE :: XLBEXI,XLBI ! Prist. ice distribution parameters
-REAL,SAVE :: XLBEXS,XLBS ! Snow/agg. distribution parameters
-!
-REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
-REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.)
-REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
-!
-REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape
- ! parameter of snow
-!
-CHARACTER(LEN=8),DIMENSION(5),PARAMETER &
- :: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', &
- 'CCNINIMM','CCCNNUCL'/)
- ! basenames of the SV articles stored
- ! in the binary files
- !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond)
- ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
- ! NI:Nuclei Immersed (activated IFN by Imm)
- ! HF:Homogeneous Freezing
-CHARACTER(LEN=3),DIMENSION(5),PARAMETER &
- :: CLIMA_COLD_CONC=(/'NI ','NIF','NIN','NNI','NNH'/)!for DIAG
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. MICROPHYSICAL FACTORS
-! ---------------------
-!
-REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation
- XFSEDS, XEXSEDS ! fluxes of ice and snow
-!
-REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous
- XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON
- XMNU0 ! mass of nucleated ice crystal
-!
-REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous
- XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI
- XCRITSAT1_HONH,XCRITSAT2_HONH, &
- XTMIN_HONH,XTMAX_HONH, &
- XDLNJODT1_HONH,XDLNJODT2_HONH, &
- XC1_HONH,XC2_HONH,XC3_HONH
-!
-REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous
- XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI
- XTEXP3_HONC,XTEXP4_HONC, &
- XTEXP5_HONC
-!
-REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, &
- XRHORSMIN, &
- XDSCNVI_LIM, XLBDASCNVI_LIM, & ! Constants for snow
- XC0DEPSI,XC1DEPSI, & ! sublimation conversion to
- XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI
-!
-REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron
- X0DEPI,X2DEPI, & ! Findeisen process and
- X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition
-!
-REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice
- XC0DEPIS,XC1DEPIS, & ! deposition conversion to
- XR0DEPIS,XR1DEPIS ! snow : ICNVS
-!
-REAL,SAVE :: XCOLEXIS, & ! Constants for snow
- XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG
- XAGGS_RLARGE1,XAGGS_RLARGE2
-!
-!??????????????????
-REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma)
-!
-REAL,SAVE :: XSELFI,XCOLEXII ! Constants for pristine ice
- ! self-collection (ini_ice_coma)
-!
-REAL,SAVE :: XAUTO3, XAUTO4, & ! Constants for pristine ice
- XLAUTS, XLAUTS_THRESHOLD, & ! autoconversion : AUT
- XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com)
- XTEXAUTI
-!
-REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
- ! ice concentration (init and grid-nesting)
-REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
-!
-!-------------------------------------------------------------------------------
-!
-END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/arome/micro/modd_param_lima_mixed.F90 b/src/arome/micro/modd_param_lima_mixed.F90
deleted file mode 100644
index f13accfc669e88fca83566c2eb72f5c2cc6f4945..0000000000000000000000000000000000000000
--- a/src/arome/micro/modd_param_lima_mixed.F90
+++ /dev/null
@@ -1,169 +0,0 @@
-! ############################
- MODULE MODD_PARAM_LIMA_MIXED
-! ###########################{
-!
-!!**** *MODD_PARAM_LIMA_MIXED* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
-!! the LIMA mixed scheme.
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!* 1. DESCRIPTIVE PARAMETERS
-! ----------------------
-!
-! Declaration of microphysical constants, including the descriptive
-! parameters for the raindrop and the ice crystal habits, and the
-! parameters relevant of the dimensional distributions.
-!
-! m(D) = XAx * D**XBx : Mass-MaxDim relationship
-! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
-! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
-! XF0x, XF1x, XF2x : Ventilation factors
-! XC1x : Shape parameter for deposition
-!
-! and
-!
-! XALPHAx, XNUx : Generalized GAMMA law
-! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
-! distribution law
-!
-REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
-REAL,SAVE :: XLBEXG,XLBG ! Graupel distribution parameters
-REAL,SAVE :: XLBDAG_MAX ! Max values allowed for the shape
- ! parameter of graupeln
-!
-REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
-REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. MICROPHYSICAL FACTORS - Graupel
-! -------------------------------
-!
-REAL,SAVE :: XFSEDG, XEXSEDG ! Sedimentation fluxes of Graupel
-!
-REAL,SAVE :: X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! Deposition on graupel
-!
-REAL,SAVE :: XHMTMIN,XHMTMAX,XHM1,XHM2, & ! Constants for the
- XHM_YIELD,XHM_COLLCS,XHM_FACTS, & ! revised
- XHM_COLLCG,XHM_FACTG, & ! Hallett-Mossop process
- XGAMINC_HMC_BOUND_MIN, & ! Min val. of Lbda_c for HMC
- XGAMINC_HMC_BOUND_MAX, & ! Max val. of Lbda_c for HMC
- XHMSINTP1,XHMSINTP2, & ! (this is no more used !)
- XHMLINTP1,XHMLINTP2
-!
-REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
- XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
- XEXCRIMSG,XCRIMSG, & !
- XEXSRIMCG,XSRIMCG, & !
- XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
- XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
- XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
- ! the tab. incomplete Gamma law
-INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
-REAL, DIMENSION(:), SAVE, ALLOCATABLE &
- :: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
- XGAMINC_RIM2, & ! for XDS+2 and for XBS
- XGAMINC_HMC ! and for the HM process
-!
-REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
- XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
- XFSACCRG, & ! ACC (processes RACCSS and
- XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
- XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
- XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
- XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
- XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
- XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
- XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
- ! XKER_RACCSS and XKER_SACCRG
- ! tables
-INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
- NACCLBDAR ! of Lbda_r values in the
- ! XKER_RACCSS and XKER_SACCRG
- ! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
- :: XKER_RACCSS, & ! Normalized kernel for RACCSS
- XKER_RACCS, & ! Normalized kernel for RACCS
- XKER_SACCRG ! Normalized kernel for SACCRG
-REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
- ! the aggregates
-!
-REAL,SAVE :: XCOLIR, & ! Constants for rain contact
- XEXRCFRI,XRCFRI, & ! freezing : CFR
- XEXICFRR,XICFRR !
-!
-REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
- XCOLCG, & ! of the graupeln :
- XCOLIG,XCOLEXIG,XFIDRYG, & !
- XCOLSG,XCOLEXSG,XFSDRYG, & ! RCDRYG
- XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
- XFRDRYG, & ! RSDRYG
- XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
- XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
- XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
- XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
- XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
- XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
- XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
- XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
- XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
- XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
- ! tables
-INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
- NDRYLBDAS, & ! of Lbda_s and
- NDRYLBDAG ! of Lbda_g values in
- ! the XKER_SDRYG and XKER_RDRYG
- ! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
- :: XKER_SDRYG, & ! Normalized kernel for SDRYG
- XKER_RDRYG ! Normalized kernel for RDRYG
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. MICROPHYSICAL FACTORS - Hail
-! ----------------------------
-!
-REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
-!
-!
-REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
-!
-REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
- XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
- XFGWETH, & ! processes RSWETH
- XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
- XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
- XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
- XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
- XWETLBDAG_MAX, & ! Max val. of Lbda_g for WET
- XWETLBDAH_MIN, & ! Min val. of Lbda_h for WET
- XWETLBDAH_MAX, & ! Max val. of Lbda_h for WET
- XWETINTP1S,XWETINTP2S, & ! Csts for bilin. interpol. of
- XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s and Lbda_g in
- XWETINTP1H,XWETINTP2H ! the XKER_SWETH and XKER_GWETH
- ! tables
-INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
- NWETLBDAG, & ! of Lbda_g and
- NWETLBDAH ! of Lbda_h values in
- ! the XKER_SWETH and XKER_GWETH
- ! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
- :: XKER_SWETH, & ! Normalized kernel for SWETH
- XKER_GWETH ! Normalized kernel for GWETH
-
-!
-!-------------------------------------------------------------------------------
-!
-END MODULE MODD_PARAM_LIMA_MIXED
diff --git a/src/arome/micro/modd_param_lima_warm.F90 b/src/arome/micro/modd_param_lima_warm.F90
deleted file mode 100644
index d0688aa72acecbfa45b0810043a36b5386ffe2cb..0000000000000000000000000000000000000000
--- a/src/arome/micro/modd_param_lima_warm.F90
+++ /dev/null
@@ -1,119 +0,0 @@
-! ###########################
- MODULE MODD_PARAM_LIMA_WARM
-! ###########################
-!
-!!**** *MODD_PARAM_LIMA_WARM* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
-!! the LIMA warm scheme.
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!* 1. DESCRIPTIVE PARAMETERS
-! ----------------------
-!
-REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
- XLBR, XLBEXR ! shape parameters of the raindrops
-!
-REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
- XCCR, & !For diagnostics
- XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
-!
-!
-CHARACTER(LEN=8),DIMENSION(4),PARAMETER &
- :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI'/)
- ! basenames of the SV articles stored
- ! in the binary files
-CHARACTER(LEN=5),DIMENSION(4),PARAMETER &
- :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN '/)
-! ! basenames of the SV articles stored
-! ! in the binary files for DIAG
-!
-!* Special issue for Below-Cloud SCAVenging of Aerosol particles
-CHARACTER(LEN=6),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. MICROPHYSICAL FACTORS
-! ---------------------
-!
-REAL,SAVE :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
- XFSEDRC,XFSEDCC ! fluxes of R, C
-!
-!
-REAL,SAVE :: XDIVA, & ! Diffusivity of water vapor
- XTHCO ! Thermal conductivity
-REAL,SAVE :: XWMIN ! Min value of updraft velocity
- ! to enable nucleation process
-REAL,SAVE :: XTMIN ! Min value of
- ! temperature evolution
- ! to enable nucleation process
-REAL,SAVE :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
-INTEGER, SAVE :: NHYP ! Number of value of the HYP
- ! functions
-REAL,SAVE :: XHYPINTP1, XHYPINTP2 ! Factors defining the
- ! supersaturation log scale
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & ! Tabulated HYPgeometric
- :: XHYPF12, XHYPF32 ! functions used in HEN
-INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
- ! functions
-REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
- ! temperatures in lin scale
-REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
- :: XAHENG,XPSI1, XPSI3, & ! Twomey-CPB98 and
- XAHENF,XAHENY ! Feingold-Heymsfield
- ! parameterization to compute Smax
-REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
- XWCOEF_Y1, XWCOEF_Y2, XWCOEF_Y3 ! COEF_Y of the polynomial temp.
- ! function powering W
-!
-!
-REAL,SAVE :: XKERA1, XKERA2 ! Constants to define the lin
- ! and parabolic kernel param.
-REAL,SAVE :: XSELFC ! Constants for cloud droplet
- ! selfcollection : SELF
-!
-REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
- XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
- XITAUTR, XITAUTR_THRESHOLD
-!
-REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
- XACCR4, XACCR5, XACCR6, & ! process
- XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
- XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
-!
-REAL,SAVE :: XSCBU2, XSCBU3, & ! Constants for the raindrop
- XSCBU_EFF1, XSCBU_EFF2, XSCBUEXP1 ! breakup-selfcollection: SCBU
-!
-REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
- XSPONCOEF2 ! (drop size limiter)
-!
-REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop
- XEX0EVAR, XEX1EVAR, XEX2EVAR ! evaporation: EVA
-!
-REAL,DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: XCONCC_INI
-REAL,SAVE :: XCONCR_PARAM_INI
- ! Used to initialize the
- ! concentrations from mixing ratios
- ! (init and grid-nesting from Kessler)
-!
-REAL,SAVE :: X0CNDC, X2CNDC ! Constants for cloud droplet
- ! condensation/evaporation
-REAL,SAVE :: XFREFFC ! Factor to compute the cloud droplet effective radius
-REAL,SAVE :: XFREFFR ! Factor to compute the rain drop effective radius
-REAL,SAVE :: XCREC, XCRER
- ! Factors to compute reff when cloud and rain are present
-!
-!-------------------------------------------------------------------------------
-!
-END MODULE MODD_PARAM_LIMA_WARM
diff --git a/src/arome/micro/set_conc_lima_lbc.F90 b/src/arome/micro/set_conc_lima_lbc.F90
new file mode 100644
index 0000000000000000000000000000000000000000..99fe74a52891aac1083ddd1a271c9db67ae87049
--- /dev/null
+++ b/src/arome/micro/set_conc_lima_lbc.F90
@@ -0,0 +1,226 @@
+!MNH_LIC Copyright 2000-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_set_conc_lima_lbc
+!#######################################
+
+implicit none
+
+contains
+
+! ###########################################################################
+ SUBROUTINE SET_CONC_LIMA_LBC( kmi, HGETCLOUD, PRHODREF, PRT, PSVT )
+! ###########################################################################
+!
+!!**** *SET_CONC_LIMA * - initialize droplet, raindrop and ice
+!! concentration for a RESTArt simulation of the LIMA scheme
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize cloud droplet and rain drop
+!! concentrations when the cloud droplet and rain drop mixing ratios are
+!! only available (generally from a previous run using the Kessler scheme).
+!! This routine is used to initialize the droplet/drop concentrations
+!! using the r_c and r_r of a previous REVE or KESS run but also to compute
+!! the LB tendencies in ONE_WAY$n in case of grid-nesting when the optional
+!! argument PTIME is set (a LIMA run embedded in a KESS or REVE run).
+!!
+!!** METHOD
+!! ------
+!! The method assumes a Csk law for the activation of aerososl with "s"
+!! the supersaturation (here 0.05 % is chosen). A Marshall-Palmer law with
+!! N_o=10**(-7) m**(-4) is assumed for the rain drop concentration.
+!! The initialization of the PSVT is straightforward for the cloud droplets
+!! while N_r=N_0/Lambda_r with Rho*r_r=Pi*Rho_w*N_0/(Lambda_r**4) is used for
+!! the rain drops. The HGETCLOUD test is used to discriminate between the
+!! 'REVE' and 'KESS' options for CCLOUD in the previous run (from which
+!! PRT was calculated).
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
+!! Module MODD_RAIN_C2R2_KHKO_PARAM, ONLY : XCONCC_INI, XCONCR_PARAM_INI
+!! Module MODD_CONF, ONLY : NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine SET_CONC_RAIN_C2R2 )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! P. Jabouille * CNRM/GMME *
+!! B. Vié * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/11/00
+!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM *
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! B. Vié 03/03/2020: secure physical tests
+! P. Wautelet 04/06/2020: correct array start for microphys. concentrations + add kmi dummy argument
+! (this subroutine is also called for other models)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_CCN, NMOD_IFN, &
+ NMOM_C, NMOM_R, NMOM_I
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI, XAS, XBS
+USE MODD_PARAM_LIMA_MIXED,ONLY : XAG, XBG, XAH, XBH
+USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_CCN_ACTI_A, &
+ NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, NSV_LIMA_IFN_NUCL_A
+USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
+USE MODD_CONF, ONLY : NVERB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+integer, intent(in) :: kmi ! Model number
+CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG_A(kmi):), INTENT(INOUT):: PSVT ! microphys. concentrations
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZCONC
+!
+!-------------------------------------------------------------------------------
+!* 1. RETRIEVE LOGICAL UNIT NUMBER
+! ----------------------------
+!
+!
+!* 2. INITIALIZATION
+! --------------
+!
+IF (NMOM_C.GE.2) THEN
+!
+! droplets
+!
+ ZCONC = 300.E6 ! droplet concentration set at 300 cm-3
+ WHERE ( PRT(:,:,:,2) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NC_A(kmi))<1.E-11)
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = ZCONC
+ END WHERE
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NC_A(kmi))<1.E-11)
+ PRT(:,:,:,2) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = 0.0
+ END WHERE
+
+ IF (NMOD_CCN .GE. 1) THEN
+ WHERE ( PRT(:,:,:,2) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NC_A(kmi))<1.E-11)
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = ZCONC
+ END WHERE
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NC_A(kmi))<1.E-11)
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = 0.0
+ END WHERE
+ END IF
+
+END IF
+!
+IF (NMOM_R.GE.2) THEN
+!
+! drops
+!
+ ZCONC = (1.E7)**3/(XPI*XRHOLW) ! cf XCONCR_PARAM_INI in ini_rain_c2r2.f90
+ IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ ELSE ! init from KESS, ICE3...
+ WHERE ( PRT(:,:,:,3) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NR_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
+ *ZCONC)),1. )
+ END WHERE
+ WHERE ( PRT(:,:,:,3) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NR_A(kmi))<1.E-11 )
+ PRT(:,:,:,3) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
+ END WHERE
+ END IF
+END IF
+!
+IF (NMOM_I.GE.2) THEN
+!
+! ice crystals
+!
+ ZCONC = 100.E3 ! maximum ice concentration set at 100/L
+ WHERE ( PRT(:,:,:,4) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NI_A(kmi))<1.E-11 )
+!
+! PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN( PRHODREF(:,:,:) / &
+! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
+! ZCONC )
+! Correction
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONC )
+ END WHERE
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NI_A(kmi))<1.E-11 )
+ PRT(:,:,:,4) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = 0.0
+ END WHERE
+
+ IF (NMOD_IFN .GE. 1) THEN
+ WHERE ( PRT(:,:,:,4) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NI_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = PSVT(:,:,:,NSV_LIMA_NI_A(kmi))
+ END WHERE
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NI_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = 0.0
+ END WHERE
+ END IF
+
+END IF
+!
+IF (NSV_LIMA_NS_A(KMI).GE.1) THEN
+!
+! snow
+!
+ ZCONC = 1./ (XAS*0.001**XBS) ! 1mm particle size
+ WHERE ( PRT(:,:,:,5) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NS_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NS_A(KMI)) = PRT(:,:,:,5) * ZCONC
+ END WHERE
+ WHERE ( PRT(:,:,:,5) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NS_A(kmi))<1.E-11 )
+ PRT(:,:,:,5) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NS_A(KMI)) = 0.0
+ END WHERE
+END IF
+!
+IF (NSV_LIMA_NG_A(KMI).GE.1) THEN
+!
+! graupel
+!
+ ZCONC = 1./ (XAG*0.001**XBG) ! 1mm particle size
+ WHERE ( PRT(:,:,:,6) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NG_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NG_A(KMI)) = PRT(:,:,:,6) * ZCONC
+ END WHERE
+ WHERE ( PRT(:,:,:,6) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NG_A(kmi))<1.E-11 )
+ PRT(:,:,:,6) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NG_A(KMI)) = 0.0
+ END WHERE
+END IF
+!
+IF (NSV_LIMA_NH_A(KMI).GE.1) THEN
+!
+! hail
+!
+ ZCONC = 1./ (XAH*0.001**XBH) ! 1mm particle size
+ WHERE ( PRT(:,:,:,7) > 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NH_A(kmi))<1.E-11 )
+ PSVT(:,:,:,NSV_LIMA_NH_A(KMI)) = PRT(:,:,:,7) * ZCONC
+ END WHERE
+ WHERE ( PRT(:,:,:,7) <= 1.E-11 .AND. PSVT(:,:,:,NSV_LIMA_NH_A(kmi))<1.E-11 )
+ PRT(:,:,:,7) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NH_A(KMI)) = 0.0
+ END WHERE
+END IF
+!
+END SUBROUTINE SET_CONC_LIMA_LBC
+
+end module mode_set_conc_lima_lbc
diff --git a/src/common/aux/modd_nsv.f90 b/src/common/aux/modd_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9cfa343c413e3b78171c89590cf04432585986fc
--- /dev/null
+++ b/src/common/aux/modd_nsv.f90
@@ -0,0 +1,282 @@
+!MNH_LIC Copyright 2001-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 MODD_NSV
+! ###############
+!
+!!**** *MODD_NSV* - declaration of scalar variables numbers
+!!
+!! PURPOSE
+!! -------
+!! Arrays to store the per-model NSV_* values number (suffix _A denote an array)
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen L.A.
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! J.-P. Pinty 29/11/02 add C3R5, ELEC
+!! V. Masson 01/2004 add scalar names
+!! M. Leriche 12/04/07 add aqueous chemistry
+!! M. Leriche 08/07/10 add ice phase chemistry
+!! C.Lac 07/11 add conditional sampling
+!! Pialat/Tulet 15/02/12 add ForeFire
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! V. Vionnet 07/17 add blowing snow
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: add TSVLIST and TSVLIST_A to store the metadata of all the scalar variables
+! A. Costes 12/2021: add Blaze fire model smoke
+! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
+! + NSV_CHEM_LIST(_A) the size of the list
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_FIELD, ONLY: tfieldmetadata
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX, & ! Maximum length of a scalar variable name
+ NMNHNAMELGTMAX
+!
+IMPLICIT NONE
+SAVE
+!
+REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
+!
+LOGICAL :: LINI_NSV(JPMODELMAX) = .FALSE. ! becomes True when routine INI_NSV is called
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSV_CHEM_LIST_A !Names of all the chemical variables
+TYPE(tfieldmetadata), DIMENSION(:,:), ALLOCATABLE, TARGET :: TSVLIST_A !Metadata of all the scalar variables
+
+INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
+ ! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_LIST_A = 0 ! total number of chemical variables (including dust, salt...)
+INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
+ ! indices in the range : 1...NSV_USER_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2_A = 0 ! number of liq scalar in C2R2
+ ! and in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2END_A = 0 ! NSV_C2R2BEG_A...NSV_C2R2END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3_A = 0 ! number of ice scalar in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3END_A = 0 ! NSV_C1R3BEG_A...NSV_C1R3END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELEC_A = 0 ! number of scalar in ELEC
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECEND_A = 0 ! NSV_ELECBEG_A...NSV_ELECEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_A = 0 ! number of chemical scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMEND_A = 0 ! NSV_CHEMBEG_A...NSV_CHEMEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGS_A = 0 ! number of gaseous chemcial species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSEND_A = 0 ! NSV_CHGSBEG_
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHAC_A = 0 ! number of aqueous chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACEND_A = 0 ! NSV_CHACBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHIC_A = 0 ! number of ice phase chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICEND_A = 0 ! NSV_CHICBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LG_A = 0 ! number of LaGrangian
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGEND_A = 0 ! NSV_LGBEG_A...NSV_LGEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOX_A = 0 ! number of lightning NOx
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXEND_A = 0 ! NSV_LNOXBEG_A...NSV_LNOXEND_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DST_A = 0 ! number of dust scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTEND_A = 0 ! NSV_DSTBEG_A...NSV_DSTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLT_A = 0 ! number of sea salt scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AER_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AEREND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PP_A = 0 ! number of passive pol.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPEND_A = 0 ! NSV_PPBEG_A...NSV_PPEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CS_A = 0 ! number of condit.samplings
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSEND_A = 0 ! NSV_CSBEG_A...NSV_CSEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_A = 0 ! number of scalar in LIMA
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_END_A = 0 ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NC_A = 0 ! First Nc variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NR_A = 0 ! First Nr variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_FREE_A = 0 ! First Free CCN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_ACTI_A = 0 ! First Acti. CNN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SCAVMASS_A = 0 ! Scavenged mass variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NI_A = 0 ! First Ni var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NS_A = 0 ! First Ns var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NG_A = 0 ! First Ng var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NH_A = 0 ! First Nh var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
+!
+#ifdef MNH_FOREFIRE
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
+!
+#endif
+! Blaze smoke indexes
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIRE_A = 0 ! number of Blaze smoke scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREEND_A = 0 ! NSV_FIREBEG_A...NSV_FIREEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
+!
+!###############################################################################
+!
+! variables updated for the current model
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), POINTER :: CSV_CHEM_LIST !Names of all the chemical variables
+TYPE(tfieldmetadata), DIMENSION(:), POINTER :: TSVLIST !Metadata of all the scalar variables
+
+CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
+
+INTEGER :: NSV = 0 ! total number of user scalar variables
+!
+INTEGER :: NSV_CHEM_LIST = 0 ! total number of chemical variables (including dust, salt...)
+!
+INTEGER :: NSV_USER = 0 ! number of user scalar variables with indices
+ ! in the range : 1...NSV_USER
+INTEGER :: NSV_C2R2 = 0 ! number of liq scalar used in C2R2 and in C3R5
+INTEGER :: NSV_C2R2BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C2R2END = 0 ! NSV_C2R2BEG...NSV_C2R2END
+!
+INTEGER :: NSV_C1R3 = 0 ! number of ice scalar used in C3R5
+INTEGER :: NSV_C1R3BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C1R3END = 0 ! NSV_C1R3BEG...NSV_C1R3END
+!
+INTEGER :: NSV_ELEC = 0 ! number of scalar variables used in ELEC
+INTEGER :: NSV_ELECBEG = 0 ! with indices in the range :
+INTEGER :: NSV_ELECEND = 0 ! NSV_ELECBEG...NSV_ELECEND
+!
+INTEGER :: NSV_CHEM = 0 ! number of chemical scalar variables
+INTEGER :: NSV_CHEMBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHEMEND = 0 ! NSV_CHEMBEG...NSV_CHEMEND
+!
+INTEGER :: NSV_CHGS = 0 ! number of gas-phase chemicals
+INTEGER :: NSV_CHGSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHGSEND = 0 ! NSV_CHGSBEG...NSV_CHGSEND
+!
+INTEGER :: NSV_CHAC = 0 ! number of aqueous-phase chemicals
+INTEGER :: NSV_CHACBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHACEND = 0 ! NSV_CHACBEG...NSV_CHACEND
+!
+INTEGER :: NSV_CHIC = 0 ! number of ice-phase chemicals
+INTEGER :: NSV_CHICBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHICEND = 0 ! NSV_CHICBEG...NSV_CHICEND
+!
+INTEGER :: NSV_LG = 0 ! number of lagrangian
+INTEGER :: NSV_LGBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LGEND = 0 ! NSV_LGBEG...NSV_LGEND
+!
+INTEGER :: NSV_LNOX = 0 ! number of lightning NOx variables
+INTEGER :: NSV_LNOXBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LNOXEND = 0 ! NSV_LNOXBEG...NSV_LNOXEND
+!
+INTEGER :: NSV_DST = 0 ! number of dust scalar variables
+INTEGER :: NSV_DSTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTEND = 0 ! NSV_DSTBEG...NSV_DSTEND
+
+INTEGER :: NSV_SLT = 0 ! number of sea salt scalar variables
+INTEGER :: NSV_SLTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTEND = 0 ! NSV_SLTBEG...NSV_SLTEND
+
+INTEGER :: NSV_AER = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AEREND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_DSTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_DSTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_AERDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AERDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_SLTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_SLTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_PP = 0 ! number of passive pollutants
+INTEGER :: NSV_PPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_PPEND = 0 ! NSV_PPBEG...NSV_PPEND
+!
+INTEGER :: NSV_CS = 0 ! number of condit.samplings
+INTEGER :: NSV_CSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
+!
+INTEGER :: NSV_LIMA ! number of scalar in LIMA
+INTEGER :: NSV_LIMA_BEG ! with indices in the range :
+INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER :: NSV_LIMA_NC !
+INTEGER :: NSV_LIMA_NR !
+INTEGER :: NSV_LIMA_CCN_FREE !
+INTEGER :: NSV_LIMA_CCN_ACTI !
+INTEGER :: NSV_LIMA_SCAVMASS !
+INTEGER :: NSV_LIMA_NI !
+INTEGER :: NSV_LIMA_NS !
+INTEGER :: NSV_LIMA_NG !
+INTEGER :: NSV_LIMA_NH !
+INTEGER :: NSV_LIMA_IFN_FREE !
+INTEGER :: NSV_LIMA_IFN_NUCL !
+INTEGER :: NSV_LIMA_IMM_NUCL !
+INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
+!
+#ifdef MNH_FOREFIRE
+INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
+INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
+!
+#endif
+! Blaze smoke
+INTEGER :: NSV_FIRE = 0 ! number of Blaze smoke scalar variables
+INTEGER :: NSV_FIREBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FIREEND = 0 ! NSV_FIREBEG...NSV_FIREEND
+!
+INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
+INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
+!
+INTEGER :: NSV_CO2 = 0 ! index for CO2
+!
+END MODULE MODD_NSV
diff --git a/src/mesonh/micro/hypgeo.f90 b/src/common/micro/hypgeo.F90
similarity index 100%
rename from src/mesonh/micro/hypgeo.f90
rename to src/common/micro/hypgeo.F90
diff --git a/src/mesonh/micro/ini_lima.f90 b/src/common/micro/ini_lima.F90
similarity index 98%
rename from src/mesonh/micro/ini_lima.f90
rename to src/common/micro/ini_lima.F90
index 54c784e641111c8f83b00b5063f2006b38eb8569..6f4bdcd0015f42e8c770bac6981c0542eb09ee4a 100644
--- a/src/mesonh/micro/ini_lima.f90
+++ b/src/common/micro/ini_lima.F90
@@ -55,7 +55,7 @@ USE MODD_CST
USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAMETERS
-USE MODD_LUNIT, ONLY : TLUOUT0
+!USE MODD_LUNIT, ONLY : TLUOUT0
!
IMPLICIT NONE
!
@@ -88,7 +88,7 @@ INTEGER :: IRESP ! Return code of FM-routines
!
!
! Init output listing
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!
ZVTRMAX(2) = 0.3 ! Maximum cloud droplet fall speed
diff --git a/src/mesonh/micro/ini_lima_cold_mixed.f90 b/src/common/micro/ini_lima_cold_mixed.F90
similarity index 69%
rename from src/mesonh/micro/ini_lima_cold_mixed.f90
rename to src/common/micro/ini_lima_cold_mixed.F90
index 2e3d956a46102eb75e5707369aed815f7f9bb798..55303431f6c033e1ae31ab923f02f13b7570af5a 100644
--- a/src/mesonh/micro/ini_lima_cold_mixed.f90
+++ b/src/common/micro/ini_lima_cold_mixed.F90
@@ -51,32 +51,30 @@ END MODULE MODI_INI_LIMA_COLD_MIXED
! ------------
!
USE MODD_CST
-USE MODD_LUNIT, ONLY: TLUOUT0
+!USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
-USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1, XALPHA2, XBETA1, XBETA2, IMNU0=>XMNU0, XNU10, XNU20, &
- RAIN_ICE_PARAM_ASSOCIATE
USE MODD_REF
!
use mode_msg
!
-USE MODI_LIMA_FUNCTIONS
+USE MODE_LIMA_FUNCTIONS, ONLY: MOMG, GAUHER
USE MODI_GAMMA
USE MODI_GAMMA_INC
USE MODE_RRCOLSS, ONLY: RRCOLSS
USE MODE_RZCOLX, ONLY: RZCOLX
USE MODE_RSCOLRG, ONLY: RSCOLRG
-USE MODI_NRCOLSS
-USE MODI_NZCOLX
-USE MODI_NSCOLRG
-USE MODI_LIMA_READ_XKER_RACCS
-USE MODI_LIMA_READ_XKER_SDRYG
-USE MODI_LIMA_READ_XKER_RDRYG
-USE MODI_LIMA_READ_XKER_SWETH
-USE MODI_LIMA_READ_XKER_GWETH
+USE MODE_NRCOLSS, ONLY: NRCOLSS
+USE MODE_NZCOLX, ONLY: NZCOLX
+USE MODE_NSCOLRG, ONLY: NSCOLRG
+USE MODE_LIMA_READ_XKER_RACCS, ONLY: LIMA_READ_XKER_RACCS
+USE MODE_LIMA_READ_XKER_SDRYG, ONLY: LIMA_READ_XKER_SDRYG
+USE MODE_LIMA_READ_XKER_RDRYG, ONLY: LIMA_READ_XKER_RDRYG
+USE MODE_LIMA_READ_XKER_SWETH, ONLY: LIMA_READ_XKER_SWETH
+USE MODE_LIMA_READ_XKER_GWETH, ONLY: LIMA_READ_XKER_GWETH
!
IMPLICIT NONE
!
@@ -109,9 +107,9 @@ REAL :: ZESR, ZESS ! Mean efficiency of rain-aggregate collection, ag
REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
!
!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
- ! listing
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+! ! listing
REAL :: ZCONC_MAX ! Maximal concentration for snow
REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
!
@@ -150,13 +148,13 @@ REAL :: ZRHOIW ! ice density
!-------------------------------------------------------------------------------
!
!
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!
!* 1. CHARACTERISTICS OF THE SPECIES
! ------------------------------
!
-CALL RAIN_ICE_PARAM_ASSOCIATE()
+!CALL RAIN_ICE_PARAM_ASSOCIATE()
!
!* 1.2 Ice crystal characteristics
!
@@ -334,14 +332,14 @@ ELSE
XLBH = XAH * MOMG(XALPHAH,XNUH,XBH)
END IF
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
- WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
+!!$END IF
!
XLBDAS_MAX = 1.E7 ! (eq to r~1E-7kg/kg) (for non MP PSD, use conversion XTRANS_MP_GAMMAS)
XLBDAS_MIN = 1. ! (eq to r~0.18kg/kg) (for non MP PSD, use conversion XTRANS_MP_GAMMAS)
@@ -593,14 +591,14 @@ XEX_CON = -2.8
!
XMNU0 = 6.88E-13
!
-IF (LMEYERS) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
- XNUC_DEP,XEXSI_DEP,XEX_DEP
- WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
- XNUC_CON,XEXTT_CON,XEX_CON
- WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
-END IF
+!!$IF (LMEYERS) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
+!!$ XNUC_DEP,XEXSI_DEP,XEX_DEP
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
+!!$ XNUC_CON,XEXTT_CON,XEX_CON
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+!!$END IF
!
! *****************
!* 4.3 NUCLEATION for NMOM_I=1
@@ -614,7 +612,7 @@ XNU20 = 1000.*ZFACT_NUCL
XALPHA2 = 12.96
XBETA2 = 0.639
!
-IMNU0 = 6.88E-13
+!XMNU0 = 6.88E-13
!-------------------------------------------------------------------------------
!
!
@@ -655,16 +653,16 @@ ELSE
'/= 3. No algorithm developed for this case' )
END IF
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
- WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
- WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
+!!$ WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
+!!$END IF
!
!
!* 5.2 Constants for vapor deposition on ice
@@ -756,11 +754,11 @@ XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
!
XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+!!$END IF
!
XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
@@ -780,11 +778,11 @@ XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+!!$END IF
!
!-------------------------------------------------------------------------------
!
@@ -809,13 +807,13 @@ XEXSRIMCG= -XBS
XSRIMCG2 = XAG*MOMG(XALPHAS,XNUS,XBG)
XSRIMCG3 = 0.1
XEXSRIMCG2=XBG
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
-END IF
-!
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+!!$END IF
+!!$!
NGAMINC = 80
XGAMINC_BOUND_MIN = (1000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = (50000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
@@ -929,33 +927,33 @@ CALL NSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
ZESR, XCS, XDS, XFVELOS, XCR, XDR, &
XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
ZFDINFTY, XKER_N_SACCRG,XAG, XBS, XAS )
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCSS) ) THEN")')
-DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCSS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RACCSS(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCS) ) THEN")')
-DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RACCS(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("!")')
-WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SACCRG) ) THEN")')
-DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SACCRG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SACCRG(J1,J2)
- END DO
-END DO
-WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCSS) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCSS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RACCSS(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RACCS) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RACCS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RACCS(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SACCRG) ) THEN")')
+!!$DO J1 = 1 , NACCLBDAR
+!!$ DO J2 = 1 , NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SACCRG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SACCRG(J1,J2)
+!!$ END DO
+!!$END DO
+!!$WRITE(UNIT=ILUOUT0,FMT='("!")')
!
CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
@@ -982,71 +980,71 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, &
XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
- XACCLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
- XACCLBDAR_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
- XACCLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
- XACCLBDAR_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCSS(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RACCS (J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
- DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SACCRG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
+!!$ XACCLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
+!!$ XACCLBDAR_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
+!!$ XACCLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
+!!$ XACCLBDAR_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RACCSS(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAS
+!!$ DO J2 = 1 , NACCLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RACCS (J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+!!$ DO J1 = 1 , NACCLBDAR
+!!$ DO J2 = 1 , NACCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SACCRG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
END IF
!
!* 7.2N Computations of the tabulated normalized kernels Snow Self Collection !!
@@ -1083,31 +1081,31 @@ XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
XSCLBDAS_MAX, XSCLBDAS_MAX, XSCLBDAS_MIN, XSCLBDAS_MIN, &
ZFDINFTY, XKER_N_SSCS )
!
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SSCS KERNELS ***")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KSCLBDAS=",I3)') NSCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PESS=",E13.6)') ZESS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MAX=",E13.6)') &
- XSCLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MIN=",E13.6)') &
- XSCLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SSCS ) ) THEN")')
- DO J1 = 1 , NSCLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SSCS (",I3,",",I3,") = ",E13.6)') &
- J1,J1,XKER_N_SSCS (J1,J1)
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SSCS KERNELS ***")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KSCLBDAS=",I3)') NSCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PESS=",E13.6)') ZESS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MAX=",E13.6)') &
+!!$ XSCLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PSCLBDAS_MIN=",E13.6)') &
+!!$ XSCLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SSCS ) ) THEN")')
+!!$ DO J1 = 1 , NSCLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SSCS (",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J1,XKER_N_SSCS (J1,J1)
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!
!* 7.2N2 Constants for the 'spontaneous' break-up
!
@@ -1123,11 +1121,11 @@ XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
!
XFSCVMG = 2.0
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
- WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+!!$END IF
!
!
!* 7.4 Constants for Ice-Ice collision process (CIBU)
@@ -1136,12 +1134,12 @@ XDCSLIM_CIBU_MIN = 2.0E-4 ! D_cs lim min
XDCSLIM_CIBU_MAX = 1.0E-3 ! D_cs lim max
XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX
- WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
+!!$END IF
!
NGAMINC = 80
!
@@ -1196,11 +1194,11 @@ XMOMGS_CIBU_3 = MOMG(XALPHAS,XNUS,XBS+XDS)
!
XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")')
- WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
+!!$END IF
!
NGAMINC = 80
!
@@ -1246,11 +1244,11 @@ XEXICFRR = -XDR-2.0
XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
*MOMG(XALPHAR,XNUR,XDR+2.0)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+!!$END IF
!
!
!* 8.2 Constants for the dry growth of the graupeln
@@ -1270,16 +1268,16 @@ XCOLIG = 0.25 ! Collection efficiency of I+G
XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
XCOLIG = 0.01 ! Collection efficiency of I+G
XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
-WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
-WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+!!$WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+!!$WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
XFIDRYG = (XPI/4.0)*XCOLIG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+!!$END IF
!
!* 8.2.3 Constants for the aggregate collection by the graupeln
!
@@ -1287,8 +1285,8 @@ XCOLSG = 0.25 ! Collection efficiency of S+G
XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
XCOLSG = 0.01 ! Collection efficiency of S+G
XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
-WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
-WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+!!$WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+!!$WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
XFSDRYG = XNS*(XPI/4.0)*XCOLSG*XAS*(ZRHO00**XCEXVT)
XFNSDRYG= (XPI/4.0)*XCOLSG*(ZRHO00**XCEXVT)
!
@@ -1299,12 +1297,12 @@ XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
- WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
- WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+!!$END IF
!
!* 8.2.4 Constants for the raindrop collection by the graupeln
!
@@ -1352,15 +1350,15 @@ ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
ZEGS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
ZFDINFTY, XKER_N_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
!
CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
@@ -1379,48 +1377,48 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
ZFDINFTY, XKER_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
- XDRYLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
- XDRYLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+!!$ XDRYLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+!!$ XDRYLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+!!$ XDRYLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+!!$ XDRYLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY,XKER_SDRYG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
END IF
!
!
@@ -1435,15 +1433,15 @@ ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
ZEGR, XCG, XDG, 0., XCR, XDR, 0., &
XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
ZFDINFTY, XKER_N_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_RDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_RDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_RDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_RDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
!
CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
@@ -1462,47 +1460,47 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., &
XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
ZFDINFTY, XKER_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
- WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
- WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
- WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
- WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
- XDRYLBDAR_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
- XDRYLBDAR_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
- WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_RDRYG(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+!!$ XDRYLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+!!$ XDRYLBDAR_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+!!$ XDRYLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+!!$ XDRYLBDAR_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+!!$ DO J1 = 1 , NDRYLBDAG
+!!$ DO J2 = 1 , NDRYLBDAR
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_RDRYG(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
PFDINFTY,XKER_RDRYG )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
END IF
!
!-------------------------------------------------------------------------------
@@ -1575,15 +1573,15 @@ ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
ZEHS, XCH, XDH, 0., XCS, XDS, XFVELOS, & !
XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & !
ZFDINFTY, XKER_N_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_SWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_SWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_SWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_SWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
!
@@ -1603,48 +1601,48 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
ZEHS, XBS, XCH, XDH, 0., XCS, XDS, XFVELOS, &
XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
ZFDINFTY, XKER_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
- WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
- WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
- WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
- WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
- WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
- WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
- XWETLBDAS_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
- XWETLBDAS_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
- WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_SWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFVELOS=",E13.6)') XFVELOS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+!!$ XWETLBDAH_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
+!!$ XWETLBDAS_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+!!$ XWETLBDAH_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
+!!$ XWETLBDAS_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAS
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_SWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY,XKER_SWETH )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
END IF
!
!
@@ -1658,15 +1656,15 @@ ZFDINFTY = 20.0
ZEHG, XCH, XDH, 0., XCG, XDG, 0., &
XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
ZFDINFTY, XKER_N_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_GWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_N_GWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_N_GWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PKER_N_GWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_N_GWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
!
@@ -1686,47 +1684,47 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., &
XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
ZFDINFTY, XKER_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
- WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
- WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
- WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
- WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
- WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
- WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
- WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
- WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
- WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
- WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
- XWETLBDAG_MAX
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
- XWETLBDAG_MIN
- WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
- WRITE(UNIT=ILUOUT0,FMT='("!")')
- WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
- WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
- J1,J2,XKER_GWETH(J1,J2)
- END DO
- END DO
- WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+!!$ XWETLBDAH_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
+!!$ XWETLBDAG_MAX
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+!!$ XWETLBDAH_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
+!!$ XWETLBDAG_MIN
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+!!$ DO J1 = 1 , NWETLBDAH
+!!$ DO J2 = 1 , NWETLBDAG
+!!$ WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+!!$ J1,J2,XKER_GWETH(J1,J2)
+!!$ END DO
+!!$ END DO
+!!$ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
ELSE
CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
PFDINFTY,XKER_GWETH )
- WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
END IF
!
!
@@ -1748,35 +1746,35 @@ XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
! -----------------------
!
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
- WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAI,XBI
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XC_I,XDI
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAI,XNUI
- WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAS,XBS
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCS,XDS
- WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCS,XCXS
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAS,XNUS
- WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAG,XBG
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCG,XDG
- WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
- XCCG,XCXG
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAG,XNUG
-END IF
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAI,XBI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XC_I,XDI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAI,XNUI
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAS,XBS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCS,XDS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+!!$ XCCS,XCXS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAS,XNUS
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAG,XBG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCG,XDG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+!!$ XCCG,XCXG
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAG,XNUG
+!!$END IF
!
!------------------------------------------------------------------------------
!
diff --git a/src/arome/micro/ini_lima_warm.F90 b/src/common/micro/ini_lima_warm.F90
similarity index 78%
rename from src/arome/micro/ini_lima_warm.F90
rename to src/common/micro/ini_lima_warm.F90
index e1fce381890992a8307515ccecc7873d8c3e0687..8ae14ed0fe38348f4a761530db6ec43c75b2238d 100644
--- a/src/arome/micro/ini_lima_warm.F90
+++ b/src/common/micro/ini_lima_warm.F90
@@ -1,11 +1,15 @@
+!MNH_LIC Copyright 2013-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_INI_LIMA_WARM
! #########################
!
INTERFACE
- SUBROUTINE INI_LIMA_WARM (KULOUT, PTSTEP, PDZMIN)
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
REAL, INTENT(IN) :: PTSTEP ! Effective Time step
REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
!
@@ -15,7 +19,7 @@ END INTERFACE
!
END MODULE MODI_INI_LIMA_WARM
! #########################################
- SUBROUTINE INI_LIMA_WARM (KULOUT, PTSTEP, PDZMIN)
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
! #########################################
!
!! PURPOSE
@@ -33,20 +37,22 @@ END MODULE MODI_INI_LIMA_WARM
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
-!!
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
-
+USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAMETERS
-USE MODD_LUNIT
+!USE MODD_LUNIT, ONLY : TLUOUT0
!
-USE MODI_LIMA_FUNCTIONS
+USE MODE_LIMA_FUNCTIONS, ONLY: MOMG
USE MODI_HYPGEO
USE MODI_GAMMA
!
@@ -54,7 +60,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KULOUT ! output logical unit number
REAL, INTENT(IN) :: PTSTEP ! Effective Time step
REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
!
@@ -80,8 +85,9 @@ REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
! discretize the HYP functions
!
!
-INTEGER :: IRESP ! Return code of FM-routines
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!INTEGER :: IRESP ! Return code of FM-routines
+!LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
! listing
!
!-------------------------------------------------------------------------------
@@ -156,8 +162,17 @@ ZGAMR(6) = MOMG(XALPHAR,XNUR,3.)**(2./3.)/MOMG(XALPHAR,XNUR,2.)
!
XLBC = XAR*ZGAMC(2)
XLBEXC = 1.0/XBC
-XLBR = XAR*ZGAMR(2)
-XLBEXR = 1.0/XBR
+!
+XNR = 1.0/(XAR*MOMG(XALPHAR,XNUR,XBR))
+XCCR = 8.E6
+XCXR = -1.
+IF (NMOM_R.EQ.1) THEN
+ XLBEXR = 1.0/(XCXR-XBR)
+ XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
+ELSE
+ XLBR = XAR*ZGAMR(2)
+ XLBEXR = 1.0/XBR
+END IF
!
!
!------------------------------------------------------------------------------
@@ -186,6 +201,17 @@ XFSEDCC = XCC*GAMMA_X0D(XNUC+XDC/XALPHAC)/GAMMA_X0D(XNUC)* &
(ZRHO00)**XCEXVT
!
+XLB(2) = XLBC
+XLBEX(2) = XLBEXC
+XD(2) = XDC
+XFSEDR(2) = XFSEDRC
+XFSEDC(2) = XFSEDCC
+!
+XLB(3) = XLBR
+XLBEX(3) = XLBEXR
+XD(3) = XDR
+XFSEDR(3) = XFSEDRR
+XFSEDC(3) = XFSEDCR
!
!------------------------------------------------------------------------------
!
@@ -228,12 +254,12 @@ ALLOCATE (XHYPF32( NHYP, NMOD_CCN ))
!
ZSMIN = 1.0E-5 ! Minimum supersaturation set at 0.001 %
ZSMAX = 5.0E-2 ! Maximum supersaturation set at 5 %
-XHYPINTP1 = FLOAT(NHYP-1)/LOG(ZSMAX/ZSMIN)
-XHYPINTP2 = FLOAT(NHYP)-XHYPINTP1*LOG(ZSMAX)
+XHYPINTP1 = REAL(NHYP-1)/LOG(ZSMAX/ZSMIN)
+XHYPINTP2 = REAL(NHYP)-XHYPINTP1*LOG(ZSMAX)
!
DO JMOD = 1,NMOD_CCN
DO J1 = 1,NHYP
- ZSS =ZSMAX*(ZSMIN/ZSMAX)**(FLOAT(NHYP-J1)/FLOAT(NHYP-1))
+ ZSS =ZSMAX*(ZSMIN/ZSMAX)**(REAL(NHYP-J1)/REAL(NHYP-1))
XHYPF12(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
0.5*XKHEN_MULTI(JMOD)+1.0,XBETAHEN_MULTI(JMOD),ZSS)
XHYPF32(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
@@ -243,7 +269,7 @@ ENDDO
!
NAHEN = 81 ! Tabulation for each Kelvin degree in the range XTT-40 to XTT+40
XAHENINTP1 = 1.0
-XAHENINTP2 = 0.5*FLOAT(NAHEN-1) - XTT
+XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
!
! Compute the tabulation of function of T :
!
@@ -260,11 +286,13 @@ XAHENINTP2 = 0.5*FLOAT(NAHEN-1) - XTT
! G
!
ALLOCATE (XAHENG(NAHEN))
+ALLOCATE (XAHENG2(NAHEN))
+ALLOCATE (XAHENG3(NAHEN))
ALLOCATE (XPSI1(NAHEN))
ALLOCATE (XPSI3(NAHEN))
XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
DO J1 = 1,NAHEN
- ZTT = XTT + FLOAT(J1-(NAHEN-1)/2) ! T
+ ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
XPSI1(J1) = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
XPSI3(J1) = -1*XMV*ZLV/(XMD*XRD*(ZTT**2)) ! Psi3
@@ -272,6 +300,8 @@ DO J1 = 1,NAHEN
(XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ (ZLV/ZTT)**2/(XTHCO*XRV) ) )
XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+ XAHENG2(J1) = 1/(ZG)**(1./2.) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
+ XAHENG3(J1) = (ZG) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
END DO
!-------------------------------------------------------------------------------
!
@@ -313,6 +343,7 @@ XLAUTR_THRESHOLD = 0.4
XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
XITAUTR_THRESHOLD = 7.5
XCAUTR = 3.5E9
+XR0 = 25.0E-6
!
! Cst for the accretion process
!
@@ -331,6 +362,11 @@ XACCR_CSMALL2 = XKERA1*ZGAMR(3)
XACCR_RSMALL1 = XKERA1*ZGAMC(5)*XRHOLW*(XPI/6.0)
XACCR_RSMALL2 = XKERA1*ZGAMC(2)*ZGAMR(3)*XRHOLW*(XPI/6.0)
!
+! ICE3 accretion of cloud droplets by rain drops
+!
+XFCACCR = (XPI/4.0)*XCCR*XCR*(ZRHO00**XCEXVT)*MOMG(XALPHAR,XNUR,XDR+2.0)
+XEXCACCR = -XDR-3.0
+!
! Cst for the raindrop self-collection/breakup process
!
XSCBU2 = XKERA2*ZGAMR(2)
@@ -384,6 +420,7 @@ X0EVAR = (12.0)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)
X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR+3./XALPHAR)
!
+XCEVAP = 0.86
!
!------------------------------------------------------------------------------
!
@@ -411,28 +448,29 @@ XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
! -----------------------
!
!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- WRITE(UNIT=KULOUT,FMT='(" Summary of the cloud particule characteristics")')
- WRITE(UNIT=KULOUT,FMT='(" CLOUD")')
- WRITE(UNIT=KULOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=KULOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCC,XDC
- WRITE(UNIT=KULOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAC,XNUC
- WRITE(UNIT=KULOUT,FMT='(" RAIN")')
- WRITE(UNIT=KULOUT,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=KULOUT,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCR,XDR
-!!$ WRITE(UNIT=KULOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$GFLAG = .TRUE.
+!!$IF (GFLAG) THEN
+!!$ ILUOUT0 = TLUOUT0%NLU
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAR,XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCC,XDC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAC,XNUC
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+!!$ XAR,XBR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+!!$ XCR,XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
!!$ XALPHAR,XNUR
-!!$ WRITE(UNIT=KULOUT,FMT='(" Description of the nucleation spectrum")')
-!!$ WRITE(UNIT=KULOUT,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
-!!$ WRITE(UNIT=KULOUT,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
-!!$ WRITE(UNIT=KULOUT,FMT='(" CCN max=",E13.6)') XCONC_CCN
-END IF
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
+!!$END IF
!
!------------------------------------------------------------------------------
!
diff --git a/src/mesonh/micro/init_aerosol_properties.f90 b/src/common/micro/init_aerosol_properties.F90
similarity index 92%
rename from src/mesonh/micro/init_aerosol_properties.f90
rename to src/common/micro/init_aerosol_properties.F90
index 52f7ddc882a89149d5f467797f07c70b1a9f5ba2..ecd30df7f7498c011657b3af21a40a14cc675103 100644
--- a/src/mesonh/micro/init_aerosol_properties.f90
+++ b/src/common/micro/init_aerosol_properties.F90
@@ -44,7 +44,7 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!* 0. DECLARATIONS
! ------------
!
-USE MODD_LUNIT, ONLY : TLUOUT0
+!USE MODD_LUNIT, ONLY : TLUOUT0
USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
@@ -52,12 +52,13 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
XACTEMP_CCN, XFSOLUB_CCN, &
NMOD_IFN, NSPECIE, CIFN_SPECIES, &
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
- CINT_MIXING, NPHILLIPS
+ CINT_MIXING, NPHILLIPS, &
+ NIMM, NMOD_IMM, NINDICE_CCN_IMM
!
use mode_msg
!
USE MODI_GAMMA
-USE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+USE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM, ONLY: LIMA_INIT_CCN_ACTIVATION_SPECTRUM
!
IMPLICIT NONE
!
@@ -84,8 +85,8 @@ REAL, DIMENSION(3) :: RHOCCN
!
INTEGER :: I,J,JMOD
!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
+!INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!INTEGER :: IRESP ! Return code of FM-routines
!
REAL :: X1, X2, X3, X4, X5
! REAL, DIMENSION(7) :: diameters=(/ 0.01E-6, 0.05E-6, 0.1E-6, 0.2E-6, 0.5E-6, 1.E-6, 2.E-6 /)
@@ -97,7 +98,7 @@ INTEGER :: II, IJ, IK
!
!-------------------------------------------------------------------------------
!
-ILUOUT0 = TLUOUT0%NLU
+!ILUOUT0 = TLUOUT0%NLU
!
!!!!!!!!!!!!!!!!
! CCN properties
@@ -183,13 +184,13 @@ IF ( NMOD_CCN .GE. 1 ) THEN
IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
!
IF (HINI_CCN == 'CCN') THEN
- IF (LSCAV) THEN
-! Attention !
- WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
- ¬ depending on the aerosol properties, however you need it for &
- &scavenging. &
- &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
- END IF
+!!$ IF (LSCAV) THEN
+!!$! Attention !
+!!$ WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
+!!$ ¬ depending on the aerosol properties, however you need it for &
+!!$ &scavenging. &
+!!$ &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
+!!$ END IF
! Numerical initialization without dependence on AP physical properties
DO JMOD = 1, NMOD_CCN
XKHEN_MULTI(JMOD) = XKHEN_TMP(JMOD)
@@ -431,6 +432,22 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC_REF(4)=0.06
END IF
!
+! Immersion modes
+!
+ IF (.NOT.(ALLOCATED(NIMM))) ALLOCATE(NIMM(NMOD_CCN))
+ NIMM(:)=0
+ IF (ALLOCATED(NINDICE_CCN_IMM)) DEALLOCATE(NINDICE_CCN_IMM)
+ ALLOCATE(NINDICE_CCN_IMM(MAX(1,NMOD_IMM)))
+ IF (NMOD_IMM .GE. 1) THEN
+ DO J = 0, NMOD_IMM-1
+ NIMM(NMOD_CCN-J)=1
+ NINDICE_CCN_IMM(NMOD_IMM-J) = NMOD_CCN-J
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS existe mais vaut 0, pour l'appel à resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+!
END IF ! NMOD_IFN > 0
!
END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/mesonh/micro/lima.f90 b/src/common/micro/lima.F90
similarity index 71%
rename from src/mesonh/micro/lima.f90
rename to src/common/micro/lima.F90
index 0ed11fe4885abca003bda12c21d85a861f293d43..c1d23e04f783deee4db97f278f061b20237e6838 100644
--- a/src/mesonh/micro/lima.f90
+++ b/src/common/micro/lima.F90
@@ -3,82 +3,17 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ######spl
-MODULE MODI_LIMA
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, only: NSV_LIMA_BEG
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-INTEGER, INTENT(IN) :: NCCN ! for array size declarations
-INTEGER, INTENT(IN) :: NIFN ! for array size declarations
-INTEGER, INTENT(IN) :: NIMM ! for array size declarations
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
-!
-END SUBROUTINE LIMA
-END INTERFACE
-END MODULE MODI_LIMA
-!
-!
-! ######spl
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
- PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR )
-! ######################################################################
+! #####################################################################
+SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+! #####################################################################
!
!! PURPOSE
!! -------
@@ -110,48 +45,44 @@ END MODULE MODI_LIMA
!
!* 0. DECLARATIONS
! ------------
-use modd_budget, only: lbu_enable, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
- lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
- NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
-USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+USE MODD_CST, ONLY: CST_t
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: NSV_LIMA_BEG, &
- NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
- NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+ NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE, &
+ NSV_LIMA_BEG
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
- LHAIL, LSNOW, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
-USE MODD_TURB_n, ONLY: LSUBG_COND
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+use mode_budget, only: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
use mode_tools, only: Countjv
-USE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
-USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
-USE MODI_LIMA_INST_PROCS
-USE MODI_LIMA_NUCLEATION_PROCS
-USE MODI_LIMA_SEDIMENTATION
-USE MODI_LIMA_TENDENCIES
+USE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS, ONLY: LIMA_COMPUTE_CLOUD_FRACTIONS
+USE MODE_LIMA_DROPS_TO_DROPLETS_CONV, ONLY: LIMA_DROPS_TO_DROPLETS_CONV
+USE MODE_LIMA_INST_PROCS, ONLY: LIMA_INST_PROCS
+USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
+USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
+USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -167,12 +98,12 @@ INTEGER, INTENT(IN) :: NIMM ! for array size declarati
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
@@ -186,6 +117,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
!* 0.2 Declarations of local variables :
!
@@ -340,7 +272,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCF1D, ZIF1D, ZPF1D
! Various parameters
! domain size and levels (AROME compatibility)
INTEGER :: KRR
-INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
! loops and packing
INTEGER :: II, IPACK, JI, JJ, JK
integer :: idx
@@ -355,26 +286,36 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condense
LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: GDEP
real, dimension(:,:,:), allocatable :: zrhodjontstep
!
+INTEGER :: ISV_LIMA_NC
+INTEGER :: ISV_LIMA_NR
+INTEGER :: ISV_LIMA_CCN_FREE
+INTEGER :: ISV_LIMA_CCN_ACTI
+INTEGER :: ISV_LIMA_NI
+INTEGER :: ISV_LIMA_NS
+INTEGER :: ISV_LIMA_NG
+INTEGER :: ISV_LIMA_NH
+INTEGER :: ISV_LIMA_IFN_FREE
+INTEGER :: ISV_LIMA_IFN_NUCL
+INTEGER :: ISV_LIMA_IMM_NUCL
+INTEGER :: ISV_LIMA_HOM_HAZE
+!
!-------------------------------------------------------------------------------
!
!* 0. Init
! ----
!
-!
-IIB=1+JPHEXT ! first physical point in i
-IIT=SIZE(PDZZ,1) ! total number of points in i
-IIE=IIT - JPHEXT ! last physical point in i
-!
-IJB=1+JPHEXT ! first physical point in j
-IJT=SIZE(PDZZ,2) ! total number of points in j
-IJE=IJT - JPHEXT ! last physical point in j
-!
-IKB=KKA+JPVEXT*KKL ! near ground physical point
-IKE=KKU-JPVEXT*KKL ! near TOA physical point
-IKT=SIZE(PDZZ,3) ! total number of points in k
-!
-IKTB=1+JPVEXT ! first index for a physical point in k
-IKTE=IKT-JPVEXT ! last index for a physical point in k
+ISV_LIMA_NC = NSV_LIMA_NC - NSV_LIMA_BEG + 1
+ISV_LIMA_NR = NSV_LIMA_NR - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_FREE = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI - NSV_LIMA_BEG + 1
+ISV_LIMA_NI = NSV_LIMA_NI - NSV_LIMA_BEG + 1
+ISV_LIMA_NS = NSV_LIMA_NS - NSV_LIMA_BEG + 1
+ISV_LIMA_NG = NSV_LIMA_NG - NSV_LIMA_BEG + 1
+ISV_LIMA_NH = NSV_LIMA_NH - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_HOM_HAZE = NSV_LIMA_HOM_HAZE - NSV_LIMA_BEG + 1
!
ZTHS(:,:,:) = PTHS(:,:,:)
ZTHT(:,:,:) = PTHS(:,:,:) * PTSTEP
@@ -418,7 +359,7 @@ ZIMMNS(:,:,:,:) = 0.
ZHOMFT(:,:,:) = 0.
ZHOMFS(:,:,:) = 0.
-if ( lbu_enable ) then
+if ( BUCONF%lbu_enable ) then
Z_RR_CVRC(:,:,:) = 0.
Z_CR_CVRC(:,:,:) = 0.
allocate( ZTOT_CR_BRKU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_BRKU(:,:,:) = 0.
@@ -569,62 +510,62 @@ IF ( KRR .GE. 7 ) ZRHS(:,:,:) = PRS(:,:,:,7)
! Concentrations
!
IF ( NMOM_C.GE.2) THEN
- ZCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC) * PTSTEP
- ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+ ZCCT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC) * PTSTEP
+ ZCCS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)
ELSE
ZCCT(:,:,:) = 300.E6 / PRHODREF(:,:,:)
ZCCS(:,:,:) = ZCCT(:,:,:) / PTSTEP
END IF
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2) ZCRT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR) * PTSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2) ZCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD .AND. NMOM_I.GE.2) ZCIT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI) * PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2) ZCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
-IF ( LCOLD .AND. LSNOW .AND. NMOM_S.GE.2) ZCST(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS) * PTSTEP
-IF ( LCOLD .AND. LSNOW .AND. NMOM_S.GE.2) ZCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
-IF ( LCOLD .AND. NMOM_G.GE.2) ZCGT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG) * PTSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2) ZCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
-IF ( LCOLD .AND. NMOM_H.GE.2) ZCHT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH) * PTSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2) ZCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
-!
-IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
-IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
-IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
-!
-IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
-IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
-IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
-!
-IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
-IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
-!
-IF ( LCOLD .AND. LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE) * PTSTEP
-IF ( LCOLD .AND. LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+IF ( NMOM_R.GE.2) ZCRT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NR) * PTSTEP
+IF ( NMOM_R.GE.2) ZCRS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NR)
+IF ( NMOM_I.GE.2) ZCIT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI) * PTSTEP
+IF ( NMOM_I.GE.2) ZCIS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI)
+IF ( NMOM_S.GE.2) ZCST(:,:,:) = PSVS(:,:,:,ISV_LIMA_NS) * PTSTEP
+IF ( NMOM_S.GE.2) ZCSS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NS)
+IF ( NMOM_G.GE.2) ZCGT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NG) * PTSTEP
+IF ( NMOM_G.GE.2) ZCGS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NG)
+IF ( NMOM_H.GE.2) ZCHT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NH) * PTSTEP
+IF ( NMOM_H.GE.2) ZCHS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NH)
+!
+IF ( NMOD_CCN .GE. 1 ) ZCCNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNAT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) * PTSTEP
+IF ( NMOD_CCN .GE. 1 ) ZCCNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)
+IF ( NMOD_CCN .GE. 1 ) ZCCNAS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)
+!
+IF ( NMOD_IFN .GE. 1 ) ZIFNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNNT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) * PTSTEP
+IF ( NMOD_IFN .GE. 1 ) ZIFNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1)
+IF ( NMOD_IFN .GE. 1 ) ZIFNNS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1)
+!
+IF ( NMOD_IMM .GE. 1 ) ZIMMNT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) * PTSTEP
+IF ( NMOD_IMM .GE. 1 ) ZIMMNS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1)
+!
+IF ( LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,ISV_LIMA_HOM_HAZE) * PTSTEP
+IF ( LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,ISV_LIMA_HOM_HAZE)
!
ZINV_TSTEP = 1./PTSTEP
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZEXN(:,:,:) = (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
!-------------------------------------------------------------------------------
!
!* 0. Check mean diameter for cloud, rain and ice
! --------------------------------------------
-! if ( lbu_enable ) then
-! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_sv ) then
+! if ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_rc .and. lwarm .and. lrain ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rr .and. lwarm .and. lrain ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_ri .and. lcold .and. lsnow ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rs .and. lcold .and. lsnow ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_sv ) then
! if ( lwarm .and. lrain .and. nmom_c.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
! if ( lwarm .and. lrain .and. nmom_r.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
! if ( lcold .and. lsnow .and. nmom_i.ge.2) &
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
! end if
! end if
-!!$IF (LWARM .AND. LRAIN) THEN
+!!$IF (NMOM_R.GE.2) THEN
!!$ WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
!!$ ZRRT=ZRRT+ZRCT
!!$ ZRRS=ZRRS+ZRCS
@@ -637,7 +578,7 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!!$!
-!!$IF (LWARM .AND. LRAIN) THEN
+!!$IF (NMOM_R.GE.2) THEN
!!$ WHERE( ZRRT>XRTMIN(3) .AND. ZCRT>XCTMIN(3) .AND. ZRRT<XAR*ZCRT*(60.E-6)**XBR )
!!$ ZRCT=ZRCT+ZRRT
!!$ ZRCS=ZRCS+ZRRS
@@ -650,7 +591,7 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!!$!
-!!$IF (LCOLD .AND. LSNOW) THEN
+!!$IF (NMOM_S.GE.2) THEN
!!$ WHERE( ZRIT>XRTMIN(4) .AND. ZCIT>XCTMIN(4) .AND. ZRIT>XAI*ZCIT*(250.E-6)**XBI )
!!$ ZRST=ZRST+ZRIT
!!$ ZRSS=ZRSS+ZRIS
@@ -661,18 +602,18 @@ ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!!$ END WHERE
!!$END IF
!
-! if ( lbu_enable ) then
-! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
-! if ( lbudget_sv ) then
+! if ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_rc .and. lwarm .and. lrain ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rr .and. lwarm .and. lrain ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_ri .and. lcold .and. lsnow ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_rs .and. lcold .and. lsnow ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( BUCONF%lbudget_sv ) then
! if ( lwarm .and. lrain .and. nmom_c.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
! if ( lwarm .and. lrain .and. nmom_r.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
! if ( lcold .and. lsnow .and. nmom_i.ge.2) &
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
! end if
! end if
!-------------------------------------------------------------------------------
@@ -688,102 +629,130 @@ PINPRI=0.
PINPRS=0.
PINPRG=0.
PINPRH=0.
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lsedc .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain .and. nmom_r.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsedi .and. nmom_i.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( lsedc .and. nmom_c.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi .and. nmom_i.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_s.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', zcss(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_g.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_h.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
end if
end if
-
+PFPR(:,:,:,:)=0.
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LWARM .AND. LSEDC) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_C.GE.1 .AND. LSEDC) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LWARM .AND. LRAIN) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'L', NMOM_R, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_R.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'L', NMOM_R, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSEDI) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_I, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_I.GE.1 .AND. LSEDI) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_I, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_S, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZCSS, PINPRS)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_S.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_S, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LSNOW) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_G, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZCGS, PINPRG)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_G.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_G, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
-ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (LCOLD .AND. LHAIL) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- 'I', NMOM_H, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZCHS, PINPRH)
+ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
+IF (NMOM_H.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
+ 'I', NMOM_H, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
!
ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lsedc .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain .and. nmom_r.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsedi .and. nmom_i.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( lsedc .and. nmom_c.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi .and. nmom_i.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_s.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', zcss(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_g.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_h.ge.2 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
end if
end if
!
! 1.bis Deposition at 1st level above ground
!
-IF (LWARM .AND. LDEPOC) THEN
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+IF (NMOM_C.GE.1 .AND. LDEPOC) THEN
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0 .AND. ZRCT(:,:,IKB) >0 .AND. ZCCT(:,:,IKB) >0
+ GDEP(:,:) = ZRCS(:,:,D%NKB) >0 .AND. ZCCS(:,:,D%NKB) >0 .AND. ZRCT(:,:,D%NKB) >0 .AND. ZCCT(:,:,D%NKB) >0
WHERE (GDEP)
- ZRCS(:,:,IKB) = ZRCS(:,:,IKB) - XVDEPOC * ZRCT(:,:,IKB) / PDZZ(:,:,IKB)
- ZCCS(:,:,IKB) = ZCCS(:,:,IKB) - XVDEPOC * ZCCT(:,:,IKB) / PDZZ(:,:,IKB)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- PINDEP(:,:) = XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ ZRCS(:,:,D%NKB) = ZRCS(:,:,D%NKB) - XVDEPOC * ZRCT(:,:,D%NKB) / PDZZ(:,:,D%NKB)
+ ZCCS(:,:,D%NKB) = ZCCS(:,:,D%NKB) - XVDEPOC * ZCCT(:,:,D%NKB) / PDZZ(:,:,D%NKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,D%NKB) * PRHODREF(:,:,D%NKB) /CST%XRHOLW
+ PINDEP(:,:) = XVDEPOC * ZRCT(:,:,D%NKB) * PRHODREF(:,:,D%NKB) /CST%XRHOLW
END WHERE
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!
-!!$IF (LWARM .AND. LRAIN) THEN
-!!$ if( lbu_enable ) then
-!!$ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_c.ge.2) &
-!!$ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_r.ge.2) &
-!!$ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+!!$Z_RR_CVRC(:,:,:) = 0.
+!!$Z_CR_CVRC(:,:,:) = 0.
+!!$IF (NMOM_R.GE.2) THEN
+!!$ if( BUCONF%lbu_enable ) then
+!!$ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_rr ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+!!$ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_r.ge.2) &
+!!$ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
!!$ end if
!!$
!!$ CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
@@ -794,13 +763,13 @@ END IF
!!$ ZCCS(:,:,:) = ZCCS(:,:,:) - Z_CR_CVRC(:,:,:)/PTSTEP
!!$ ZCRS(:,:,:) = ZCRS(:,:,:) + Z_CR_CVRC(:,:,:)/PTSTEP
!!$
-!!$ if( lbu_enable ) then
-!!$ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_c.ge.2) &
-!!$ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
-!!$ if ( lbudget_sv .and. nmom_r.ge.2) &
-!!$ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+!!$ if( BUCONF%lbu_enable ) then
+!!$ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_rr ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_c.ge.2) &
+!!$ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+!!$ if ( BUCONF%lbudget_sv .and. nmom_r.ge.2) &
+!!$ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
!!$ end if
!!$END IF
!
@@ -816,19 +785,19 @@ IF ( KRR .GE. 5 ) ZRST(:,:,:) = ZRSS(:,:,:) * PTSTEP
IF ( KRR .GE. 6 ) ZRGT(:,:,:) = ZRGS(:,:,:) * PTSTEP
IF ( KRR .GE. 7 ) ZRHT(:,:,:) = ZRHS(:,:,:) * PTSTEP
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2 ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_S.GE.2 ) ZCST(:,:,:) = ZCSS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2 ) ZCGT(:,:,:) = ZCGS(:,:,:) * PTSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2 ) ZCHT(:,:,:) = ZCHS(:,:,:) * PTSTEP
+IF ( NMOM_C.GE.2 ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
+IF ( NMOM_R.GE.2 ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
+IF ( NMOM_I.GE.2 ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
+IF ( NMOM_S.GE.2 ) ZCST(:,:,:) = ZCSS(:,:,:) * PTSTEP
+IF ( NMOM_G.GE.2 ) ZCGT(:,:,:) = ZCGS(:,:,:) * PTSTEP
+IF ( NMOM_H.GE.2 ) ZCHT(:,:,:) = ZCHS(:,:,:) * PTSTEP
!
!-------------------------------------------------------------------------------
!
!* 2. Compute cloud, ice and precipitation fractions
! ----------------------------------------------
!
-CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+CALL LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
ZCCT, ZRCT, &
ZCRT, ZRRT, &
ZCIT, ZRIT, &
@@ -842,9 +811,10 @@ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
!* 2. Nucleation processes
! --------------------
!
-CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+CALL LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, PRHODJ, &
PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
ZCCT, ZCRT, ZCIT, &
ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
PCLDFR, PICEFR, PPRCFR )
@@ -898,7 +868,7 @@ ZTIME(:,:,:)=0. ! Current integration time (all points may have a different inte
ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
WHERE (ZRT_SUM(:,:,:)<XRTMIN(2)) ZTIME(:,:,:)=PTSTEP ! no need to treat hydrometeor-free point
!
-DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
+DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
!
IF(XMRSTEP/=0.) THEN
! In this case we need to remember the mixing ratios used to compute the tendencies
@@ -919,7 +889,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
ENDIF
!
LLCOMPUTE(:,:,:)=.FALSE.
- LLCOMPUTE(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ LLCOMPUTE(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE) = ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
WHERE(LLCOMPUTE(:,:,:))
IITER(:,:,:)=IITER(:,:,:)+1
END WHERE
@@ -1233,13 +1203,13 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
! We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
!Is ZB_TH enough to change temperature sign?
- WHERE( ((ZTHT1D(:) - XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - XTT/ZEXN1D(:))) < 0. )
+ WHERE( ((ZTHT1D(:) - CST%XTT/ZEXN1D(:)) * (ZTHT1D(:) + ZB_TH(:) - CST%XTT/ZEXN1D(:))) < 0. )
ZMAXTIME(:)=0.
ENDWHERE
!Can ZA_TH make temperature change of sign?
ZTIME_THRESHOLD(:)=-1.
WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
+ ZTIME_THRESHOLD(:)=(CST%XTT/ZEXN1D(:) - ZB_TH(:) - ZTHT1D(:))/ZA_TH(:)
ENDWHERE
WHERE(ZTIME_THRESHOLD(:)>0.)
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
@@ -1455,7 +1425,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
!
!*** 4.4 Unpacking for budgets
!
- IF(LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE) THEN
ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
@@ -1803,248 +1773,248 @@ IF ( KRR .GE. 5 ) PRS(:,:,:,5) = ZRST(:,:,:) *ZINV_TSTEP
IF ( KRR .GE. 6 ) PRS(:,:,:,6) = ZRGT(:,:,:) *ZINV_TSTEP
IF ( KRR .GE. 7 ) PRS(:,:,:,7) = ZRHT(:,:,:) *ZINV_TSTEP
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = ZCCT(:,:,:) *ZINV_TSTEP
-IF ( LWARM .AND. LRAIN .AND. NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = ZCRT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = ZCIT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = ZCST(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = ZCGT(:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = ZCHT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,ISV_LIMA_NC) = ZCCT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,ISV_LIMA_NR) = ZCRT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,ISV_LIMA_NI) = ZCIT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_S.GE.2 ) PSVS(:,:,:,ISV_LIMA_NS) = ZCST(:,:,:) *ZINV_TSTEP
+IF ( NMOM_G.GE.2 ) PSVS(:,:,:,ISV_LIMA_NG) = ZCGT(:,:,:) *ZINV_TSTEP
+IF ( NMOM_H.GE.2 ) PSVS(:,:,:,ISV_LIMA_NH) = ZCHT(:,:,:) *ZINV_TSTEP
!
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
-IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
-IF ( LCOLD .AND. LHHONI) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TSTEP
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) = ZCCNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_CCN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZCCNAT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) = ZIFNFT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IFN .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) = ZIFNNT(:,:,:,:) *ZINV_TSTEP
+IF ( NMOD_IMM .GE. 1 ) PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) = ZIMMNT(:,:,:,:) *ZINV_TSTEP
+IF ( LHHONI) PSVS(:,:,:,ISV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TSTEP
!
!
!
! Call budgets
!
-if ( lbu_enable ) then
+if ( BUCONF%lbu_enable ) then
allocate( zrhodjontstep(size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
zrhodjontstep(:, :, :) = zinv_tstep * prhodj(:, :, :)
- if ( lbudget_th ) then
- call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPH', ztot_th_deph (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ztot_th_weth (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', ztot_th_hmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_th ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPH', ztot_th_deph (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', ztot_th_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', ztot_th_hmlt (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rv ) then
- call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPH', -ztot_rh_deph (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rv ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPH', -ztot_rh_deph (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rc ) then
- call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
- !call Budget_store_add( tbudgets(NBUDGET_RC), 'REVA', 0. )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', ztot_rc_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rc ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'REVA', 0. )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', ztot_rc_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rr ) then
- call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :)* zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', ztot_rr_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rr ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :)* zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', ztot_rr_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_ri ) then
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CIBU', ztot_ri_cibu (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'RDSF', ztot_ri_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', ztot_ri_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_ri ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CIBU', ztot_ri_cibu (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'RDSF', ztot_ri_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', ztot_ri_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rs ) then
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'CIBU', -ztot_ri_cibu(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', ztot_rs_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rs ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CIBU', -ztot_ri_cibu(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', ztot_rs_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rg ) then
- call Budget_store_add( tbudgets(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
+ if ( BUCONF%lbudget_rg ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
* zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'RDSF', -ztot_ri_rdsf(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', ztot_rg_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RG), 'COHG', ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RDSF', -ztot_ri_rdsf(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', ztot_rg_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'COHG', ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_rh ) then
- call Budget_store_add( tbudgets(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'DEPH', ztot_rh_deph(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ztot_rh_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'COHG', -ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ if ( BUCONF%lbudget_rh ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DEPH', ztot_rh_deph(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', ztot_rh_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'COHG', -ztot_rg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ztot_rr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
- if ( lbudget_sv ) then
+ if ( BUCONF%lbudget_sv ) then
!
! Cloud droplets
!
if (nmom_c.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nc
- call Budget_store_add( tbudgets(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
- !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
- call Budget_store_add( tbudgets(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cc_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'REVA', 0. )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cc_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Rain drops
!
if (nmom_r.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nr
- call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'REVA', ztot_cr_evap(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cr_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMLT', ztot_cr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'REVA', ztot_cr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cr_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMLT', ztot_cr_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Ice crystals
!
if (nmom_i.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ni
- call Budget_store_add( tbudgets(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CIBU', ztot_ci_cibu (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RDSF', ztot_ci_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_ci_weth (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CIBU', ztot_ci_cibu (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RDSF', ztot_ci_rdsf (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_ci_weth (:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Snow
!
if (nmom_s.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ns
- call Budget_store_add( tbudgets(idx), 'CNVI', -ztot_ci_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CNVS', -ztot_ci_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'RIM', ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CMEL', ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'SSC', ztot_cs_ssc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cs_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVI', -ztot_ci_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CNVS', -ztot_ci_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CMEL', ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'SSC', ztot_cs_ssc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'DRYG', ztot_cs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cs_weth(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Graupel
!
if (nmom_g.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_ng
- call Budget_store_add( tbudgets(idx), 'RIM', -ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'ACC', -ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CMEL', -ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'CFRZ', -ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETG', ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cg_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'WETH', ztot_cg_weth(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'COHG', ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'RIM', -ztot_cs_rim(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'ACC', -ztot_cs_acc(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CMEL', -ztot_cs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'CFRZ', -ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'GMLT', ztot_cg_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETH', ztot_cg_weth(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'COHG', ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
end if
!
! Hail
!
if (nmom_h.ge.2) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nh
- call Budget_store_add( tbudgets(idx), 'WETG', -ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'COHG', -ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
- call Budget_store_add( tbudgets(idx), 'HMLT', ztot_ch_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'WETG', -ztot_cg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'COHG', -ztot_cg_cohg(:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'HMLT', ztot_ch_hmlt(:, :, :) * zrhodjontstep(:, :, :) )
end if
do ii = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + ii - 1
- call Budget_store_add( tbudgets(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
end do
end if
diff --git a/src/mesonh/micro/lima_adjust_split.f90 b/src/common/micro/lima_adjust_split.F90
similarity index 65%
rename from src/mesonh/micro/lima_adjust_split.f90
rename to src/common/micro/lima_adjust_split.F90
index d0b3425d8f83bec8cf9010ace6fe2dfab4e71acd..f85bde85b19f4019847185e086d78cae47ad1762 100644
--- a/src/mesonh/micro/lima_adjust_split.f90
+++ b/src/common/micro/lima_adjust_split.F90
@@ -3,76 +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_LIMA_ADJUST_SPLIT
-! #############################
-!
-INTERFACE
-!
- SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
- OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
- PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF)
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, only: NSV_LIMA_BEG
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=80), INTENT(IN) :: HCONDENS
-CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Absolute Pressure at t+dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-!
-END SUBROUTINE LIMA_ADJUST_SPLIT
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_ADJUST_SPLIT
-!
! ###########################################################################
- SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ KRR, KMI, HCONDENS, HLAMBDA3, &
OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
@@ -152,15 +85,13 @@ END MODULE MODI_LIMA_ADJUST_SPLIT
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbu_enable, nbumod, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- tbudgets
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, &
+ NBUDGET_RC, NBUDGET_RI, NBUDGET_RV, NBUDGET_SV1, NBUMOD
+USE MODD_CST, ONLY: CST_t
USE MODD_CONF
-USE MODD_CST
-use modd_field, only: TFIELDMETADATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+!use modd_field, only: TFIELDDATA, TYPEREAL
+!USE MODD_IO, ONLY: TFILEDATA
+!USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
@@ -172,15 +103,13 @@ USE MODD_NEB, ONLY: NEB
USE MODD_TURB_n, ONLY: TURBN
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_budget, only: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_msg
use mode_tools, only: Countjv
!
-USE MODI_CONDENS
USE MODI_CONDENSATION
-USE MODI_LIMA_FUNCTIONS
-USE MODI_LIMA_CCN_ACTIVATION
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -188,9 +117,13 @@ IMPLICIT NONE
!
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=80), INTENT(IN) :: HCONDENS
CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
@@ -217,9 +150,9 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
!
@@ -244,6 +177,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
PRIT, & ! Cloud ice m.r. at t
PRST, & ! Aggregate m.r. at t
PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Hail m.r. at t
!
PRVS, & ! Water vapor m.r. source
PRCS, & ! Cloud water m.r. source
@@ -251,6 +185,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
PRIS, & ! Cloud ice m.r. source
PRSS, & ! Aggregate m.r. source
PRGS, & ! Graupel m.r. source
+ PRHS, & ! Hail m.r. source
!
PCCT, & ! Cloud water conc. at t
PCIT, & ! Cloud ice conc. at t
@@ -287,19 +222,19 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
ZRI, ZRI_IN, &
Z_SIGS, Z_SRCS, &
ZW_MF, &
- ZCND, ZS, ZVEC1,ZDUM
+ ZCND, ZS, ZVEC1, ZDUM
REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2)) :: ZSIGQSAT2D
!
INTEGER, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: IVEC1
!
-INTEGER :: IRESP ! Return code of FM routines
+!INTEGER :: IRESP ! Return code of FM routines
INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IKB ! K index value of the first inner mass point
INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
-INTEGER :: ILUOUT ! Logical unit of output listing
+!INTEGER :: ILUOUT ! Logical unit of output listing
!
INTEGER :: ISIZE
LOGICAL :: G_SIGMAS, GUSERI
@@ -310,26 +245,34 @@ integer :: idx
integer :: JI, JJ, JK, jl
INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
!
-TYPE(TFIELDMETADATA) :: TZFIELD
+!!$TYPE(TFIELDMETADATA) :: TZFIELD
+!
+INTEGER :: ISV_LIMA_NC
+INTEGER :: ISV_LIMA_CCN_FREE
+INTEGER :: ISV_LIMA_CCN_ACTI
+INTEGER :: ISV_LIMA_SCAVMASS
+INTEGER :: ISV_LIMA_NI
+INTEGER :: ISV_LIMA_IFN_FREE
+INTEGER :: ISV_LIMA_IFN_NUCL
+INTEGER :: ISV_LIMA_IMM_NUCL
!
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-ILUOUT = TLUOUT%NLU
+ISV_LIMA_NC = NSV_LIMA_NC - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_FREE = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI - NSV_LIMA_BEG + 1
+ISV_LIMA_SCAVMASS = NSV_LIMA_SCAVMASS - NSV_LIMA_BEG + 1
+ISV_LIMA_NI = NSV_LIMA_NI - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + 1
+ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
+ISV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL - NSV_LIMA_BEG + 1
!
-IIU = SIZE(PEXNREF,1)
-IJU = SIZE(PEXNREF,2)
-IKU = SIZE(PEXNREF,3)
-IIB = 1 + JPHEXT
-IIE = SIZE(PRHODJ,1) - JPHEXT
-IJB = 1 + JPHEXT
-IJE = SIZE(PRHODJ,2) - JPHEXT
-IKB = 1 + JPVEXT
-IKE = SIZE(PRHODJ,3) - JPVEXT
+!ILUOUT = TLUOUT%NLU
!
-ZEPS= XMV / XMD
+ZEPS= CST%XMV / CST%XMD
!
IF (OSUBG_COND) THEN
ITERMAX=1
@@ -363,6 +306,8 @@ PRST(:,:,:) = 0.
PRSS(:,:,:) = 0.
PRGT(:,:,:) = 0.
PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
!
IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRS(:,:,:,2)*PTSTEP
IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
@@ -374,6 +319,8 @@ IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
!
! Prepare 3D number concentrations
PCCT(:,:,:) = 0.
@@ -381,68 +328,68 @@ PCIT(:,:,:) = 0.
PCCS(:,:,:) = 0.
! PCIS(:,:,:) = 0.
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PCCT(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)*PTSTEP
-IF ( LCOLD .AND. NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)*PTSTEP
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,ISV_LIMA_NI)
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-! IF ( LCOLD .AND. NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NC)
+! IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,ISV_LIMA_NI)
!
-IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,ISV_LIMA_SCAVMASS)
!
-IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+IF ( NMOM_C.GE.1 .AND. NMOD_CCN.GE.1 ) THEN
ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNFT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
- PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
- PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
- PNFT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
- PNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
+ PNFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ PNFT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
+ PNAT(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
END IF
!
-! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! IF ( NMOM_I.GE.1 .AND. NMOD_IFN .GE. 1 ) THEN
! ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
! ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
-! PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
-! PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+! PIFS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1)
+! PINS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1)
! END IF
!
! IF ( NMOD_IMM .GE. 1 ) THEN
! ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
-! PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+! PNIS(:,:,:,:) = PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1)
! END IF
!
!
-if ( nbumod == kmi .and. lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+if ( nbumod == kmi .and. BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rv ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
!Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri ) call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( nmom_c.ge.2) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_c.ge.1 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
-! if ( lcold ) then
-! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! if ( nmom_i.ge.2 ) then
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
! do jl = 1, nmod_ifn
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
! end do
! do jl = 1, nmod_imm
! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
! end do
! end if
end if
@@ -457,11 +404,11 @@ end if
!* 2.1 remove negative non-precipitating negative water
! ------------------------------------------------
!
-IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
- WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
- WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
- WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
-END IF
+!IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+! WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+! WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+! WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+!END IF
!
WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
@@ -469,7 +416,7 @@ END WHERE
!
!* 2.2 estimate the Exner function at t+1
!
-ZEXNS(:,:,:) = ( PPABSTT(:,:,:) / XP00 ) ** (XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABSTT(:,:,:) / CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! beginning of the iterative loop
!
@@ -482,15 +429,15 @@ DO JITER =1,ITERMAX
!
!* 2.4 compute the specific heat for moist air (Cph) at t+1
!
- ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
- + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
- + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+ ZCPH(:,:,:) = CST%XCPD + CST%XCPV *ZDT* PRVS(:,:,:) &
+ + CST%XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + CST%XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) + PRHS(:,:,:) )
!
!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
! and of sublimation Ls(T*) at t+1
!
- ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
- ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ ZLV(:,:,:) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( ZT(:,:,:) -CST%XTT )
+ ZLS(:,:,:) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( ZT(:,:,:) -CST%XTT )
!
!
!-------------------------------------------------------------------------------
@@ -498,12 +445,10 @@ DO JITER =1,ITERMAX
!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
! ---------------------------------------
!
- ZRV=PRVS*PTSTEP
- ZRC=PRCS*PTSTEP
+ ZRV_IN=PRVS*PTSTEP
ZRV2=PRVT
+ ZRC_IN=PRCS*PTSTEP
ZRC2=PRCT
- ZRV_IN=ZRV
- ZRC_IN=ZRC
IF (NMOM_I.EQ.1) THEN
ZRI_IN=PRIS*PTSTEP
GUSERI=.TRUE.
@@ -533,7 +478,7 @@ DO JITER =1,ITERMAX
IF (OSUBG_COND .AND. NMOM_C.GE.2 .AND. LACTI) THEN
PSRCS=Z_SRCS
ZW_MF=0.
- CALL LIMA_CCN_ACTIVATION (TPFILE, &
+ CALL LIMA_CCN_ACTIVATION (CST, &
PRHODREF, PEXNREF, PPABST, ZT2, PDTHRAD, PW_NU+ZW_MF, &
PTHT, ZRV2, ZRC2, PCCT, PRRT, PNFT, PNAT, &
PCLDFR )
@@ -564,7 +509,7 @@ ELSE
ZVEC1(JI,JJ,JK) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZT(JI,JJ,JK) + XAHENINTP2 ) )
IVEC1(JI,JJ,JK) = INT( ZVEC1(JI,JJ,JK) )
ZVEC1(JI,JJ,JK) = ZVEC1(JI,JJ,JK) - FLOAT( IVEC1(JI,JJ,JK) )
- ZW(JI,JJ,JK)=EXP( XALPW - XBETAW/ZT(JI,JJ,JK) - XGAMW*ALOG(ZT(JI,JJ,JK) ) ) ! es_w
+ ZW(JI,JJ,JK)=EXP( CST%XALPW - CST%XBETAW/ZT(JI,JJ,JK) - CST%XGAMW*ALOG(ZT(JI,JJ,JK) ) ) ! es_w
ZW(JI,JJ,JK)=ZEPS*ZW(JI,JJ,JK) / ( PPABST(JI,JJ,JK)-ZW(JI,JJ,JK) )
ZS(JI,JJ,JK) = PRVS(JI,JJ,JK)*PTSTEP / ZW(JI,JJ,JK) - 1.
ZW(JI,JJ,JK) = PCCS(JI,JJ,JK)*PTSTEP/(XLBC*PCCS(JI,JJ,JK)/PRCS(JI,JJ,JK))**XLBEXC
@@ -652,7 +597,7 @@ IF (NMOM_C .GE. 2) THEN
END IF
!
ZW1(:,:,:) = 0.
-IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+IF (NMOM_C.GE.1 .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
ZW2(:,:,:) = 0.
WHERE ( ZW(:,:,:) > 0. )
@@ -660,7 +605,7 @@ WHERE ( ZW(:,:,:) > 0. )
ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
ENDWHERE
!
-IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+IF (NMOM_C.GE.1 .AND. NMOD_CCN.GE.1) THEN
DO JMOD = 1, NMOD_CCN
PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
@@ -681,20 +626,20 @@ ELSE
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
END IF
!
-IF ( tpfile%lopened ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'NEB', &
- CSTDNAME = '', &
- CLONGNAME = 'NEB', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_NEB', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ TZFIELD = TFIELDMETADATA( &
+!!$ CMNHNAME = 'NEB', &
+!!$ CSTDNAME = '', &
+!!$ CLONGNAME = 'NEB', &
+!!$ CUNITS = '1', &
+!!$ CDIR = 'XY', &
+!!$ CCOMMENT = 'X_Y_Z_NEB', &
+!!$ NGRID = 1, &
+!!$ NTYPE = TYPEREAL, &
+!!$ NDIMS = 3, &
+!!$ LTIMEDEP = .TRUE. )
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
+!!$END IF
!
!
!* 6. SAVE CHANGES IN PRS AND PSVS
@@ -707,83 +652,84 @@ IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM .AND. NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-! IF ( LCOLD .AND. NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,ISV_LIMA_NC) = PCCS(:,:,:)
+! IF ( NMOM_I.GE.2 ) PSVS(:,:,:,ISV_LIMA_NI) = PCIS(:,:,:)
!
-IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,ISV_LIMA_SCAVMASS) = PMAS(:,:,:)
!
-IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
- PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+IF ( NMOM_C.GE.1 .AND. NMOD_CCN.GE.1 ) THEN
+ PSVS(:,:,:,ISV_LIMA_CCN_FREE:ISV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,ISV_LIMA_CCN_ACTI:ISV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
END IF
!
-! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
-! PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
-! PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+! IF ( NMOM_I.GE.1 .AND. NMOD_IFN .GE. 1 ) THEN
+! PSVS(:,:,:,ISV_LIMA_IFN_FREE:ISV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+! PSVS(:,:,:,ISV_LIMA_IFN_NUCL:ISV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
! END IF
!
-! IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
-! PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+! IF ( NMOM_I.GE.1 .AND. NMOD_IMM .GE. 1 ) THEN
+! PSVS(:,:,:,ISV_LIMA_IMM_NUCL:ISV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
! END IF
!
! write SSI in LFI
!
-IF ( tpfile%lopened ) THEN
- ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
- ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
- ZW1(:,:,:)= PPABSTT(:,:,:)
- ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSI', &
- CSTDNAME = '', &
- CLONGNAME = 'SSI', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_SSI', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+!!$ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+!!$ ZW1(:,:,:)= PPABSTT(:,:,:)
+!!$ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+!!$
+!!$ TZFIELD = TFIELDMETADATA( &
+!!$ CMNHNAME = 'SSI', &
+!!$ CSTDNAME = '', &
+!!$ CLONGNAME = 'SSI', &
+!!$ CUNITS = '', &
+!!$ CDIR = 'XY', &
+!!$ CCOMMENT = 'X_Y_Z_SSI', &
+!!$ NGRID = 1, &
+!!$ NTYPE = TYPEREAL, &
+!!$ NDIMS = 3, &
+!!$ LTIMEDEP = .TRUE. )
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+!!$END IF
!
!
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-if ( nbumod == kmi .and. lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+if ( nbumod == kmi .and. BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rv ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri ) call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_sv ) then
+ if ( nmom_c.ge.2) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_c.ge.1 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
-! if ( lcold ) then
-! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! if ( nmom_i.ge.2 ) then
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
! do jl = 1, nmod_ifn
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
-! call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
-! call Budget_store_end( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
! end do
! do jl = 1, nmod_imm
! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
-! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
! end do
! end if
end if
diff --git a/src/arome/micro/lima_precip_scavenging.F90 b/src/common/micro/lima_precip_scavenging.F90
similarity index 85%
rename from src/arome/micro/lima_precip_scavenging.F90
rename to src/common/micro/lima_precip_scavenging.F90
index ad63b968348186447f7a3c7aaa39900ad8345810..acf263d021550e63a1d6f791bd9a0955b6630e4d 100644
--- a/src/arome/micro/lima_precip_scavenging.F90
+++ b/src/common/micro/lima_precip_scavenging.F90
@@ -1,48 +1,13 @@
-! ##################################
- MODULE MODI_LIMA_PRECIP_SCAVENGING
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
- PPABST, PTHT, PSVT, PRSVS, PINPAP, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
-INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except
- ! for the first time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
-!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE LIMA_PRECIP_SCAVENGING
-END INTERFACE
-END MODULE MODI_LIMA_PRECIP_SCAVENGING
-!
+!MNH_LIC Copyright 2013-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.
+!-----------------------------------------------------------------
!########################################################################
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
- PPABST, PTHT, PSVT, PRSVS, PINPAP , &
- YDDDH, YDLDDH, YDMDDH)
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
!########################################################################x
!
!! PURPOSE
@@ -100,39 +65,48 @@ END MODULE MODI_LIMA_PRECIP_SCAVENGING
!! -------------
!! Original ??/??/13
!!
+! P. Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 03/06/2020: bugfix: correct array starts for PSVT and PRSVS
+! P. Wautelet 11/02/2021: bugfix: ZRTMIN was of wrong size (replaced by a scalar)
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
!-------------------------------------------------------------------------------
!
!* 0.DECLARATIONS
! --------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+use modd_budget, only: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_SV1
+USE MODD_CST, ONLY: CST_t
USE MODD_NSV
-USE MODD_CST
USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
+ NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XALPHAR, XNUR, &
+ LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
+ XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
+ XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
+
+use mode_budget, only: Budget_store_init_phy, Budget_store_end_phy
+use mode_tools, only: Countjv
+
USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-! Previous versions by S. Berthet were compatible with all schemes
-! Here : Compatibility with LIMA only
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
- NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
- XALPHAR, XNUR, &
- LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
- XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
- XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XCR, XDR
-!
-USE MODD_BUDGET
-USE MODE_BUDGET, ONLY: BUDGET_DDH
-!
+USE MODE_LIMA_FUNCTIONS, ONLY: GAUHER, GAULAG
+
IMPLICIT NONE
!
!* 0.1 declarations of dummy arguments :
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
@@ -151,10 +125,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB ! Define the domain where is
@@ -250,15 +220,32 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: &
ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
REAL :: ZDENS_RATIO_SQRT
INTEGER :: SV_VAR, NM, JM
+integer :: idx
REAL :: XMDIAMP
REAL :: XSIGMAP
REAL :: XRHOP
REAL :: XFRACP
!
-!
+INTEGER :: ISV_LIMA_NR
+INTEGER :: ISV_LIMA_SCAVMASS
!
!------------------------------------------------------------------------------
-!
+ISV_LIMA_NR = NSV_LIMA_NR - NSV_LIMA_BEG + 1
+ISV_LIMA_SCAVMASS = NSV_LIMA_SCAVMASS - NSV_LIMA_BEG + 1
+
+if ( BUCONF%lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_init_phy(D, tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
!
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
@@ -272,7 +259,7 @@ IKB=1+JPVEXT
IKE=SIZE(PRHODREF,3) - JPVEXT
!
! PCRT
-PCRT(:,:,:)=PSVT(:,:,:,NSV_LIMA_NR)
+PCRT(:,:,:)=PSVT(:,:,:,ISV_LIMA_NR)
!
! Rain mask
GRAIN(:,:,:) = .FALSE.
@@ -303,19 +290,19 @@ ZSHAPE_FACTOR = GAMMA_X0D(XNUR+3./XALPHAR)/GAMMA_X0D(XNUR)
!
WHERE ( GRAIN(:,:,:) )
!
- ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 )**(CST%XRD/CST%XCPD)
ZCONCR_3D(:,:,:) = PCRT(:,:,:) * PRHODREF(:,:,:) ![/m3]
! Sutherland law for viscosity of air
- ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**(3/2)*(XTREF+XT_SUTH_A) &
+ ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**1.5*(XTREF+XT_SUTH_A) &
/(XT_SUTH_A+ZT_3D(:,:,:))
! Air mean free path
- ZMFPA_3D(:,:,:) = XMFPA0*(XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
+ ZMFPA_3D(:,:,:) = XMFPA0*(CST%XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
! Viscosity ratio
ZVISC_RATIO_3D(:,:,:) = ZVISCA_3D(:,:,:)/XVISCW !!!!! inversé par rapport à orig. !
! Rain drops parameters
- ZLAMBDAR_3D(:,:,:) = ( ((XPI/6.)*ZSHAPE_FACTOR*XRHOLW*ZCONCR_3D(:,:,:)) &
+ ZLAMBDAR_3D(:,:,:) = ( ((CST%XPI/6.)*ZSHAPE_FACTOR*CST%XRHOLW*ZCONCR_3D(:,:,:)) &
/(PRHODREF(:,:,:)*PRRT(:,:,:)) )**(1./3.) ![/m]
- FACTOR_3D(:,:,:) = XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ FACTOR_3D(:,:,:) = CST%XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
!
END WHERE
!
@@ -351,11 +338,11 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
!
IF (JSV .LE. NMOD_CCN) THEN
JMOD = JSV
- SV_VAR = NSV_LIMA_CCN_FREE -1 + JMOD ! Variable number in PSVT
+ SV_VAR = NSV_LIMA_CCN_FREE - NSV_LIMA_BEG + JMOD ! Variable number in PSVT
NM = 1 ! Number of species (for IFN int. mixing)
ELSE
JMOD = JSV - NMOD_CCN
- SV_VAR = NSV_LIMA_IFN_FREE -1 + JMOD
+ SV_VAR = NSV_LIMA_IFN_FREE - NSV_LIMA_BEG + JMOD
NM = NSPECIE
END IF
!
@@ -459,7 +446,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ZKNUDSEN(:) = MIN( 20.,ZVOLDP(J1)/ZMFPA(:) )
ZCUNSLIP(:,J1) = 1.0+2.0/ZKNUDSEN(:)*(1.257+0.4*EXP(-0.55*ZKNUDSEN(:)))
! Diffusion coefficient
- ZDIFF(:,J1) = XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*XPI*ZVISCA(:)*ZVOLDP(J1))
+ ZDIFF(:,J1) = CST%XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*CST%XPI*ZVISCA(:)*ZVOLDP(J1))
! Schmidt number
ZSC(:,J1) = ZVISCA(:)/(ZRHODREF(:)*ZDIFF(:,J1))
ZSC_INV(:,J1) = 1./ZSC(:,J1)
@@ -468,7 +455,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
! Characteristic Time Required for reaching terminal velocity
ZRELT(:,J1) = (ZVOLDP(J1)**2)*ZCUNSLIP(:,J1)*XRHOP/(18.*ZVISCA(:))
! Density number
- ZDENS_RATIO = XRHOP/XRHOLW
+ ZDENS_RATIO = XRHOP/CST%XRHOLW
ZDENS_RATIO_SQRT = SQRT(ZDENS_RATIO)
! Initialisation
ZBC_SCAV_COEF(:,J1)=0.
@@ -477,7 +464,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
!
DO J2=1,NDIAMR
! Stokes number
- ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*XG) &
+ ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*CST%XG) &
*ZVOLDR_INV(:,J2)
! Size Ratio
ZSIZE_RATIO(:,J1,J2) = ZVOLDP(J1)*ZVOLDR_INV(:,J2)
@@ -498,7 +485,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
! Total MASS Scavenging Rate of aerosol [kg.m**-3.s**-1]
ZTOT_MASS_RATE(:) = ZTOT_MASS_RATE(:) + &
ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1) &
- *XPI/6.*XRHOP*(ZVOLDP(J1)**3)
+ *CST%XPI/6.*XRHOP*(ZVOLDP(J1)**3)
END DO
! End of the loop over the drops diameters
!--------------------------------------------------------------------------
@@ -514,9 +501,9 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
- PRHODREF, PRRT, PSVT(:,:,:,NSV_LIMA_SCAVMASS),&
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS), PINPAP )
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS)=PRSVS(:,:,:,NSV_LIMA_SCAVMASS) + &
+ PRHODREF, PRRT, PSVT(:,:,:,ISV_LIMA_SCAVMASS),&
+ PRSVS(:,:,:,ISV_LIMA_SCAVMASS), PINPAP )
+ PRSVS(:,:,:,ISV_LIMA_SCAVMASS)=PRSVS(:,:,:,ISV_LIMA_SCAVMASS) + &
PTOT_MASS_RATE(:,:,:)*PRHODJ(:,:,:)/PRHODREF(:,:,:)
END IF
ENDDO
@@ -565,21 +552,19 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ENDIF
ENDDO
!
-IF (LBUDGET_SV) THEN
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET_DDH ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
- 12+NSV_LIMA_CCN_FREE+JL-1,'SCAV_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET_DDH ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
- 12+NSV_LIMA_IFN_FREE+JL-1,'SCAV_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
- END IF
-END IF
-!
+if ( BUCONF%lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_end_phy(D, tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
!------------------------------------------------------------------------------
!
!
@@ -683,7 +668,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRRS, & ! Rain water m.r. source
ZRHODREF, & ! RHO Dry REFerence
ZZW ! Work array
!
-REAL, DIMENSION(3) :: ZRTMIN
+REAL :: ZRTMIN3
!
!
REAL :: ZVTRMAX, ZDZMIN, ZT
@@ -716,7 +701,7 @@ firstcall : IF (GSFIRSTCALL) THEN
ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
ISPLITR = 1
SPLIT : DO
- ZT = 2.* PTSTEP / FLOAT(ISPLITR)
+ ZT = 2.* PTSTEP / REAL(ISPLITR)
IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
ISPLITR = ISPLITR + 1
END DO SPLIT
@@ -728,10 +713,10 @@ END IF firstcall
!* 2.2 time splitting loop initialization
!
IF( (KTCOUNT==1) .AND. (CCONF=='START') ) THEN
- ZTSPLITR = PTSTEP / FLOAT(ISPLITR) ! Small time step
+ ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
ZTSTEP = PTSTEP ! Large time step
ELSE
- ZTSPLITR= 2. * PTSTEP / FLOAT(ISPLITR)
+ ZTSPLITR= 2. * PTSTEP / REAL(ISPLITR)
ZTSTEP = 2. * PTSTEP
END IF
!
@@ -740,11 +725,11 @@ END IF
! optimization by looking for locations where
! the precipitating fields are larger than a minimal value only !!!
!
-ZRTMIN(:) = XRTMIN(:) / ZTSTEP
+ZRTMIN3 = XRTMIN(3) / ZTSTEP
ZZS(:,:,:) = PRAIN(:,:,:)
DO JN = 1 , ISPLITR
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
!
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
IF( ISEDIM >= 1 ) THEN
@@ -772,14 +757,14 @@ DO JN = 1 , ISPLITR
END DO
IF( JN==1 ) THEN
PINPAP(:,:) = ZWSED(:,:,IKB)* &
- ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN(3),PRRT(:,:,IKB)) )
+ ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN3,PRRT(:,:,IKB)) )
END IF
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZRRS)
DEALLOCATE(ZZW)
IF( JN==ISPLITR ) THEN
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
ZWSED(:,:,:) = 0.0
WHERE( GSEDIM(:,:,:) )
ZWSED(:,:,:) = 1.0/ZTSTEP - PRAIN(:,:,:)/ZZS(:,:,:)
diff --git a/src/common/micro/minpack.F90 b/src/common/micro/minpack.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c927712e40538d3f25197984d88e40d459f953e7
--- /dev/null
+++ b/src/common/micro/minpack.F90
@@ -0,0 +1,5780 @@
+!!$ Minpack Copyright Notice (1999) University of Chicago. All rights reserved
+!!$
+!!$ Redistribution and use in source and binary forms, with or
+!!$ without modification, are permitted provided that the
+!!$ following conditions are met:
+!!$
+!!$ 1. Redistributions of source code must retain the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer.
+!!$
+!!$ 2. Redistributions in binary form must reproduce the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer in the documentation and/or other materials
+!!$ provided with the distribution.
+!!$
+!!$ 3. The end-user documentation included with the
+!!$ redistribution, if any, must include the following
+!!$ acknowledgment:
+!!$
+!!$ "This product includes software developed by the
+!!$ University of Chicago, as Operator of Argonne National
+!!$ Laboratory."
+!!$
+!!$ Alternately, this acknowledgment may appear in the software
+!!$ itself, if and wherever such third-party acknowledgments
+!!$ normally appear.
+!!$
+!!$ 4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
+!!$ WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
+!!$ UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
+!!$ THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
+!!$ IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
+!!$ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
+!!$ OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
+!!$ OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
+!!$ USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
+!!$ THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
+!!$ DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
+!!$ UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
+!!$ BE CORRECTED.
+!!$
+!!$ 5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
+!!$ HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
+!!$ ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
+!!$ INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
+!!$ ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
+!!$ PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
+!!$ SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
+!!$ (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
+!!$ EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
+!!$ POSSIBILITY OF SUCH LOSS OR DAMAGES.
+
+subroutine chkder ( m, n, x, fvec, fjac, ldfjac, xp, fvecp, mode, err )
+
+!*****************************************************************************80
+!
+!! CHKDER checks the gradients of M functions of N variables.
+!
+! Discussion:
+!
+! CHKDER checks the gradients of M nonlinear functions in N variables,
+! evaluated at a point X, for consistency with the functions themselves.
+!
+! The user calls CHKDER twice, first with MODE = 1 and then with MODE = 2.
+!
+! MODE = 1.
+! On input,
+! X contains the point of evaluation.
+! On output,
+! XP is set to a neighboring point.
+!
+! Now the user must evaluate the function and gradients at X, and the
+! function at XP. Then the subroutine is called again:
+!
+! MODE = 2.
+! On input,
+! FVEC contains the function values at X,
+! FJAC contains the function gradients at X.
+! FVECP contains the functions evaluated at XP.
+! On output,
+! ERR contains measures of correctness of the respective gradients.
+!
+! The subroutine does not perform reliably if cancellation or
+! rounding errors cause a severe loss of significance in the
+! evaluation of a function. Therefore, none of the components
+! of X should be unusually small (in particular, zero) or any
+! other value which may cause loss of significance.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+!
+! Input, real ( kind = 8 ) X(N), the point at which the jacobian is to be
+! evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), is used only when MODE = 2.
+! In that case, it should contain the function values at X.
+!
+! Input, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. When MODE = 2,
+! FJAC(I,J) should contain the value of dF(I)/dX(J).
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, real ( kind = 8 ) XP(N), on output with MODE = 1, is a neighboring
+! point of X, at which the function is to be evaluated.
+!
+! Input, real ( kind = 8 ) FVECP(M), on input with MODE = 2, is the function
+! value at XP.
+!
+! Input, integer ( kind = 4 ) MODE, should be set to 1 on the first call, and
+! 2 on the second.
+!
+! Output, real ( kind = 8 ) ERR(M). On output when MODE = 2, ERR contains
+! measures of correctness of the respective gradients. If there is no
+! severe loss of significance, then if ERR(I):
+! = 1.0D+00, the I-th gradient is correct,
+! = 0.0D+00, the I-th gradient is incorrect.
+! > 0.5D+00, the I-th gradient is probably correct.
+! < 0.5D+00, the I-th gradient is probably incorrect.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsf
+ real ( kind = 8 ) epslog
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) err(m)
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) fvecp(m)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) mode
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xp(n)
+
+ epsmch = epsilon ( epsmch )
+ eps = sqrt ( epsmch )
+!
+! MODE = 1.
+!
+ if ( mode == 1 ) then
+
+ do j = 1, n
+ temp = eps * abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = eps
+ end if
+ xp(j) = x(j) + temp
+ end do
+!
+! MODE = 2.
+!
+ else if ( mode == 2 ) then
+
+ epsf = 100.0D+00 * epsmch
+ epslog = log10 ( eps )
+
+ err = 0.0D+00
+
+ do j = 1, n
+ temp = abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = 1.0D+00
+ end if
+ err(1:m) = err(1:m) + temp * fjac(1:m,j)
+ end do
+
+ do i = 1, m
+
+ temp = 1.0D+00
+
+ if ( fvec(i) /= 0.0D+00 .and. fvecp(i) /= 0.0D+00 .and. &
+ abs ( fvecp(i)-fvec(i)) >= epsf * abs ( fvec(i) ) ) then
+ temp = eps * abs ( (fvecp(i)-fvec(i)) / eps - err(i) ) &
+ / ( abs ( fvec(i) ) + abs ( fvecp(i) ) )
+ end if
+
+ err(i) = 1.0D+00
+
+ if ( epsmch < temp .and. temp < eps ) then
+ err(i) = ( log10 ( temp ) - epslog ) / epslog
+ end if
+
+ if ( eps <= temp ) then
+ err(i) = 0.0D+00
+ end if
+
+ end do
+
+ end if
+
+ return
+end
+subroutine dogleg ( n, r, lr, diag, qtb, delta, x )
+
+!*****************************************************************************80
+!
+!! DOGLEG finds the minimizing combination of Gauss-Newton and gradient steps.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA, the
+! problem is to determine the convex combination X of the
+! Gauss-Newton and scaled gradient directions that minimizes
+! (A*X - B) in the least squares sense, subject to the
+! restriction that the euclidean norm of D*X be at most DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization of A. That is, if A = Q*R, where Q has
+! orthogonal columns and R is an upper triangular matrix,
+! then DOGLEG expects the full upper triangle of R and
+! the first N components of Q'*B.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the matrix R.
+!
+! Input, real ( kind = 8 ) R(LR), the upper triangular matrix R stored
+! by rows.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be
+! no less than (N*(N+1))/2.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'* B.
+!
+! Input, real ( kind = 8 ) DELTA, is a positive upper bound on the
+! euclidean norm of D*X(1:N).
+!
+! Output, real ( kind = 8 ) X(N), the desired convex combination of the
+! Gauss-Newton direction and the scaled gradient direction.
+!
+ implicit none
+
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) bnorm
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) gnorm
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) sgnorm
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Calculate the Gauss-Newton direction.
+!
+ jj = ( n * ( n + 1 ) ) / 2 + 1
+
+ do k = 1, n
+
+ j = n - k + 1
+ jj = jj - k
+ l = jj + 1
+ sum2 = 0.0D+00
+
+ do i = j + 1, n
+ sum2 = sum2 + r(l) * x(i)
+ l = l + 1
+ end do
+
+ temp = r(jj)
+
+ if ( temp == 0.0D+00 ) then
+
+ l = j
+ do i = 1, j
+ temp = max ( temp, abs ( r(l)) )
+ l = l + n - i
+ end do
+
+ if ( temp == 0.0D+00 ) then
+ temp = epsmch
+ else
+ temp = epsmch * temp
+ end if
+
+ end if
+
+ x(j) = ( qtb(j) - sum2 ) / temp
+
+ end do
+!
+! Test whether the Gauss-Newton direction is acceptable.
+!
+ wa1(1:n) = 0.0D+00
+ wa2(1:n) = diag(1:n) * x(1:n)
+ qnorm = enorm ( n, wa2 )
+
+ if ( qnorm <= delta ) then
+ return
+ end if
+!
+! The Gauss-Newton direction is not acceptable.
+! Calculate the scaled gradient direction.
+!
+ l = 1
+ do j = 1, n
+ temp = qtb(j)
+ do i = j, n
+ wa1(i) = wa1(i) + r(l) * temp
+ l = l + 1
+ end do
+ wa1(j) = wa1(j) / diag(j)
+ end do
+!
+! Calculate the norm of the scaled gradient.
+! Test for the special case in which the scaled gradient is zero.
+!
+ gnorm = enorm ( n, wa1 )
+ sgnorm = 0.0D+00
+ alpha = delta / qnorm
+
+ if ( gnorm /= 0.0D+00 ) then
+!
+! Calculate the point along the scaled gradient which minimizes the quadratic.
+!
+ wa1(1:n) = ( wa1(1:n) / gnorm ) / diag(1:n)
+
+ l = 1
+ do j = 1, n
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + r(l) * wa1(i)
+ l = l + 1
+ end do
+ wa2(j) = sum2
+ end do
+
+ temp = enorm ( n, wa2 )
+ sgnorm = ( gnorm / temp ) / temp
+!
+! Test whether the scaled gradient direction is acceptable.
+!
+ alpha = 0.0D+00
+!
+! The scaled gradient direction is not acceptable.
+! Calculate the point along the dogleg at which the quadratic is minimized.
+!
+ if ( sgnorm < delta ) then
+
+ bnorm = enorm ( n, qtb )
+ temp = ( bnorm / gnorm ) * ( bnorm / qnorm ) * ( sgnorm / delta )
+ temp = temp - ( delta / qnorm ) * ( sgnorm / delta) ** 2 &
+ + sqrt ( ( temp - ( delta / qnorm ) ) ** 2 &
+ + ( 1.0D+00 - ( delta / qnorm ) ** 2 ) &
+ * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) )
+
+ alpha = ( ( delta / qnorm ) * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) ) &
+ / temp
+
+ end if
+
+ end if
+!
+! Form appropriate convex combination of the Gauss-Newton
+! direction and the scaled gradient direction.
+!
+ temp = ( 1.0D+00 - alpha ) * min ( sgnorm, delta )
+
+ x(1:n) = temp * wa1(1:n) + alpha * x(1:n)
+
+ return
+end
+function enorm ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This is an extremely simplified version of the original ENORM
+! routine, which has been renamed to "ENORM2".
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) enorm
+
+ enorm = sqrt ( sum ( x(1:n) ** 2 ))
+
+ return
+end
+function enorm2 ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM2 computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This routine was named ENORM. It has been renamed "ENORM2",
+! and a simplified routine has been substituted.
+!
+! The Euclidean norm is computed by accumulating the sum of
+! squares in three different sums. The sums of squares for the
+! small and large components are scaled so that no overflows
+! occur. Non-destructive underflows are permitted. Underflows
+! and overflows do not occur in the computation of the unscaled
+! sum of squares for the intermediate components.
+!
+! The definitions of small, intermediate and large components
+! depend on two constants, RDWARF and RGIANT. The main
+! restrictions on these constants are that RDWARF^2 not
+! underflow and RGIANT^2 not overflow.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1
+! Argonne National Laboratory,
+! Argonne, Illinois.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM2, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) agiant
+ real ( kind = 8 ) enorm2
+ integer ( kind = 4 ) i
+ real ( kind = 8 ) rdwarf
+ real ( kind = 8 ) rgiant
+ real ( kind = 8 ) s1
+ real ( kind = 8 ) s2
+ real ( kind = 8 ) s3
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xabs
+ real ( kind = 8 ) x1max
+ real ( kind = 8 ) x3max
+
+ rdwarf = sqrt ( tiny ( rdwarf ) )
+ rgiant = sqrt ( huge ( rgiant ) )
+
+ s1 = 0.0D+00
+ s2 = 0.0D+00
+ s3 = 0.0D+00
+ x1max = 0.0D+00
+ x3max = 0.0D+00
+ agiant = rgiant / real ( n, kind = 8 )
+
+ do i = 1, n
+
+ xabs = abs ( x(i) )
+
+ if ( xabs <= rdwarf ) then
+
+ if ( x3max < xabs ) then
+ s3 = 1.0D+00 + s3 * ( x3max / xabs ) ** 2
+ x3max = xabs
+ else if ( xabs /= 0.0D+00 ) then
+ s3 = s3 + ( xabs / x3max ) ** 2
+ end if
+
+ else if ( agiant <= xabs ) then
+
+ if ( x1max < xabs ) then
+ s1 = 1.0D+00 + s1 * ( x1max / xabs ) ** 2
+ x1max = xabs
+ else
+ s1 = s1 + ( xabs / x1max ) ** 2
+ end if
+
+ else
+
+ s2 = s2 + xabs ** 2
+
+ end if
+
+ end do
+!
+! Calculation of norm.
+!
+ if ( s1 /= 0.0D+00 ) then
+
+ enorm2 = x1max * sqrt ( s1 + ( s2 / x1max ) / x1max )
+
+ else if ( s2 /= 0.0D+00 ) then
+
+ if ( x3max <= s2 ) then
+ enorm2 = sqrt ( s2 * ( 1.0D+00 + ( x3max / s2 ) * ( x3max * s3 ) ) )
+ else
+ enorm2 = sqrt ( x3max * ( ( s2 / x3max ) + ( x3max * s3 ) ) )
+ end if
+
+ else
+
+ enorm2 = x3max * sqrt ( s3 )
+
+ end if
+
+ return
+end
+subroutine fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC1 estimates an N by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the N by N jacobian matrix associated with a specified
+! problem of N functions in N variables. If the jacobian has
+! a banded form, then function evaluations are saved by only
+! approximating the nonzero terms.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(N), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the N by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC, which
+! must not be less than N.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the
+! jacobian is not banded, set ML and MU to N-1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+ msum = ml + mu + 1
+!
+! Computation of dense approximate jacobian.
+!
+ if ( n <= msum ) then
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:n,j) = ( wa1(1:n) - fvec(1:n) ) / h
+
+ end do
+
+ else
+!
+! Computation of banded approximate jacobian.
+!
+ do k = 1, msum
+
+ do j = k, n, msum
+ wa2(j) = x(j)
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+ x(j) = wa2(j) + h
+ end do
+
+ iflag = 1
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ do j = k, n, msum
+
+ x(j) = wa2(j)
+
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ fjac(1:n,j) = 0.0D+00
+
+ do i = 1, n
+ if ( j - mu <= i .and. i <= j + ml ) then
+ fjac(i,j) = ( wa1(i) - fvec(i) ) / h
+ end if
+ end do
+
+ end do
+
+ end do
+
+ end if
+
+ return
+end
+subroutine fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC2 estimates an M by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the M by N jacobian matrix associated with a specified
+! problem of M functions in N variables.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the M by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC,
+! which must not be less than M.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable
+! step length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( m, n, x, wa, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:m,j) = ( wa(1:m) - fvec(1:m) ) / h
+
+ end do
+
+ return
+end
+subroutine hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRD seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions. The jacobian is
+! then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the jacobian
+! is not banded, set ML and MU to at least n - 1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of
+! iterates if it is positive. In this case, FCN is called with IFLAG = 0 at
+! the beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN has reached or exceeded MAXFEV.
+! 3, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress, as measured by the improvement
+! from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the improvement
+! from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced by
+! the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be no
+! less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ return
+ else if ( xtol < 0.0D+00 ) then
+ return
+ else if ( maxfev <= 0 ) then
+ return
+ else if ( ml < 0 ) then
+ return
+ else if ( mu < 0 ) then
+ return
+ else if ( factor <= 0.0D+00 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( lr < ( n * ( n + 1 ) ) / 2 ) then
+ return
+ end if
+
+ if ( mode == 2 ) then
+
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+
+ end if
+!
+! Evaluate the function at the starting point
+! and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Determine the number of calls to FCN needed to compute the jacobian matrix.
+!
+ msum = min ( ml + mu + 1, n )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+30 continue
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+ nfev = nfev + msum
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q' * FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ temp = - dot_product ( qtf(j:n), fjac(j:n,j) ) / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+ end if
+
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+180 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ endif
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Criterion for recalculating jacobian approximation
+! by forward differences.
+!
+ if ( ncfail == 2 ) then
+ go to 290
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+ go to 180
+
+ 290 continue
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine hybrd1 ( fcn, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRD1 seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRD. The user must provide a
+! subroutine which calculates the functions. The jacobian is then
+! calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN has reached or exceeded 200*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, the iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) lwa
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(n,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ xtol = tol
+ maxfev = 200 * ( n + 1 )
+ ml = n - 1
+ mu = n - 1
+ epsfcn = 0.0D+00
+ diag(1:n) = 1.0D+00
+ mode = 2
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ fjac(1:n,1:n) = 0.0D+00
+ ldfjac = n
+ r(1:(n*(n+1))/2) = 0.0D+00
+ lr = ( n * ( n + 1 ) ) / 2
+ qtf(1:n) = 0.0D+00
+
+ call hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRJ seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRJ finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+!
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N matrix, containing
+! the orthogonal matrix Q produced by the QR factorization
+! of the final approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of the
+! array FJAC. LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 3, XTOL is too small. No further improvement in
+! the approximate solution X is possible.
+! 4, iteration is not making good progress, as measured by the
+! improvement from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the
+! improvement from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced
+! by the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must
+! be no less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( ldfjac < n .or. &
+ xtol < 0.0D+00 .or. &
+ maxfev <= 0 .or. &
+ factor <= 0.0D+00 .or. &
+ lr < ( n * ( n + 1 ) ) / 2 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+ do
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + fjac(i,j) * qtf(i)
+ end do
+ temp = - sum2 / fjac(j,j)
+ do i = j, n
+ qtf(i) = qtf(i) + fjac(i,j) * temp
+ end do
+ end if
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+ do
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, fjac, ldfjac, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Criterion for recalculating jacobian.
+!
+ if ( ncfail == 2 ) then
+ exit
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+
+ end do
+!
+! End of the outer loop.
+!
+ end do
+
+end
+subroutine hybrj1 ( fcn, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRJ1 seeks a zero of N equations in N variables by Powell's method.
+!
+! Discussion:
+!
+! HYBRJ1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRJ. The user
+! must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at most
+! TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ maxfev = 100 * ( n + 1 )
+ xtol = tol
+ mode = 2
+ diag(1:n) = 1.0D+00
+ factor = 100.0D+00
+ nprint = 0
+ lr = ( n * ( n + 1 ) ) / 2
+
+ call hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDER minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. Termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN with IFLAG = 1 is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of
+! squares are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN with
+! IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN with
+! IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P
+! such that JAC*P = Q*R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column
+! IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 300
+ end if
+
+ if ( m < n ) then
+ go to 300
+ end if
+
+ if ( ldfjac < m &
+ .or. ftol < 0.0D+00 .or. xtol < 0.0D+00 .or. gtol < 0.0D+00 &
+ .or. maxfev <= 0 .or. factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if mode is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction p and x + p. calculate the norm of p.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at x + p and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, fjac, ldfjac, iflag )
+
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( 0.0D+00 <= actred ) then
+ temp = 0.5D+00
+ end if
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Successful iteration.
+!
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. &
+ prered <= ftol .and. &
+ 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( nfev >= maxfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ return
+end
+subroutine lmder1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDER1 minimizes M functions in N variables by Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDER.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, is the leading dimension of FJAC,
+! which must be no less than M.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( ldfjac < m ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ factor = 100.0D+00
+ maxfev = 100 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ mode = 1
+ nprint = 0
+
+ call lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDIF minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. Therefore, XTOL
+! measures the relative error desired in the approximate solution. XTOL
+! should be nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound.
+! This bound is set to the product of FACTOR and the euclidean norm of
+! DIAG*X if nonzero, or else to FACTOR itself. In most cases, FACTOR should
+! lie in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN has reached or exceeded MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column IPVT(J)
+! of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+
+ if ( n <= 0 ) then
+ go to 300
+ else if ( m < n ) then
+ go to 300
+ else if ( ldfjac < m ) then
+ go to 300
+ else if ( ftol < 0.0D+00 ) then
+ go to 300
+ else if ( xtol < 0.0D+00 ) then
+ go to 300
+ else if ( gtol < 0.0D+00 ) then
+ go to 300
+ else if ( maxfev <= 0 ) then
+ go to 300
+ else if ( factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+ nfev = nfev + n
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+ end if
+!
+! Form Q' * FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+
+ l = ipvt(j)
+
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = 1, j
+ sum2 = sum2 + fjac(i,j) * ( qtf(i) / fnorm )
+ end do
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ endif
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration. update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) info = 3
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine lmdif1 ( fcn, m, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDIF1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDIF.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN has reached or exceeded 200*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(m,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ ! *** BVIE BEGIN ***
+ !factor = 100.0D+00
+ factor = 0.1D+00
+ ! *** BVIE END ***
+ maxfev = 200 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ epsfcn = 0.0D+00
+ mode = 1
+ nprint = 0
+ ldfjac = m
+
+ call lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmpar ( n, r, ldr, ipvt, diag, qtb, delta, par, x, sdiag )
+
+!*****************************************************************************80
+!
+!! LMPAR computes a parameter for the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA,
+! the problem is to determine a value for the parameter
+! PAR such that if X solves the system
+!
+! A*X = B,
+! sqrt ( PAR ) * D * X = 0,
+!
+! in the least squares sense, and DXNORM is the euclidean
+! norm of D*X, then either PAR is zero and
+!
+! ( DXNORM - DELTA ) <= 0.1 * DELTA,
+!
+! or PAR is positive and
+!
+! abs ( DXNORM - DELTA) <= 0.1 * DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! A*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then LMPAR expects
+! the full upper triangle of R, the permutation matrix P,
+! and the first N components of Q'*B. On output
+! LMPAR also provides an upper triangular matrix S such that
+!
+! P' * ( A' * A + PAR * D * D ) * P = S'* S.
+!
+! S is employed within LMPAR and may be of separate interest.
+!
+! Only a few iterations are generally needed for convergence
+! of the algorithm. If, however, the limit of 10 iterations
+! is reached, then the output PAR will contain the best
+! value obtained so far.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 24 January 2014
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N),the N by N matrix. The full
+! upper triangle must contain the full upper triangle of the matrix R.
+! On output the full upper triangle is unaltered, and the strict lower
+! triangle contains the strict upper triangle (transposed) of the upper
+! triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R. LDR must be
+! no less than N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the
+! identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Input, real ( kind = 8 ) DELTA, an upper bound on the euclidean norm
+! of D*X. DELTA should be positive.
+!
+! Input/output, real ( kind = 8 ) PAR. On input an initial estimate of the
+! Levenberg-Marquardt parameter. On output the final estimate.
+! PAR should be nonnegative.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution of the system
+! A*X = B, sqrt(PAR)*D*X = 0, for the output value of PAR.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dwarf
+ real ( kind = 8 ) dxnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) fp
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) par
+ real ( kind = 8 ) parc
+ real ( kind = 8 ) parl
+ real ( kind = 8 ) paru
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+!
+! DWARF is the smallest positive magnitude.
+!
+ dwarf = tiny ( dwarf )
+!
+! Compute and store in X the Gauss-Newton direction.
+!
+! If the jacobian is rank-deficient, obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+ wa1(j) = qtb(j)
+ if ( r(j,j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+ if ( nsing < n ) then
+ wa1(j) = 0.0D+00
+ end if
+ end do
+
+ do k = 1, nsing
+ j = nsing - k + 1
+ wa1(j) = wa1(j) / r(j,j)
+ temp = wa1(j)
+ wa1(1:j-1) = wa1(1:j-1) - r(1:j-1,j) * temp
+ end do
+
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa1(j)
+ end do
+!
+! Initialize the iteration counter.
+! Evaluate the function at the origin, and test
+! for acceptance of the Gauss-Newton direction.
+!
+ iter = 0
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ fp = dxnorm - delta
+
+ if ( fp <= 0.1D+00 * delta ) then
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+ return
+ end if
+!
+! If the jacobian is not rank deficient, the Newton
+! step provides a lower bound, PARL, for the zero of
+! the function.
+!
+! Otherwise set this bound to zero.
+!
+ parl = 0.0D+00
+
+ if ( n <= nsing ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ sum2 = dot_product ( wa1(1:j-1), r(1:j-1,j) )
+ wa1(j) = ( wa1(j) - sum2 ) / r(j,j)
+ end do
+
+ temp = enorm ( n, wa1 )
+ parl = ( ( fp / delta ) / temp ) / temp
+
+ end if
+!
+! Calculate an upper bound, PARU, for the zero of the function.
+!
+ do j = 1, n
+ sum2 = dot_product ( qtb(1:j), r(1:j,j) )
+ l = ipvt(j)
+ wa1(j) = sum2 / diag(l)
+ end do
+
+ gnorm = enorm ( n, wa1 )
+ paru = gnorm / delta
+
+ if ( paru == 0.0D+00 ) then
+ paru = dwarf / min ( delta, 0.1D+00 )
+ end if
+!
+! If the input PAR lies outside of the interval (PARL, PARU),
+! set PAR to the closer endpoint.
+!
+ par = max ( par, parl )
+ par = min ( par, paru )
+ if ( par == 0.0D+00 ) then
+ par = gnorm / dxnorm
+ end if
+!
+! Beginning of an iteration.
+!
+ do
+
+ iter = iter + 1
+!
+! Evaluate the function at the current value of PAR.
+!
+ if ( par == 0.0D+00 ) then
+ par = max ( dwarf, 0.001D+00 * paru )
+ end if
+
+ wa1(1:n) = sqrt ( par ) * diag(1:n)
+
+ call qrsolv ( n, r, ldr, ipvt, wa1, qtb, x, sdiag )
+
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ temp = fp
+ fp = dxnorm - delta
+!
+! If the function is small enough, accept the current value of PAR.
+!
+ if ( abs ( fp ) <= 0.1D+00 * delta ) then
+ exit
+ end if
+!
+! Test for the exceptional cases where PARL
+! is zero or the number of iterations has reached 10.
+!
+ if ( parl == 0.0D+00 .and. fp <= temp .and. temp < 0.0D+00 ) then
+ exit
+ else if ( iter == 10 ) then
+ exit
+ end if
+!
+! Compute the Newton correction.
+!
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ wa1(j) = wa1(j) / sdiag(j)
+ temp = wa1(j)
+ wa1(j+1:n) = wa1(j+1:n) - r(j+1:n,j) * temp
+ end do
+
+ temp = enorm ( n, wa1 )
+ parc = ( ( fp / delta ) / temp ) / temp
+!
+! Depending on the sign of the function, update PARL or PARU.
+!
+ if ( 0.0D+00 < fp ) then
+ parl = max ( parl, par )
+ else if ( fp < 0.0D+00 ) then
+ paru = min ( paru, par )
+ end if
+!
+! Compute an improved estimate for PAR.
+!
+ par = max ( parl, par + parc )
+!
+! End of an iteration.
+!
+ end do
+!
+! Termination.
+!
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+
+ return
+end
+subroutine lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMSTR minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! The user must provide a subroutine which calculates the functions and
+! the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle of FJAC contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! triangular part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual and
+! predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number
+! of calls to FCN with IFLAG = 1 is at least MAXFEV by the end of
+! an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular.
+! Column J of P is column IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 340
+ else if ( m < n ) then
+ go to 340
+ else if ( ldfjac < n ) then
+ go to 340
+ else if ( ftol < 0.0D+00 ) then
+ go to 340
+ else if ( xtol < 0.0D+00 ) then
+ go to 340
+ else if ( gtol < 0.0D+00 ) then
+ go to 340
+ else if ( maxfev <= 0 ) then
+ go to 340
+ else if ( factor <= 0.0D+00 ) then
+ go to 340
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 340
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+ 30 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter-1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian matrix calculated one row
+! at a time, while simultaneously forming Q'* FVEC and storing
+! the first N components in QTF.
+!
+ qtf(1:n) = 0.0D+00
+ fjac(1:n,1:n) = 0.0D+00
+ iflag = 2
+
+ do i = 1, m
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ temp = fvec(i)
+ call rwupdt ( n, fjac, ldfjac, wa3, qtf, temp, wa1, wa2 )
+ iflag = iflag + 1
+ end do
+
+ njev = njev + 1
+!
+! If the jacobian is rank deficient, call QRFAC to
+! reorder its columns and update the components of QTF.
+!
+ sing = .false.
+ do j = 1, n
+ if ( fjac(j,j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ ipvt(j) = j
+ wa2(j) = enorm ( j, fjac(1,j) )
+ end do
+
+ if ( sing ) then
+
+ pivot = .true.
+ call qrfac ( n, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+
+ sum2 = dot_product ( qtf(j:n), fjac(j:n,j) )
+ temp = - sum2 / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+
+ end if
+
+ fjac(j,j) = wa1(j)
+
+ end do
+
+ end if
+!
+! On the first iteration
+! if mode is 1,
+! scale according to the norms of the columns of the initial jacobian.
+! calculate the norm of the scaled X,
+! initialize the step bound delta.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 340
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+240 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, wa3, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt(par) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ else
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = pnorm / 0.5D+00
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+ if ( ratio >= 0.0001D+00 ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence, termination and stringent tolerances.
+!
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+
+ if ( nfev >= maxfev) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 240
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 340 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+
+ return
+end
+subroutine lmstr1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMSTR1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! This is done by using the more general least-squares solver
+! LMSTR. The user must provide a subroutine which calculates
+! the functions and the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower triangular part of FJAC contains information generated
+! during the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( m < n ) then
+ info = 0
+ return
+ end if
+
+ if ( ldfjac < n ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ fvec(1:n) = 0.0D+00
+ fjac(1:ldfjac,1:n) = 0.0D+00
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ maxfev = 100 * ( n + 1 )
+ diag(1:n) = 0.0D+00
+ mode = 1
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ njev = 0
+ ipvt(1:n) = 0
+ qtf(1:n) = 0.0D+00
+
+ call lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine qform ( m, n, q, ldq )
+
+!*****************************************************************************80
+!
+!! QFORM produces the explicit QR factorization of a matrix.
+!
+! Discussion:
+!
+! The QR factorization of a matrix is usually accumulated in implicit
+! form, that is, as a series of orthogonal transformations of the
+! original matrix. This routine carries out those transformations,
+! to explicitly exhibit the factorization constructed by QRFAC.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is a positive integer input variable set
+! to the number of rows of A and the order of Q.
+!
+! Input, integer ( kind = 4 ) N, is a positive integer input variable set
+! to the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) Q(LDQ,M). Q is an M by M array.
+! On input the full lower trapezoid in the first min(M,N) columns of Q
+! contains the factored form.
+! On output, Q has been accumulated into a square matrix.
+!
+! Input, integer ( kind = 4 ) LDQ, is a positive integer input variable
+! not less than M which specifies the leading dimension of the array Q.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldq
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) minmn
+ real ( kind = 8 ) q(ldq,m)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+
+ minmn = min ( m, n )
+
+ do j = 2, minmn
+ q(1:j-1,j) = 0.0D+00
+ end do
+!
+! Initialize remaining columns to those of the identity matrix.
+!
+ q(1:m,n+1:m) = 0.0D+00
+
+ do j = n+1, m
+ q(j,j) = 1.0D+00
+ end do
+!
+! Accumulate Q from its factored form.
+!
+ do l = 1, minmn
+
+ k = minmn - l + 1
+
+ wa(k:m) = q(k:m,k)
+
+ q(k:m,k) = 0.0D+00
+ q(k,k) = 1.0D+00
+
+ if ( wa(k) /= 0.0D+00 ) then
+
+ do j = k, m
+ temp = dot_product ( wa(k:m), q(k:m,j) ) / wa(k)
+ q(k:m,j) = q(k:m,j) - temp * wa(k:m)
+ end do
+
+ end if
+
+ end do
+
+ return
+end
+subroutine qrfac ( m, n, a, lda, pivot, ipvt, lipvt, rdiag, acnorm )
+
+!*****************************************************************************80
+!
+!! QRFAC computes a QR factorization using Householder transformations.
+!
+! Discussion:
+!
+! This subroutine uses Householder transformations with column
+! pivoting (optional) to compute a QR factorization of the
+! M by N matrix A. That is, QRFAC determines an orthogonal
+! matrix Q, a permutation matrix P, and an upper trapezoidal
+! matrix R with diagonal elements of nonincreasing magnitude,
+! such that A*P = Q*R. The Householder transformation for
+! column K, K = 1,2,...,min(M,N), is of the form
+!
+! I - ( 1 / U(K) ) * U * U'
+!
+! where U has zeros in the first K-1 positions. The form of
+! this transformation and the method of pivoting first
+! appeared in the corresponding LINPACK subroutine.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, A contains the matrix for which the QR factorization is to
+! be computed. On output, the strict upper trapezoidal part of A contains
+! the strict upper trapezoidal part of R, and the lower trapezoidal
+! part of A contains a factored form of Q (the non-trivial elements of
+! the U vectors described above).
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must
+! be no less than M.
+!
+! Input, logical PIVOT, is TRUE if column pivoting is to be carried out.
+!
+! Output, integer ( kind = 4 ) IPVT(LIPVT), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the identity
+! matrix. If PIVOT is false, IPVT is not referenced.
+!
+! Input, integer ( kind = 4 ) LIPVT, the dimension of IPVT, which should
+! be N if pivoting is used.
+!
+! Output, real ( kind = 8 ) RDIAG(N), contains the diagonal elements of R.
+!
+! Output, real ( kind = 8 ) ACNORM(N), the norms of the corresponding
+! columns of the input matrix A. If this information is not needed,
+! then ACNORM can coincide with RDIAG.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) lipvt
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) acnorm(n)
+ real ( kind = 8 ) ajnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) i4_temp
+ integer ( kind = 4 ) ipvt(lipvt)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) kmax
+ integer ( kind = 4 ) minmn
+ logical pivot
+ real ( kind = 8 ) r8_temp(m)
+ real ( kind = 8 ) rdiag(n)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Compute the initial column norms and initialize several arrays.
+!
+ do j = 1, n
+ acnorm(j) = enorm ( m, a(1:m,j) )
+ end do
+
+ rdiag(1:n) = acnorm(1:n)
+ wa(1:n) = acnorm(1:n)
+
+ if ( pivot ) then
+ do j = 1, n
+ ipvt(j) = j
+ end do
+ end if
+!
+! Reduce A to R with Householder transformations.
+!
+ minmn = min ( m, n )
+
+ do j = 1, minmn
+!
+! Bring the column of largest norm into the pivot position.
+!
+ if ( pivot ) then
+
+ kmax = j
+
+ do k = j, n
+ if ( rdiag(kmax) < rdiag(k) ) then
+ kmax = k
+ end if
+ end do
+
+ if ( kmax /= j ) then
+
+ r8_temp(1:m) = a(1:m,j)
+ a(1:m,j) = a(1:m,kmax)
+ a(1:m,kmax) = r8_temp(1:m)
+
+ rdiag(kmax) = rdiag(j)
+ wa(kmax) = wa(j)
+
+ i4_temp = ipvt(j)
+ ipvt(j) = ipvt(kmax)
+ ipvt(kmax) = i4_temp
+
+ end if
+
+ end if
+!
+! Compute the Householder transformation to reduce the
+! J-th column of A to a multiple of the J-th unit vector.
+!
+ ajnorm = enorm ( m-j+1, a(j,j) )
+
+ if ( ajnorm /= 0.0D+00 ) then
+
+ if ( a(j,j) < 0.0D+00 ) then
+ ajnorm = -ajnorm
+ end if
+
+ a(j:m,j) = a(j:m,j) / ajnorm
+ a(j,j) = a(j,j) + 1.0D+00
+!
+! Apply the transformation to the remaining columns and update the norms.
+!
+ do k = j + 1, n
+
+ temp = dot_product ( a(j:m,j), a(j:m,k) ) / a(j,j)
+
+ a(j:m,k) = a(j:m,k) - temp * a(j:m,j)
+
+ if ( pivot .and. rdiag(k) /= 0.0D+00 ) then
+
+ temp = a(j,k) / rdiag(k)
+ rdiag(k) = rdiag(k) * sqrt ( max ( 0.0D+00, 1.0D+00-temp ** 2 ) )
+
+ if ( 0.05D+00 * ( rdiag(k) / wa(k) ) ** 2 <= epsmch ) then
+ rdiag(k) = enorm ( m-j, a(j+1,k) )
+ wa(k) = rdiag(k)
+ end if
+
+ end if
+
+ end do
+
+ end if
+
+ rdiag(j) = - ajnorm
+
+ end do
+
+ return
+end
+subroutine qrsolv ( n, r, ldr, ipvt, diag, qtb, x, sdiag )
+
+!*****************************************************************************80
+!
+!! QRSOLV solves a rectangular linear system A*x=b in the least squares sense.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N diagonal matrix D,
+! and an M-vector B, the problem is to determine an X which
+! solves the system
+!
+! A*X = B
+! D*X = 0
+!
+! in the least squares sense.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! Q*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then QRSOLV expects
+! the full upper triangle of R, the permutation matrix p,
+! and the first N components of Q'*B.
+!
+! The system is then equivalent to
+!
+! R*Z = Q'*B
+! P'*D*P*Z = 0
+!
+! where X = P*Z. If this system does not have full rank,
+! then a least squares solution is obtained. On output QRSOLV
+! also provides an upper triangular matrix S such that
+!
+! P'*(A'*A + D*D)*P = S'*S.
+!
+! S is computed within QRSOLV and may be of separate interest.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N), the N by N matrix.
+! On input the full upper triangle must contain the full upper triangle
+! of the matrix R. On output the full upper triangle is unaltered, and
+! the strict lower triangle contains the strict upper triangle
+! (transposed) of the upper triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R, which must be
+! at least N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P such
+! that A*P = Q*R. Column J of P is column IPVT(J) of the identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) c
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) diag(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) qtbpj
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) s
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) t
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+ real ( kind = 8 ) x(n)
+!
+! Copy R and Q'*B to preserve input and initialize S.
+!
+! In particular, save the diagonal elements of R in X.
+!
+ do j = 1, n
+ r(j:n,j) = r(j,j:n)
+ x(j) = r(j,j)
+ end do
+
+ wa(1:n) = qtb(1:n)
+!
+! Eliminate the diagonal matrix D using a Givens rotation.
+!
+ do j = 1, n
+!
+! Prepare the row of D to be eliminated, locating the
+! diagonal element using P from the QR factorization.
+!
+ l = ipvt(j)
+
+ if ( diag(l) /= 0.0D+00 ) then
+
+ sdiag(j:n) = 0.0D+00
+ sdiag(j) = diag(l)
+!
+! The transformations to eliminate the row of D
+! modify only a single element of Q'*B
+! beyond the first N, which is initially zero.
+!
+ qtbpj = 0.0D+00
+
+ do k = j, n
+!
+! Determine a Givens rotation which eliminates the
+! appropriate element in the current row of D.
+!
+ if ( sdiag(k) /= 0.0D+00 ) then
+
+ if ( abs ( r(k,k) ) < abs ( sdiag(k) ) ) then
+ cotan = r(k,k) / sdiag(k)
+ s = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c = s * cotan
+ else
+ t = sdiag(k) / r(k,k)
+ c = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * t ** 2 )
+ s = c * t
+ end if
+!
+! Compute the modified diagonal element of R and
+! the modified element of (Q'*B,0).
+!
+ r(k,k) = c * r(k,k) + s * sdiag(k)
+ temp = c * wa(k) + s * qtbpj
+ qtbpj = - s * wa(k) + c * qtbpj
+ wa(k) = temp
+!
+! Accumulate the tranformation in the row of S.
+!
+ do i = k+1, n
+ temp = c * r(i,k) + s * sdiag(i)
+ sdiag(i) = - s * r(i,k) + c * sdiag(i)
+ r(i,k) = temp
+ end do
+
+ end if
+
+ end do
+
+ end if
+!
+! Store the diagonal element of S and restore
+! the corresponding diagonal element of R.
+!
+ sdiag(j) = r(j,j)
+ r(j,j) = x(j)
+
+ end do
+!
+! Solve the triangular system for Z. If the system is
+! singular, then obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+
+ if ( sdiag(j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+
+ if ( nsing < n ) then
+ wa(j) = 0.0D+00
+ end if
+
+ end do
+
+ do j = nsing, 1, -1
+ sum2 = dot_product ( wa(j+1:nsing), r(j+1:nsing,j) )
+ wa(j) = ( wa(j) - sum2 ) / sdiag(j)
+ end do
+!
+! Permute the components of Z back to components of X.
+!
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa(j)
+ end do
+
+ return
+end
+subroutine r1mpyq ( m, n, a, lda, v, w )
+
+!*****************************************************************************80
+!
+!! R1MPYQ computes A*Q, where Q is the product of Householder transformations.
+!
+! Discussion:
+!
+! Given an M by N matrix A, this subroutine computes A*Q where
+! Q is the product of 2*(N - 1) transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! and GV(I), GW(I) are Givens rotations in the (I,N) plane which
+! eliminate elements in the I-th and N-th planes, respectively.
+! Q itself is not given, rather the information to recover the
+! GV, GW rotations is supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, the matrix A to be postmultiplied by the orthogonal matrix Q.
+! On output, the value of A*Q.
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must not
+! be less than M.
+!
+! Input, real ( kind = 8 ) V(N), W(N), contain the information necessary
+! to recover the Givens rotations GV and GW.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) c
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) s
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(n)
+!
+! Apply the first set of Givens rotations to A.
+!
+ do j = n - 1, 1, -1
+
+ if ( 1.0D+00 < abs ( v(j) ) ) then
+ c = 1.0D+00 / v(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = v(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) - s * a(i,n)
+ a(i,n) = s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+!
+! Apply the second set of Givens rotations to A.
+!
+ do j = 1, n - 1
+
+ if ( abs ( w(j) ) > 1.0D+00 ) then
+ c = 1.0D+00 / w(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = w(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) + s * a(i,n)
+ a(i,n) = - s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+
+ return
+end
+subroutine r1updt ( m, n, s, ls, u, v, w, sing )
+
+!*****************************************************************************80
+!
+!! R1UPDT re-triangularizes a matrix after a rank one update.
+!
+! Discussion:
+!
+! Given an M by N lower trapezoidal matrix S, an M-vector U, and an
+! N-vector V, the problem is to determine an orthogonal matrix Q such that
+!
+! (S + U * V' ) * Q
+!
+! is again lower trapezoidal.
+!
+! This subroutine determines Q as the product of 2 * (N - 1)
+! transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! where GV(I), GW(I) are Givens rotations in the (I,N) plane
+! which eliminate elements in the I-th and N-th planes,
+! respectively. Q itself is not accumulated, rather the
+! information to recover the GV and GW rotations is returned.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of S.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of S.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) S(LS). On input, the lower trapezoidal
+! matrix S stored by columns. On output S contains the lower trapezoidal
+! matrix produced as described above.
+!
+! Input, integer ( kind = 4 ) LS, the length of the S array. LS must be at
+! least (N*(2*M-N+1))/2.
+!
+! Input, real ( kind = 8 ) U(M), the U vector.
+!
+! Input/output, real ( kind = 8 ) V(N). On input, V must contain the
+! vector V. On output V contains the information necessary to recover the
+! Givens rotations GV described above.
+!
+! Output, real ( kind = 8 ) W(M), contains information necessary to
+! recover the Givens rotations GW described above.
+!
+! Output, logical SING, is set to TRUE if any of the diagonal elements
+! of the output S are zero. Otherwise SING is set FALSE.
+!
+ implicit none
+
+ integer ( kind = 4 ) ls
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) cos
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) giant
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) s(ls)
+ real ( kind = 8 ) sin
+ logical sing
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) tau
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) u(m)
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(m)
+!
+! GIANT is the largest magnitude.
+!
+ giant = huge ( giant )
+!
+! Initialize the diagonal element pointer.
+!
+ jj = ( n * ( 2 * m - n + 1 ) ) / 2 - ( m - n )
+!
+! Move the nontrivial part of the last column of S into W.
+!
+ l = jj
+ do i = n, m
+ w(i) = s(l)
+ l = l + 1
+ end do
+!
+! Rotate the vector V into a multiple of the N-th unit vector
+! in such a way that a spike is introduced into W.
+!
+ do j = n - 1, 1, -1
+
+ jj = jj - ( m - j + 1 )
+ w(j) = 0.0D+00
+
+ if ( v(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of V.
+!
+ if ( abs ( v(n) ) < abs ( v(j) ) ) then
+ cotan = v(n) / v(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+ tau = 1.0D+00
+ if ( abs ( cos ) * giant > 1.0D+00 ) then
+ tau = 1.0D+00 / cos
+ end if
+ else
+ tan = v(j) / v(n)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+ end if
+!
+! Apply the transformation to V and store the information
+! necessary to recover the Givens rotation.
+!
+ v(n) = sin * v(j) + cos * v(n)
+ v(j) = tau
+!
+! Apply the transformation to S and extend the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) - sin * w(i)
+ w(i) = sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+
+ end if
+
+ end do
+!
+! Add the spike from the rank 1 update to W.
+!
+ w(1:m) = w(1:m) + v(n) * u(1:m)
+!
+! Eliminate the spike.
+!
+ sing = .false.
+
+ do j = 1, n-1
+
+ if ( w(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of the spike.
+!
+ if ( abs ( s(jj) ) < abs ( w(j) ) ) then
+
+ cotan = s(jj) / w(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+
+ if ( 1.0D+00 < abs ( cos ) * giant ) then
+ tau = 1.0D+00 / cos
+ else
+ tau = 1.0D+00
+ end if
+
+ else
+
+ tan = w(j) / s(jj)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+
+ end if
+!
+! Apply the transformation to S and reduce the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) + sin * w(i)
+ w(i) = - sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+!
+! Store the information necessary to recover the Givens rotation.
+!
+ w(j) = tau
+
+ end if
+!
+! Test for zero diagonal elements in the output S.
+!
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ jj = jj + ( m - j + 1 )
+
+ end do
+!
+! Move W back into the last column of the output S.
+!
+ l = jj
+ do i = n, m
+ s(l) = w(i)
+ l = l + 1
+ end do
+
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ return
+end
+subroutine r8vec_print ( n, a, title )
+
+!*****************************************************************************80
+!
+!! R8VEC_PRINT prints an R8VEC.
+!
+! Discussion:
+!
+! An R8VEC is a vector of R8's.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 22 August 2000
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the number of components of the vector.
+!
+! Input, real ( kind = 8 ) A(N), the vector to be printed.
+!
+! Input, character ( len = * ) TITLE, a title.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(n)
+ integer ( kind = 4 ) i
+ character ( len = * ) title
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) trim ( title )
+ write ( *, '(a)' ) ' '
+ do i = 1, n
+ write ( *, '(2x,i8,2x,g16.8)' ) i, a(i)
+ end do
+
+ return
+end
+subroutine rwupdt ( n, r, ldr, w, b, alpha, c, s )
+
+!*****************************************************************************80
+!
+!! RWUPDT computes the decomposition of triangular matrix augmented by one row.
+!
+! Discussion:
+!
+! Given an N by N upper triangular matrix R, this subroutine
+! computes the QR decomposition of the matrix formed when a row
+! is added to R. If the row is specified by the vector W, then
+! RWUPDT determines an orthogonal matrix Q such that when the
+! N+1 by N matrix composed of R augmented by W is premultiplied
+! by Q', the resulting matrix is upper trapezoidal.
+! The matrix Q' is the product of N transformations
+!
+! G(N)*G(N-1)* ... *G(1)
+!
+! where G(I) is a Givens rotation in the (I,N+1) plane which eliminates
+! elements in the (N+1)-st plane. RWUPDT also computes the product
+! Q'*C where C is the (N+1)-vector (B,ALPHA). Q itself is not
+! accumulated, rather the information to recover the G rotations is
+! supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N). On input the upper triangular
+! part of R must contain the matrix to be updated. On output R contains the
+! updated triangular matrix.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of the array R.
+! LDR must not be less than N.
+!
+! Input, real ( kind = 8 ) W(N), the row vector to be added to R.
+!
+! Input/output, real ( kind = 8 ) B(N). On input, the first N elements
+! of the vector C. On output the first N elements of the vector Q'*C.
+!
+! Input/output, real ( kind = 8 ) ALPHA. On input, the (N+1)-st element
+! of the vector C. On output the (N+1)-st element of the vector Q'*C.
+!
+! Output, real ( kind = 8 ) C(N), S(N), the cosines and sines of the
+! transforming Givens rotations.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) b(n)
+ real ( kind = 8 ) c(n)
+ real ( kind = 8 ) cotan
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) rowj
+ real ( kind = 8 ) s(n)
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) w(n)
+
+ do j = 1, n
+
+ rowj = w(j)
+!
+! Apply the previous transformations to R(I,J), I=1,2,...,J-1, and to W(J).
+!
+ do i = 1, j - 1
+ temp = c(i) * r(i,j) + s(i) * rowj
+ rowj = - s(i) * r(i,j) + c(i) * rowj
+ r(i,j) = temp
+ end do
+!
+! Determine a Givens rotation which eliminates W(J).
+!
+ c(j) = 1.0D+00
+ s(j) = 0.0D+00
+
+ if ( rowj /= 0.0D+00 ) then
+
+ if ( abs ( r(j,j) ) < abs ( rowj ) ) then
+ cotan = r(j,j) / rowj
+ s(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c(j) = s(j) * cotan
+ else
+ tan = rowj / r(j,j)
+ c(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ s(j) = c(j) * tan
+ end if
+!
+! Apply the current transformation to R(J,J), B(J), and ALPHA.
+!
+ r(j,j) = c(j) * r(j,j) + s(j) * rowj
+ temp = c(j) * b(j) + s(j) * alpha
+ alpha = - s(j) * b(j) + c(j) * alpha
+ b(j) = temp
+
+ end if
+
+ end do
+
+ return
+end
+subroutine timestamp ( )
+
+!*****************************************************************************80
+!
+!! TIMESTAMP prints the current YMDHMS date as a time stamp.
+!
+! Example:
+!
+! 31 May 2001 9:45:54.872 AM
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 18 May 2013
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! None
+!
+ implicit none
+
+ character ( len = 8 ) ampm
+ integer ( kind = 4 ) d
+ integer ( kind = 4 ) h
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) mm
+ character ( len = 9 ), parameter, dimension(12) :: month = (/ &
+ 'January ', 'February ', 'March ', 'April ', &
+ 'May ', 'June ', 'July ', 'August ', &
+ 'September', 'October ', 'November ', 'December ' /)
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) s
+ integer ( kind = 4 ) values(8)
+ integer ( kind = 4 ) y
+
+ call date_and_time ( values = values )
+
+ y = values(1)
+ m = values(2)
+ d = values(3)
+ h = values(5)
+ n = values(6)
+ s = values(7)
+ mm = values(8)
+
+ if ( h < 12 ) then
+ ampm = 'AM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Noon'
+ else
+ ampm = 'PM'
+ end if
+ else
+ h = h - 12
+ if ( h < 12 ) then
+ ampm = 'PM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Midnight'
+ else
+ ampm = 'AM'
+ end if
+ end if
+ end if
+
+ write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
+ d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm )
+
+ return
+end
diff --git a/src/mesonh/micro/modd_lima_precip_scavengingn.f90 b/src/common/micro/modd_lima_precip_scavengingn.F90
similarity index 100%
rename from src/mesonh/micro/modd_lima_precip_scavengingn.f90
rename to src/common/micro/modd_lima_precip_scavengingn.F90
diff --git a/src/mesonh/micro/modd_param_lima.f90 b/src/common/micro/modd_param_lima.F90
similarity index 97%
rename from src/mesonh/micro/modd_param_lima.f90
rename to src/common/micro/modd_param_lima.F90
index d199c2a666f0e97b165dff5f3dd4e1cf5a40c815..00af77b8569018404060bee7c6672e849b02f504 100644
--- a/src/mesonh/micro/modd_param_lima.f90
+++ b/src/common/micro/modd_param_lima.F90
@@ -52,12 +52,9 @@ REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step
!
! 1.1 Cold scheme configuration
!
-LOGICAL, SAVE :: LCOLD ! TRUE to enable the cold scheme
LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation
LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation
LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules
-LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel
-LOGICAL, SAVE :: LHAIL ! TRUE to enable hail
LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation
LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup
LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing
@@ -135,9 +132,7 @@ REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
!
! 2.1 Warm scheme configuration
!
-LOGICAL, SAVE :: LWARM ! TRUE to enable the warm scheme
LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation
-LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain
LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
diff --git a/src/mesonh/micro/modd_param_lima_cold.f90 b/src/common/micro/modd_param_lima_cold.F90
similarity index 97%
rename from src/mesonh/micro/modd_param_lima_cold.f90
rename to src/common/micro/modd_param_lima_cold.F90
index 3801cfcb78da31c9274375af9c3800ace8c5419a..337480312280e054f1abdaabadfa4ca829fda3ae 100644
--- a/src/mesonh/micro/modd_param_lima_cold.f90
+++ b/src/common/micro/modd_param_lima_cold.F90
@@ -139,6 +139,14 @@ REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
! ice concentration (init and grid-nesting)
REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
!
+! For ICE4 nucleation
+REAL, SAVE :: XALPHA1
+REAL, SAVE :: XALPHA2
+REAL, SAVE :: XBETA1
+REAL, SAVE :: XBETA2
+REAL, SAVE :: XNU10
+REAL, SAVE :: XNU20
+!
!-------------------------------------------------------------------------------
!
END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/mesonh/micro/modd_param_lima_mixed.f90 b/src/common/micro/modd_param_lima_mixed.F90
similarity index 100%
rename from src/mesonh/micro/modd_param_lima_mixed.f90
rename to src/common/micro/modd_param_lima_mixed.F90
diff --git a/src/mesonh/micro/modd_param_lima_warm.f90 b/src/common/micro/modd_param_lima_warm.F90
similarity index 100%
rename from src/mesonh/micro/modd_param_lima_warm.f90
rename to src/common/micro/modd_param_lima_warm.F90
diff --git a/src/mesonh/micro/lima_bergeron.f90 b/src/common/micro/mode_lima_bergeron.F90
similarity index 61%
rename from src/mesonh/micro/lima_bergeron.f90
rename to src/common/micro/mode_lima_bergeron.F90
index 7a4967708e09ec8b49e850a2583fd47a7c04ee6d..7df06b07fb522fb373f86bd6211ef365729bd9a1 100644
--- a/src/mesonh/micro/lima_bergeron.f90
+++ b/src/common/micro/mode_lima_bergeron.F90
@@ -2,41 +2,14 @@
!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_LIMA_BERGERON
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_BERGERON (LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSSIW !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI
-!!
-END SUBROUTINE LIMA_BERGERON
-END INTERFACE
-END MODULE MODI_LIMA_BERGERON
-!
+MODULE MODE_LIMA_BERGERON
+ IMPLICIT NONE
+ CONTAINS
! #############################################################
- SUBROUTINE LIMA_BERGERON( LDCOMPUTE, &
- PRCT, PRIT, PCIT, PLBDI, &
- PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
- P_TH_BERFI, P_RC_BERFI )
+ SUBROUTINE LIMA_BERGERON( LDCOMPUTE, &
+ PRCT, PRIT, PCIT, PLBDI, &
+ PSSIW, PAI, PCJ, PLVFACT, PLSFACT, &
+ P_TH_BERFI, P_RC_BERFI )
! #############################################################
!
!! PURPOSE
@@ -99,3 +72,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_BERGERON
+END MODULE MODE_LIMA_BERGERON
diff --git a/src/mesonh/micro/lima_ccn_activation.f90 b/src/common/micro/mode_lima_ccn_activation.F90
similarity index 86%
rename from src/mesonh/micro/lima_ccn_activation.f90
rename to src/common/micro/mode_lima_ccn_activation.F90
index bac576fa00f953074ced8034ceeb6e1271f3aadb..1731dd8156a2f19ebaa201b3f7fad0e835e2d417 100644
--- a/src/mesonh/micro/lima_ccn_activation.f90
+++ b/src/common/micro/mode_lima_ccn_activation.F90
@@ -3,47 +3,15 @@
!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_LIMA_CCN_ACTIVATION
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
-!
-END SUBROUTINE LIMA_CCN_ACTIVATION
-END INTERFACE
-END MODULE MODI_LIMA_CCN_ACTIVATION
-! #############################################################################
- SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
-! #############################################################################
+MODULE MODE_LIMA_CCN_ACTIVATION
+ IMPLICIT NONE
+CONTAINS
+! ##############################################################################
+ SUBROUTINE LIMA_CCN_ACTIVATION (CST, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+! ##############################################################################
!
!!
!! PURPOSE
@@ -97,10 +65,10 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMNH_EPSILON, XMV, XRV, XTT
-use modd_field, only: TFIELDMETADATA, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_CST, ONLY: CST_t
+!use modd_field, only: TFIELDDATA, TYPEREAL
+!USE MODD_IO, ONLY: TFILEDATA
+!USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: LADJ, LACTIT, NMOD_CCN, XCTMIN, XKHEN_MULTI, XRTMIN, XLIMIT_FACTOR
USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
@@ -108,7 +76,7 @@ USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCST
XLBC, XLBEXC
USE MODD_TURB_n, ONLY: LSUBG_COND
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
USE MODI_GAMMA
@@ -117,7 +85,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+TYPE(CST_t), INTENT(IN) :: CST
+!TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -180,11 +149,11 @@ REAL :: ZS1, ZS2, ZXACC
INTEGER :: JMOD
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
!
-INTEGER :: ILUOUT ! Logical unit of output listing
-TYPE(TFIELDMETADATA) :: TZFIELD
+!!$INTEGER :: ILUOUT ! Logical unit of output listing
+!!$TYPE(TFIELDMETADATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
-ILUOUT = TLUOUT%NLU
+!ILUOUT = TLUOUT%NLU
!
!* 1. PREPARE COMPUTATIONS - PACK
! ---------------------------
@@ -198,8 +167,8 @@ IKE=SIZE(PRHODREF,3) - JPVEXT
!
! Saturation vapor mixing ratio and radiative tendency
!
-ZEPS= XMV / XMD
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
+ZEPS= CST%XMV / CST%XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-CST%XALPW+CST%XBETAW/PT(:,:,:)+CST%XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
!
@@ -222,7 +191,7 @@ IF (LADJ) THEN
.OR. ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN
!
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(CST%XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
!
IF (LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
@@ -231,7 +200,7 @@ IF (LADJ) THEN
.AND. PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
ELSE
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(CST%XTT-22.) &
.AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
END IF
!
@@ -285,7 +254,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZSMAX(INUCT))
IF (LADJ) THEN
ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
- + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+ + (((CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZT(:)-CST%XTT))/ZZT(:))**2)/(CST%XCPD*CST%XRV) ! Psi2
!
!
!-------------------------------------------------------------------------------
@@ -454,8 +423,8 @@ IF( INUCT >= 1 ) THEN
!
IF (.NOT.LSUBG_COND) THEN
ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
- PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
- (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(:,:,:)-CST%XTT))/ &
+ (PEXNREF(:,:,:)*(CST%XCPD+CST%XCPV*PRVT(:,:,:)+CST%XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
@@ -497,37 +466,36 @@ IF( INUCT >= 1 ) THEN
!
END IF ! INUCT
!
-IF ( tpfile%lopened ) THEN
- IF ( INUCT == 0 ) THEN
- ZW (:,:,:) = 0.
- ZW2(:,:,:) = 0.
- END IF
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SMAX', &
- CSTDNAME = '', &
- CLONGNAME = 'SMAX', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_SMAX', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'NACT', &
- CSTDNAME = '', &
- CLONGNAME = 'NACT', &
- CUNITS = 'kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_NACT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
-END IF
+!!$IF ( tpfile%lopened ) THEN
+!!$ IF ( INUCT == 0 ) THEN
+!!$ ZW (:,:,:) = 0.
+!!$ ZW2(:,:,:) = 0.
+!!$ END IF
+!!$
+!!$ TZFIELD%CMNHNAME ='SMAX'
+!!$ TZFIELD%CSTDNAME = ''
+!!$ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+!!$ TZFIELD%CUNITS = ''
+!!$ TZFIELD%CDIR = 'XY'
+!!$ TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
+!!$ TZFIELD%NGRID = 1
+!!$ TZFIELD%NTYPE = TYPEREAL
+!!$ TZFIELD%NDIMS = 3
+!!$ TZFIELD%LTIMEDEP = .TRUE.
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+!!$ !
+!!$ TZFIELD%CMNHNAME ='NACT'
+!!$ TZFIELD%CSTDNAME = ''
+!!$ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+!!$ TZFIELD%CUNITS = 'kg-1'
+!!$ TZFIELD%CDIR = 'XY'
+!!$ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+!!$ TZFIELD%NGRID = 1
+!!$ TZFIELD%NTYPE = TYPEREAL
+!!$ TZFIELD%NDIMS = 3
+!!$ TZFIELD%LTIMEDEP = .TRUE.
+!!$ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
+!!$END IF
!
!
!-------------------------------------------------------------------------------
@@ -770,7 +738,7 @@ INTEGER :: PIVEC1
ALLOCATE(PFUNCSMAX(NPTS))
!
PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
+PZVEC1 = MAX( ( 1.0 + 10.0 * CST%XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * CST%XMNH_EPSILON ) , &
XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
PIVEC1 = INT( PZVEC1 )
PZVEC1 = PZVEC1 - REAL( PIVEC1 )
@@ -849,3 +817,4 @@ END FUNCTION SINGL_FUNCSMAX
!-----------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CCN_ACTIVATION
+END MODULE MODE_LIMA_CCN_ACTIVATION
diff --git a/src/mesonh/micro/lima_ccn_hom_freezing.f90 b/src/common/micro/mode_lima_ccn_hom_freezing.F90
similarity index 78%
rename from src/mesonh/micro/lima_ccn_hom_freezing.f90
rename to src/common/micro/mode_lima_ccn_hom_freezing.F90
index 86b7a9408b864e7d93dde71f280c0ce432bf57a8..25744d42abb867dfca9935a86bb924329e49ee8e 100644
--- a/src/mesonh/micro/lima_ccn_hom_freezing.f90
+++ b/src/common/micro/mode_lima_ccn_hom_freezing.F90
@@ -3,48 +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_LIMA_CCN_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-!
-END SUBROUTINE LIMA_CCN_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_CCN_HOM_FREEZING
-!
+MODULE MODE_LIMA_CCN_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT , &
- PICEFR )
+ SUBROUTINE LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT , &
+ PICEFR )
! ##########################################################################
!
!! PURPOSE
@@ -69,9 +35,7 @@ END MODULE MODI_LIMA_CCN_HOM_FREEZING
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
+USE MODD_CST, ONLY: CST_t
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
@@ -89,6 +53,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
@@ -185,7 +150,7 @@ IKB=1+JPVEXT
IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
ZNHT(:,:,:) = PNHT(:,:,:)
!
@@ -193,7 +158,7 @@ ZNHT(:,:,:) = PNHT(:,:,:)
! PACK variables
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-35.0
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
IF (INEGT.GT.0) THEN
@@ -256,14 +221,14 @@ IF (INEGT.GT.0) THEN
ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
!
!-------------------------------------------------------------------------------
@@ -293,7 +258,7 @@ IF (INEGT.GT.0) THEN
!
ZZW(:) = 0.0
ZZX(:) = 0.0
- ZEPS = XMV / XMD
+ ZEPS = CST%XMV / CST%XMD
ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
(MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
!
@@ -303,19 +268,19 @@ IF (INEGT.GT.0) THEN
ALLOCATE(ZTAU(INEGT))
ALLOCATE(ZBFACT(INEGT))
!
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
- ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
+ WHERE( (ZZT(:)<CST%XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
+ ZLS(:) = CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:) ! Ls
!
- ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
+ ZPSI1(:) = ZZY(:) * (CST%XG/(CST%XRD*ZZT(:)))*(ZEPS*ZLS(:)/(CST%XCPD*ZZT(:))-1.)
! ! Psi1 (a1*Scr in KL01)
! BV correction PSI2 enlever 1/ZEPS ?
! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
- ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
+ ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(CST%XCPD*CST%XRV)
! ! Psi2 (a2+a3*Scr in KL01)
ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
- ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHT(:) ) )
+ ((ZPRES(:)/CST%XP00)**(CST%XRD/CST%XCPD))*ZTHT(:) ) )
!
ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
! BV correction ZBFACT enlever 1/ZEPS ?
@@ -395,3 +360,4 @@ END IF ! INEGT>0
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CCN_HOM_FREEZING
+END MODULE MODE_LIMA_CCN_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_collisional_ice_breakup.f90 b/src/common/micro/mode_lima_collisional_ice_breakup.F90
similarity index 90%
rename from src/mesonh/micro/lima_collisional_ice_breakup.f90
rename to src/common/micro/mode_lima_collisional_ice_breakup.F90
index a6848d14345bcdf23a70338347f5b8ab66940e7b..58a040f5af64a6c7b1b780d32a0b6ea0a448709a 100644
--- a/src/mesonh/micro/lima_collisional_ice_breakup.f90
+++ b/src/common/micro/mode_lima_collisional_ice_breakup.F90
@@ -3,43 +3,15 @@
!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_LIMA_COLLISIONAL_ICE_BREAKUP
-! ########################################
-!
-INTERFACE
- SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
- PRHODREF, &
- PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
- PLBDS, PLBDG, &
- P_RI_CIBU, P_CI_CIBU )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PRGT
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PCST
-REAL, DIMENSION(:), INTENT(IN) :: PCGT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CIBU
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CIBU
-!
-END SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP
-END INTERFACE
-END MODULE MODI_LIMA_COLLISIONAL_ICE_BREAKUP
-!
+MODULE MODE_LIMA_COLLISIONAL_ICE_BREAKUP
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
- PRHODREF, &
- PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
- PLBDS, PLBDG, &
- P_RI_CIBU, P_CI_CIBU )
+ SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP (LDCOMPUTE, &
+ PRHODREF, &
+ PRIT, PRST, PRGT, PCIT, PCST, PCGT, &
+ PLBDS, PLBDG, &
+ P_RI_CIBU, P_CI_CIBU )
! #######################################################################
!
!! PURPOSE
@@ -418,3 +390,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_COLLISIONAL_ICE_BREAKUP
+END MODULE MODE_LIMA_COLLISIONAL_ICE_BREAKUP
diff --git a/src/mesonh/micro/lima_compute_cloud_fractions.f90 b/src/common/micro/mode_lima_compute_cloud_fractions.F90
similarity index 56%
rename from src/mesonh/micro/lima_compute_cloud_fractions.f90
rename to src/common/micro/mode_lima_compute_cloud_fractions.F90
index bc861da682fa9484669c5ed33d05d189230c20be..98ac4ae517cd8b246674fd551efabd46b21cd441 100644
--- a/src/mesonh/micro/lima_compute_cloud_fractions.f90
+++ b/src/common/micro/mode_lima_compute_cloud_fractions.F90
@@ -3,62 +3,18 @@
!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_LIMA_COMPUTE_CLOUD_FRACTIONS
-!#######################################
- INTERFACE
- SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- PCCT, PRCT, &
- PCRT, PRRT, &
- PCIT, PRIT, &
- PCST, PRST, &
- PCGT, PRGT, &
- PCHT, PRHT, &
- PCLDFR, PICEFR, PPRCFR )
- INTEGER, INTENT(IN) :: KIB !
- INTEGER, INTENT(IN) :: KIE !
- INTEGER, INTENT(IN) :: KJB !
- INTEGER, INTENT(IN) :: KJE !
- INTEGER, INTENT(IN) :: KKB !
- INTEGER, INTENT(IN) :: KKE !
- INTEGER, INTENT(IN) :: KKL !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCST !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCGT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
- !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PCHT !
- REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
- !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
- REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
- !
- END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
- END INTERFACE
-END MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
-!
-!
+MODULE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS
+ IMPLICIT NONE
+CONTAINS
!################################################################
-SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- PCCT, PRCT, &
- PCRT, PRRT, &
- PCIT, PRIT, &
- PCST, PRST, &
- PCGT, PRGT, &
- PCHT, PRHT, &
- PCLDFR, PICEFR, PPRCFR )
+ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PCST, PRST, &
+ PCGT, PRGT, &
+ PCHT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
!################################################################
!
!!
@@ -79,6 +35,7 @@ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
!
@@ -86,13 +43,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB !
-INTEGER, INTENT(IN) :: KIE !
-INTEGER, INTENT(IN) :: KJB !
-INTEGER, INTENT(IN) :: KJE !
-INTEGER, INTENT(IN) :: KKB !
-INTEGER, INTENT(IN) :: KKE !
-INTEGER, INTENT(IN) :: KKL !
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
!
REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
@@ -134,14 +85,14 @@ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. (NMOM_I.EQ.1 .OR. P
!
! Precipitation fraction
!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
-!!$DO JI = KIB,KIE
-!!$ DO JJ = KJB, KJE
-!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$DO JI = D%NIB,D%NIE
+!!$ DO JJ = D%NJB, D%NJE
+!!$ DO JK=D%NKE-D%NKL, D%NKB, -D%NKL
!!$ IF ( (PRRT(JI,JJ,JK).GT.XRTMIN(3) .AND. PCRT(JI,JJ,JK).GT.XCTMIN(3)) .OR. &
!!$ PRST(JI,JJ,JK).GT.XRTMIN(5) .OR. &
!!$ PRGT(JI,JJ,JK).GT.XRTMIN(6) .OR. &
!!$ PRHT(JI,JJ,JK).GT.XRTMIN(7) ) THEN
-!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+D%NKL))
!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
!!$ PPRCFR(JI,JJ,JK)=1.
!!$ END IF
@@ -153,14 +104,14 @@ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. (NMOM_I.EQ.1 .OR. P
!!$END DO
!!$
!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
-!!$DO JI = KIB,KIE
-!!$ DO JJ = KJB, KJE
-!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$DO JI = D%NIB,D%NIE
+!!$ DO JJ = D%NJB, D%NJE
+!!$ DO JK=D%NKE-D%NKL, D%NKB, -D%NKL
!!$ IF ( (PRRT(JI,JJ,JK).GT.0. .AND. PCRT(JI,JJ,JK).GT.0.) .OR. &
!!$ PRST(JI,JJ,JK).GT.0. .OR. &
!!$ PRGT(JI,JJ,JK).GT.0. .OR. &
!!$ PRHT(JI,JJ,JK).GT.0. ) THEN
-!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+D%NKL))
!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
!!$ PPRCFR(JI,JJ,JK)=1.
!!$ END IF
@@ -186,3 +137,4 @@ WHERE ( (PRRT(:,:,:).GT.0. .AND. (NMOM_R.EQ.1 .OR. PCRT(:,:,:).GT.0.) ) .OR. &
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
+END MODULE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS
diff --git a/src/mesonh/micro/lima_conversion_melting_snow.f90 b/src/common/micro/mode_lima_conversion_melting_snow.F90
similarity index 68%
rename from src/mesonh/micro/lima_conversion_melting_snow.f90
rename to src/common/micro/mode_lima_conversion_melting_snow.F90
index ef46c794f37aee347aa52ea5bf8c338502b53801..0921e3f73188b680251bbae80789d0f74870c35c 100644
--- a/src/mesonh/micro/lima_conversion_melting_snow.f90
+++ b/src/common/micro/mode_lima_conversion_melting_snow.F90
@@ -3,42 +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_LIMA_CONVERSION_MELTING_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PCST, PLBDS, &
- P_RS_CMEL, P_CS_CMEL )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_CMEL
-!
-END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
-!
+MODULE MODE_LIMA_CONVERSION_MELTING_SNOW
+ IMPLICIT NONE
+CONTAINS
! ##############################################################################
- SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRST, PCST, PLBDS, &
- P_RS_CMEL, P_CS_CMEL )
+ SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRST, PCST, PLBDS, &
+ P_RS_CMEL, P_CS_CMEL )
! ##############################################################################
!
!! PURPOSE
@@ -127,3 +99,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
+END MODULE MODE_LIMA_CONVERSION_MELTING_SNOW
diff --git a/src/mesonh/micro/lima_droplets_accretion.f90 b/src/common/micro/mode_lima_droplets_accretion.F90
similarity index 75%
rename from src/mesonh/micro/lima_droplets_accretion.f90
rename to src/common/micro/mode_lima_droplets_accretion.F90
index d183953cd21da3563c87d7fc851af9bd76d10539..8e0119a4380f264f99c14f7c3e76426f049c175e 100644
--- a/src/mesonh/micro/lima_droplets_accretion.f90
+++ b/src/common/micro/mode_lima_droplets_accretion.F90
@@ -3,43 +3,15 @@
!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_LIMA_DROPLETS_ACCRETION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
-!
-END SUBROUTINE LIMA_DROPLETS_ACCRETION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_ACCRETION
-!
+MODULE MODE_LIMA_DROPLETS_ACCRETION
+ IMPLICIT NONE
+CONTAINS
! #####################################################################
- SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR )
+ SUBROUTINE LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PLBDC, PLBDC3, PLBDR, PLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
! #####################################################################
!
!! PURPOSE
@@ -190,3 +162,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_ACCRETION
+END MODULE MODE_LIMA_DROPLETS_ACCRETION
diff --git a/src/mesonh/micro/lima_droplets_autoconversion.f90 b/src/common/micro/mode_lima_droplets_autoconversion.F90
similarity index 72%
rename from src/mesonh/micro/lima_droplets_autoconversion.f90
rename to src/common/micro/mode_lima_droplets_autoconversion.F90
index 3fa32e7a65c04cff7af42821ceaa37fcbf7b374e..fca3fbf804de1e6b60bc4fd54a9073a4b04eb369 100644
--- a/src/mesonh/micro/lima_droplets_autoconversion.f90
+++ b/src/common/micro/mode_lima_droplets_autoconversion.F90
@@ -3,38 +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_LIMA_DROPLETS_AUTOCONVERSION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PCCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
-!
-END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
-!
+MODULE MODE_LIMA_DROPLETS_AUTOCONVERSION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PCCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+ SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
+ PRHODREF, &
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
! ##########################################################################
!
!! PURPOSE
@@ -100,8 +76,8 @@ IF (NMOM_C.EQ.1 .AND. LKESSLERAC) THEN
P_RC_AUTO(:) = - 1.E-3 * MAX ( PRCT(:) - 0.5E-3 / PRHODREF(:), 0. )
ELSE IF (LKHKO) THEN
!
-! 1. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
-! ----------------------------------------------------------------------
+! 1. Autoconversion of cloud droplets
+! -----------------------------------
!
WHERE ( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) )
!
@@ -148,3 +124,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
+END MODULE MODE_LIMA_DROPLETS_AUTOCONVERSION
diff --git a/src/mesonh/micro/lima_droplets_hom_freezing.f90 b/src/common/micro/mode_lima_droplets_hom_freezing.F90
similarity index 67%
rename from src/mesonh/micro/lima_droplets_hom_freezing.f90
rename to src/common/micro/mode_lima_droplets_hom_freezing.F90
index b33d7a3501fdf56c3925db691f50a11af30b2e5f..687e161ee34a2f9c138f4510f06f81b4e15035ba 100644
--- a/src/mesonh/micro/lima_droplets_hom_freezing.f90
+++ b/src/common/micro/mode_lima_droplets_hom_freezing.F90
@@ -2,40 +2,14 @@
!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_LIMA_DROPLETS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC ! Cloud water lambda
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC
-!
-END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_HOM_FREEZING
-!
+MODULE MODE_LIMA_DROPLETS_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PT, PLVFACT, PLSFACT, &
- PRCT, PCCT, PLBDC, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC )
+ SUBROUTINE LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PT, PLVFACT, PLSFACT, &
+ PRCT, PCCT, PLBDC, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC )
! ##########################################################################
!
!! PURPOSE
@@ -123,3 +97,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_HOM_FREEZING
+END MODULE MODE_LIMA_DROPLETS_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_droplets_riming_snow.f90 b/src/common/micro/mode_lima_droplets_riming_snow.F90
similarity index 76%
rename from src/mesonh/micro/lima_droplets_riming_snow.f90
rename to src/common/micro/mode_lima_droplets_riming_snow.F90
index cd46682388de1ab48cd16f98169998029eb2dca6..70ab95d4787ed23f3b4e12fb544d6c25f3edcf40 100644
--- a/src/mesonh/micro/lima_droplets_riming_snow.f90
+++ b/src/common/micro/mode_lima_droplets_riming_snow.F90
@@ -3,53 +3,15 @@
!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_LIMA_DROPLETS_RIMING_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
-!
-END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
-!
+MODULE MODE_LIMA_DROPLETS_RIMING_SNOW
+ IMPLICIT NONE
+CONTAINS
! #########################################################################################
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS )
+ SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
! #########################################################################################
!
!! PURPOSE
@@ -234,3 +196,4 @@ END DO
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
+END MODULE MODE_LIMA_DROPLETS_RIMING_SNOW
diff --git a/src/mesonh/micro/lima_droplets_self_collection.f90 b/src/common/micro/mode_lima_droplets_self_collection.F90
similarity index 63%
rename from src/mesonh/micro/lima_droplets_self_collection.f90
rename to src/common/micro/mode_lima_droplets_self_collection.F90
index 79312e8cb058055804d58a2d48c53f10a04deb65..6a4557c89610cb9cafac0c37c4c639926e4b9a90 100644
--- a/src/mesonh/micro/lima_droplets_self_collection.f90
+++ b/src/common/micro/mode_lima_droplets_self_collection.F90
@@ -3,34 +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_LIMA_DROPLETS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
-!
-END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
-!
+MODULE MODE_LIMA_DROPLETS_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, PLBDC3, &
- P_CC_SELF )
+ SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCCT, PLBDC3, &
+ P_CC_SELF )
! ######################################################################
!
!! PURPOSE
@@ -92,3 +72,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
+END MODULE MODE_LIMA_DROPLETS_SELF_COLLECTION
diff --git a/src/mesonh/micro/lima_drops_break_up.f90 b/src/common/micro/mode_lima_drops_break_up.F90
similarity index 71%
rename from src/mesonh/micro/lima_drops_break_up.f90
rename to src/common/micro/mode_lima_drops_break_up.F90
index 697c682469036cd49ecd2f8906efd9bdd1bdb093..e2b36c2ab18e6bfa233bd9c9e27f5c40bbb62927 100644
--- a/src/mesonh/micro/lima_drops_break_up.f90
+++ b/src/common/micro/mode_lima_drops_break_up.F90
@@ -2,36 +2,14 @@
!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_LIMA_DROPS_BREAK_UP
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
-!
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-!
-END SUBROUTINE LIMA_DROPS_BREAK_UP
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_BREAK_UP
-!
-!
+MODULE MODE_LIMA_DROPS_BREAK_UP
+ IMPLICIT NONE
+CONTAINS
! ##########################################
- SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-
+ SUBROUTINE LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
! ##########################################
!
!!
@@ -98,3 +76,4 @@ PB_CR(:) = PB_CR(:) + P_CR_BRKU(:)
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_BREAK_UP
+END MODULE MODE_LIMA_DROPS_BREAK_UP
diff --git a/src/mesonh/micro/lima_drops_hom_freezing.f90 b/src/common/micro/mode_lima_drops_hom_freezing.F90
similarity index 59%
rename from src/mesonh/micro/lima_drops_hom_freezing.f90
rename to src/common/micro/mode_lima_drops_hom_freezing.F90
index b8382155bd2b89953b7a60ae0f54063d4c99af8e..1d3e289dbaad05153f76fc9dd95c23226010cec3 100644
--- a/src/mesonh/micro/lima_drops_hom_freezing.f90
+++ b/src/common/micro/mode_lima_drops_hom_freezing.F90
@@ -2,53 +2,16 @@
!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_LIMA_DROPS_HOM_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HONR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
-!
-END SUBROUTINE LIMA_DROPS_HOM_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_HOM_FREEZING
-!
+MODULE MODE_LIMA_DROPS_HOM_FREEZING
+ IMPLICIT NONE
+CONTAINS
! ###############################################################################
- SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
+ SUBROUTINE LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
! ###############################################################################
!
!! PURPOSE
@@ -142,3 +105,4 @@ ENDWHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_HOM_FREEZING
+END MODULE MODE_LIMA_DROPS_HOM_FREEZING
diff --git a/src/mesonh/micro/lima_drops_self_collection.f90 b/src/common/micro/mode_lima_drops_self_collection.F90
similarity index 73%
rename from src/mesonh/micro/lima_drops_self_collection.f90
rename to src/common/micro/mode_lima_drops_self_collection.F90
index 3f064dfcdc0f19a5124562e4d8a5658f2a31a7c5..0c16b69b4d41c53ba69667de98731a79df209c38 100644
--- a/src/mesonh/micro/lima_drops_self_collection.f90
+++ b/src/common/micro/mode_lima_drops_self_collection.F90
@@ -3,35 +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_LIMA_DROPS_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
-!
-END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_SELF_COLLECTION
-!
+MODULE MODE_LIMA_DROPS_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU )
+ SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, &
+ PCRT, PLBDR, PLBDR3, &
+ P_CR_SCBU )
! #############################################################
!
!! PURPOSE
@@ -121,3 +100,4 @@ P_CR_SCBU(:) = - ZW3(:) * PRHODREF(:)
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
+END MODULE MODE_LIMA_DROPS_SELF_COLLECTION
diff --git a/src/mesonh/micro/lima_drops_to_droplets_conv.f90 b/src/common/micro/mode_lima_drops_to_droplets_conv.F90
similarity index 69%
rename from src/mesonh/micro/lima_drops_to_droplets_conv.f90
rename to src/common/micro/mode_lima_drops_to_droplets_conv.F90
index b2c63fde29ab9a752faf1669c721d3cce9b47037..808bed2403a360d48509250e1925cea5d12a25ca 100644
--- a/src/mesonh/micro/lima_drops_to_droplets_conv.f90
+++ b/src/common/micro/mode_lima_drops_to_droplets_conv.F90
@@ -2,31 +2,12 @@
!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_LIMA_DROPS_TO_DROPLETS_CONV
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
- P_RR_CVRC, P_CR_CVRC )
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RR_CVRC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CR_CVRC
-!
-END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
-END INTERFACE
-END MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
-!
+MODULE MODE_LIMA_DROPS_TO_DROPLETS_CONV
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (PRHODREF, PRCT, PRRT, PCCT, PCRT, &
- P_RR_CVRC, P_CR_CVRC )
+ SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV (CST, PRHODREF, PRCT, PRRT, PCCT, PCRT, &
+ P_RR_CVRC, P_CR_CVRC )
! ######################################################################
!
!! PURPOSE
@@ -50,7 +31,7 @@ END MODULE MODI_LIMA_DROPS_TO_DROPLETS_CONV
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XPI, XRHOLW
+USE MODD_CST, ONLY : CST_t
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY : XLBR, XLBEXR, XLBC, XLBEXC, &
XACCR1, XACCR3, XACCR4, XACCR5
@@ -59,6 +40,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
@@ -88,7 +71,7 @@ ZDR(:,:,:) = 9999.
ZMASKR(:,:,:) = PRRT(:,:,:).GT.XRTMIN(3) .AND. PCRT(:,:,:).GT.XCTMIN(3)
ZMASKC(:,:,:) = PRCT(:,:,:).GT.XRTMIN(2) .AND. PCCT(:,:,:).GT.XCTMIN(2)
WHERE(ZMASKR(:,:,:))
- ZDR(:,:,:)=(6.*PRRT(:,:,:)/XPI/XRHOLW/PCRT(:,:,:))**0.33
+ ZDR(:,:,:)=(6.*PRRT(:,:,:)/CST%XPI/CST%XRHOLW/PCRT(:,:,:))**0.33
END WHERE
!
! Transfer all drops in droplets if out of cloud and Dr<82microns
@@ -101,3 +84,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_DROPS_TO_DROPLETS_CONV
+END MODULE MODE_LIMA_DROPS_TO_DROPLETS_CONV
diff --git a/src/common/micro/mode_lima_functions.F90 b/src/common/micro/mode_lima_functions.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c65e6e23cbca066c1e02102e150f1284118134eb
--- /dev/null
+++ b/src/common/micro/mode_lima_functions.F90
@@ -0,0 +1,244 @@
+!MNH_LIC Copyright 2016-2019 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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 19/04/2019: use modd_precision kinds
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!-----------------------------------------------------------------
+MODULE MODE_LIMA_FUNCTIONS
+ IMPLICIT NONE
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+! Pth moment order of the generalized gamma law
+ USE MODI_GAMMA
+ IMPLICIT NONE
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+ PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
+ END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
+! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+ PRECT(:) = PB
+ WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
+ PRECT(:) = PA
+ END WHERE
+ RETURN
+ END FUNCTION RECT
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
+! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
+! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+ REAL :: ZA
+ ZA = 6.0*(PA-PB)/(PX2-PX1)**3
+ WHERE (PX(:).LT.PX1)
+ PDELTA(:) = PA
+ ELSEWHERE (PX(:).GE.PX2)
+ PDELTA(:) = PB
+ ELSEWHERE
+ PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
+ + ZA*PX1*PX2* (PX(:)) &
+ - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
+ + (ZA/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+ END FUNCTION DELTA
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
+! Same as DELTA for vectorized PX1 and PX2 arguments
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+ REAL, DIMENSION(SIZE(PX,1)) :: ZA
+ ZA(:) = 0.0
+ wHERE (PX(:)<=PX1(:))
+ PDELTA_VEC(:) = PA
+ ELSEWHERE (PX(:)>=PX2(:))
+ PDELTA_VEC(:) = PB
+ ELSEWHERE
+ ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
+ PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
+ + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
+ - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
+ + (ZA(:)/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+ END FUNCTION DELTA_VEC
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE gaulag(x,w,n,alf)
+ use modd_precision, only: MNHREAL64
+ INTEGER n,MAXIT
+ REAL alf,w(n),x(n)
+ REAL(kind=MNHREAL64) :: EPS
+ PARAMETER (EPS=3.D-14,MAXIT=10)
+ INTEGER i,its,j
+ REAL ai
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ do 13 i=1,n
+ if(i.eq.1)then
+ z=(1.+alf)*(3.+.92*alf)/(1.+2.4*n+1.8*alf)
+ else if(i.eq.2)then
+ z=z+(15.+6.25*alf)/(1.+.9*alf+2.5*n)
+ else
+ ai=i-2
+ z=z+((1.+2.55*ai)/(1.9*ai)+1.26*ai*alf/(1.+3.5*ai))* &
+ (z-x(i-2))/(1.+.3*alf)
+ endif
+ do 12 its=1,MAXIT
+ p1=1.d0
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j
+11 continue
+ pp=(n*p1-(n+alf)*p2)/z
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ w(i)=-exp(gammln(alf+n)-gammln(real(n)))/(pp*n*p2)
+13 continue
+! NORMALISATION
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gaulag
+!
+!------------------------------------------------------------------------------
+!
+SUBROUTINE gauher(x,w,n)
+ use modd_precision, only: MNHREAL64
+ INTEGER n,MAXIT
+ REAL w(n),x(n)
+ REAL(kind=MNHREAL64) :: EPS,PIM4
+ PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
+ INTEGER i,its,j,m
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ m=(n+1)/2
+ do 13 i=1,m
+ if(i.eq.1)then
+ z=sqrt(real(2*n+1))-1.85575*(2*n+1)**(-.16667)
+ else if(i.eq.2)then
+ z=z-1.14*n**.426/z
+ else if (i.eq.3)then
+ z=1.86*z-.86*x(1)
+ else if (i.eq.4)then
+ z=1.91*z-.91*x(2)
+ else
+ z=2.*z-x(i-2)
+ endif
+ do 12 its=1,MAXIT
+ p1=PIM4
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=z*sqrt(2.d0/j)*p2-sqrt(dble(j-1)/dble(j))*p3
+11 continue
+ pp=sqrt(2.d0*n)*p2
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ x(n+1-i)=-z
+ pp=pp/PIM4 ! NORMALIZATION
+ w(i)=2.0/(pp*pp)
+ w(n+1-i)=w(i)
+13 continue
+! NORMALISATION
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gauher
+!
+!------------------------------------------------------------------------------
+!
+FUNCTION ARTH(FIRST,INCREMENT,N)
+ REAL,INTENT(IN) :: FIRST,INCREMENT
+ INTEGER,INTENT(IN) :: N
+ REAL,DIMENSION(N) :: ARTH
+ INTEGER :: K
+ DO K=1,N
+ ARTH(K)=FIRST+INCREMENT*(K-1)
+ END DO
+END FUNCTION ARTH
+!
+!------------------------------------------------------------------------------
+!
+FUNCTION gammln(xx)
+ IMPLICIT NONE
+ REAL, INTENT(IN) :: xx
+ REAL :: gammln
+ REAL :: tmp,x
+ REAL :: stp = 2.5066282746310005
+ REAL, DIMENSION(6) :: coef = (/76.18009172947146,&
+ -86.50532032941677,24.01409824083091,&
+ -1.231739572450155,0.1208650973866179e-2,&
+ -0.5395239384953e-5/)
+ x=xx
+ tmp=x+5.5
+ tmp=(x+0.5)*log(tmp)-tmp
+ gammln=tmp+log(stp*(1.000000000190015+&
+ sum(coef(:)/arth(x+1.,1.,size(coef))))/x)
+END FUNCTION gammln
+!
+!------------------------------------------------------------------------------
+!
+END MODULE MODE_LIMA_FUNCTIONS
diff --git a/src/mesonh/micro/lima_graupel.f90 b/src/common/micro/mode_lima_graupel.F90
similarity index 78%
rename from src/mesonh/micro/lima_graupel.f90
rename to src/common/micro/mode_lima_graupel.F90
index 8c96d2e0957a34003e2c4ff6ff5bf10b7bebcda1..42dfa71fbae577e18dab94b672e7be2cb42dae02 100644
--- a/src/mesonh/micro/lima_graupel.f90
+++ b/src/common/micro/mode_lima_graupel.F90
@@ -3,123 +3,24 @@
!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_LIMA_GRAUPEL
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PCST, PCGT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_GMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-END SUBROUTINE LIMA_GRAUPEL
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL
-!
+MODULE MODE_LIMA_GRAUPEL
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PCST, PCGT, &
- PLBDC, PLBDR, PLBDS, PLBDG, &
- PLVFACT, PLSFACT, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
+ SUBROUTINE LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
! #################################################################################
!
!! PURPOSE
@@ -146,7 +47,7 @@ END MODULE MODI_LIMA_GRAUPEL
! ------------
!
USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, LHAIL
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, NMOM_H
USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC, &
XFCDRYG, XFIDRYG, XCOLIG, XCOLSG, XCOLEXIG, XCOLEXSG, &
XFSDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XKER_SDRYG, &
@@ -487,7 +388,7 @@ END WHERE
!
ZZW(:) = 0.0
NHAIL = 0.
-IF (LHAIL) NHAIL = 1.
+IF (NMOM_H.GE.1) NHAIL = 1.
WHERE( LDCOMPUTE(:) .AND. PRGT(:)>XRTMIN(6) .AND. PCGT(:)>XCTMIN(6) .AND. PT(:)<XTT .AND. &
(ZRDRYG(:)-ZZW2(:)-ZZW3(:))>=(ZRWETG(:)-ZZW5(:)-ZZW6(:)) .AND. ZRWETG(:)-ZZW5(:)-ZZW6(:)>0.0 )
!
@@ -668,3 +569,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_GRAUPEL
+END MODULE MODE_LIMA_GRAUPEL
diff --git a/src/mesonh/micro/lima_graupel_deposition.f90 b/src/common/micro/mode_lima_graupel_deposition.F90
similarity index 65%
rename from src/mesonh/micro/lima_graupel_deposition.f90
rename to src/common/micro/mode_lima_graupel_deposition.F90
index 83b28e3d202d33d6339b48fd0d81b7f5b79cdc5b..14e970084e17abc54a598dd2720b5e1e84156e84 100644
--- a/src/mesonh/micro/lima_graupel_deposition.f90
+++ b/src/common/micro/mode_lima_graupel_deposition.F90
@@ -3,37 +3,13 @@
!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_LIMA_GRAUPEL_DEPOSITION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! graupel mr
-REAL, DIMENSION(:), INTENT(IN) :: PCGT ! graupel conc
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
-!!
-END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_GRAUPEL_DEPOSITION
-!
+MODULE MODE_LIMA_GRAUPEL_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ###########################################################################
- SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG )
+ SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRGT, PCGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
! ###########################################################################
!
!! PURPOSE
@@ -98,3 +74,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
+END MODULE MODE_LIMA_GRAUPEL_DEPOSITION
diff --git a/src/mesonh/micro/lima_hail.f90 b/src/common/micro/mode_lima_hail.F90
similarity index 78%
rename from src/mesonh/micro/lima_hail.f90
rename to src/common/micro/mode_lima_hail.F90
index 8392316ae4106fd1e9ed2cbb4f22d287b084818e..4d1fef9038708a7578e9491e8cccc2b215d2fb65 100644
--- a/src/mesonh/micro/lima_hail.f90
+++ b/src/common/micro/mode_lima_hail.F90
@@ -3,110 +3,22 @@
!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_LIMA_HAIL
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
- PLVFACT, PLSFACT, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPRES !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PKA !
-REAL, DIMENSION(:), INTENT(IN) :: PDV !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-REAL, DIMENSION(:), INTENT(IN) :: PCHT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDG !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDH !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_COHG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_COHG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CH_HMLT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-END SUBROUTINE LIMA_HAIL
-END INTERFACE
-END MODULE MODI_LIMA_HAIL
-!
+MODULE MODE_LIMA_HAIL
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
- PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
- PLVFACT, PLSFACT, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
+ SUBROUTINE LIMA_HAIL (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
+ PLBDC, PLBDR, PLBDS, PLBDG, PLBDH, &
+ PLVFACT, PLSFACT, &
+ P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
+ P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
+ P_RG_COHG, P_CG_COHG, &
+ P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
+ PA_TH, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
! #################################################################################
!
!! PURPOSE
@@ -133,7 +45,7 @@ END MODULE MODI_LIMA_HAIL
! ------------
!
USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, LHAIL
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT
USE MODD_PARAM_LIMA_MIXED, ONLY : NWETLBDAG, XWETINTP1G, XWETINTP2G, &
NWETLBDAH, X0DEPH, X1DEPH, XDH, XEX0DEPH, XEX1DEPH, &
XFWETH, XWETINTP1H, XWETINTP2H, &
@@ -574,3 +486,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_HAIL
+END MODULE MODE_LIMA_HAIL
diff --git a/src/mesonh/micro/lima_hail_deposition.f90 b/src/common/micro/mode_lima_hail_deposition.F90
similarity index 65%
rename from src/mesonh/micro/lima_hail_deposition.f90
rename to src/common/micro/mode_lima_hail_deposition.F90
index 1b411138fdfc344c7ab8cdc4043bc37e737baa2e..50eae03d08804182d5da09f0eefcf8fc30bed701 100644
--- a/src/mesonh/micro/lima_hail_deposition.f90
+++ b/src/common/micro/mode_lima_hail_deposition.F90
@@ -3,37 +3,13 @@
!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_LIMA_HAIL_DEPOSITION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
- P_TH_DEPH, P_RH_DEPH )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! hail mr
-REAL, DIMENSION(:), INTENT(IN) :: PCHT ! hail conc
-REAL, DIMENSION(:), INTENT(IN) :: PSSI !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDH !
-REAL, DIMENSION(:), INTENT(IN) :: PAI !
-REAL, DIMENSION(:), INTENT(IN) :: PCJ !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_DEPH
-!!
-END SUBROUTINE LIMA_HAIL_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_HAIL_DEPOSITION
-!
+MODULE MODE_LIMA_HAIL_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ###########################################################################
- SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
- P_TH_DEPH, P_RH_DEPH )
+ SUBROUTINE LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, &
+ PRHT, PCHT, PSSI, PLBDH, PAI, PCJ, PLSFACT, &
+ P_TH_DEPH, P_RH_DEPH )
! ###########################################################################
!
!! PURPOSE
@@ -98,3 +74,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_HAIL_DEPOSITION
+END MODULE MODE_LIMA_HAIL_DEPOSITION
diff --git a/src/common/micro/mode_lima_ice4_nucleation.F90 b/src/common/micro/mode_lima_ice4_nucleation.F90
new file mode 100644
index 0000000000000000000000000000000000000000..082b3c3e5f86ba5343e2bf2a243c58feb3a98253
--- /dev/null
+++ b/src/common/micro/mode_lima_ice4_nucleation.F90
@@ -0,0 +1,147 @@
+!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_LIMA_ICE4_NUCLEATION
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE LIMA_ICE4_NUCLEATION(CST, KSIZE, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the nucleation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! R. El Khatib 24-Aug-2021 Optimizations
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: CST_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_PARAM_LIMA_COLD, ONLY : XALPHA1, XBETA1, XALPHA2, XBETA2, XNU10, XNU20, XMNU0
+USE MODD_PARAM_LIMA, ONLY: LFEEDBACKT, XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(CST_t), INTENT(IN) :: CST
+INTEGER, INTENT(IN) :: KSIZE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(KSIZE) :: ZW ! work array
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+INTEGER :: JI
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('LIMA_ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
+!
+!$mnh_expand_where(JI=1:KSIZE)
+GNEGT(:)=PT(:)<CST%XTT .AND. PRVT(:)>XRTMIN(1)
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZUSW(:)=0.
+ZZW(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ALOG(PT(:))
+ ZUSW(:)=EXP(CST%XALPW - CST%XBETAW/PT(:) - CST%XGAMW*ZZW(:)) ! es_w
+ ZZW(:)=EXP(CST%XALPI - CST%XBETAI/PT(:) - CST%XGAMI*ZZW(:)) ! es_i
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZSSI(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (CST%XEPSILO*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
+ ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZZW(:)=0.
+DO JI=1,KSIZE
+ IF(GNEGT(JI)) THEN
+ IF(PT(JI)<CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=XNU20*EXP(XALPHA2*ZSSI(JI)-XBETA2)
+ ELSEIF(PT(JI)<=CST%XTT-2.0 .AND. PT(JI)>=CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=MAX(XNU20*EXP(-XBETA2 ), &
+ XNU10*EXP(-XBETA1*(PT(JI)-CST%XTT))*(ZSSI(JI)/ZUSW(JI))**XALPHA1)
+ ENDIF
+ ENDIF
+ENDDO
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ZZW(:)-PCIT(:)
+ ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+PRVHENI_MR(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ !
+ !* 3.1.2 update the r_i and r_v mixing ratios
+ !
+ PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
+ PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+!Limitation due to 0 crossing of temperature
+IF(LFEEDBACKT) THEN
+ ZW(:)=0.
+ !$mnh_expand_where(JI=1:KSIZE)
+ WHERE(GNEGT(:))
+ ZW(:)=MIN(PRVHENI_MR(:), &
+ MAX(0., (CST%XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
+ MAX(PRVHENI_MR(:), 1.E-20)
+ END WHERE
+ PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
+ ZZW(:)=ZZW(:)*ZW(:)
+ !$mnh_end_expand_where(JI=1:KSIZE)
+ENDIF
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+!
+IF (LHOOK) CALL DR_HOOK('LIMA_ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
+END SUBROUTINE LIMA_ICE4_NUCLEATION
+END MODULE MODE_LIMA_ICE4_NUCLEATION
diff --git a/src/mesonh/micro/lima_ice_aggregation_snow.f90 b/src/common/micro/mode_lima_ice_aggregation_snow.F90
similarity index 72%
rename from src/mesonh/micro/lima_ice_aggregation_snow.f90
rename to src/common/micro/mode_lima_ice_aggregation_snow.F90
index 26b23005738fe4202944cb83e51d634d403aeede..03f4c10b228955877104f014612422e0374ce9d2 100644
--- a/src/mesonh/micro/lima_ice_aggregation_snow.f90
+++ b/src/common/micro/mode_lima_ice_aggregation_snow.F90
@@ -3,40 +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_LIMA_ICE_AGGREGATION_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
- PT, PRHODREF, &
- PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PRST
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PCST
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
-!
-END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
-!
+MODULE MODE_LIMA_ICE_AGGREGATION_SNOW
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
- PT, PRHODREF, &
- PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS )
+ SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
+ PT, PRHODREF, &
+ PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
! #######################################################################
!
!! PURPOSE
@@ -134,3 +108,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
+END MODULE MODE_LIMA_ICE_AGGREGATION_SNOW
diff --git a/src/mesonh/micro/lima_ice_deposition.f90 b/src/common/micro/mode_lima_ice_deposition.F90
similarity index 72%
rename from src/mesonh/micro/lima_ice_deposition.f90
rename to src/common/micro/mode_lima_ice_deposition.F90
index b9ca8ed7558349a6f1da6296770fd7a5e0a4c3d2..ed7540ca238a6898c0c9c4a61ac52eaad60d2035 100644
--- a/src/mesonh/micro/lima_ice_deposition.f90
+++ b/src/common/micro/mode_lima_ice_deposition.F90
@@ -3,48 +3,15 @@
!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_LIMA_ICE_DEPOSITION
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PCIT, PLBDI, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
-!
-END SUBROUTINE LIMA_ICE_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_ICE_DEPOSITION
-!
+MODULE MODE_LIMA_ICE_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
-SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
- PRIT, PCIT, PLBDI, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS )
+ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
! ##########################################################################
!
!! PURPOSE
@@ -74,7 +41,7 @@ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
! ------------
!
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS,&
- LSNOW, NMOM_I
+ NMOM_I, NMOM_S
USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
@@ -177,9 +144,10 @@ ELSE
END WHERE
END IF
!
-IF (.NOT.LSNOW) THEN
+IF (NMOM_S.EQ.0) THEN
P_RI_CNVS(:) = 0.
P_CI_CNVS(:) = 0.
END IF
!
END SUBROUTINE LIMA_ICE_DEPOSITION
+END MODULE MODE_LIMA_ICE_DEPOSITION
diff --git a/src/mesonh/micro/lima_ice_melting.f90 b/src/common/micro/mode_lima_ice_melting.F90
similarity index 60%
rename from src/mesonh/micro/lima_ice_melting.f90
rename to src/common/micro/mode_lima_ice_melting.F90
index a95f45044056fda9664059a03b549d2395581639..e2e7b475ec9a9c622bab7d00b003b6f4997ce240 100644
--- a/src/mesonh/micro/lima_ice_melting.f90
+++ b/src/common/micro/mode_lima_ice_melting.F90
@@ -2,56 +2,16 @@
!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_LIMA_ICE_MELTING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Rain water C. at t
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! Nucleated IFN C. at t
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_IMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PB_CI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN
-!
-END SUBROUTINE LIMA_ICE_MELTING
-END INTERFACE
-END MODULE MODI_LIMA_ICE_MELTING
-!
+MODULE MODE_LIMA_ICE_MELTING
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+ SUBROUTINE LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
! ########################################################################
!
!! PURPOSE
@@ -162,3 +122,4 @@ ENDDO
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_ICE_MELTING
+END MODULE MODE_LIMA_ICE_MELTING
diff --git a/src/mesonh/micro/lima_init_ccn_activation_spectrum.f90 b/src/common/micro/mode_lima_init_ccn_activation_spectrum.F90
similarity index 93%
rename from src/mesonh/micro/lima_init_ccn_activation_spectrum.f90
rename to src/common/micro/mode_lima_init_ccn_activation_spectrum.F90
index 4403f97025e2c04b8f823efd603eec3accbb28ef..c11b9222e8a25524ee32b40d0a16b49c0abd7077 100644
--- a/src/mesonh/micro/lima_init_ccn_activation_spectrum.f90
+++ b/src/common/micro/mode_lima_init_ccn_activation_spectrum.F90
@@ -3,27 +3,11 @@
!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_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
-INTERFACE
- SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
- !
- CHARACTER(LEN=*), INTENT(IN) :: CTYPE_CCN ! Aerosol type
- REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
- REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
- REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
- REAL, INTENT(OUT) :: XK ! k
- REAL, INTENT(OUT) :: XMU ! mu
- REAL, INTENT(OUT) :: XBETA ! beta
- REAL, INTENT(OUT) :: XKAPPA ! kappa
-!
- END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
-END INTERFACE
-END MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
-! ####################
-!
+MODULE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
! #############################################################
!!
@@ -456,3 +440,4 @@ END FUNCTION DSDD
!
!------------------------------------------------------------------------------
END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+END MODULE MODE_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
diff --git a/src/common/micro/mode_lima_inst_procs.F90 b/src/common/micro/mode_lima_inst_procs.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0deeb85fa8652fa12103407a5fc1b0ad2b8a7712
--- /dev/null
+++ b/src/common/micro/mode_lima_inst_procs.F90
@@ -0,0 +1,133 @@
+!MNH_LIC Copyright 2018-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_LIMA_INST_PROCS
+ IMPLICIT NONE
+CONTAINS
+! ###########################################################################
+ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PINT, &
+ P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
+ PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
+ PB_CC, PB_CR, PB_CI, &
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
+! ###########################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute sources of instantaneous microphysical processes for the
+!! time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!
+USE MODD_PARAM_LIMA, ONLY : NMOM_C, NMOM_R, NMOM_I, NMOM_G
+!
+USE MODE_LIMA_DROPS_BREAK_UP, ONLY: LIMA_DROPS_BREAK_UP
+USE MODE_LIMA_DROPS_HOM_FREEZING, ONLY: LIMA_DROPS_HOM_FREEZING
+USE MODE_LIMA_ICE_MELTING, ONLY: LIMA_ICE_MELTING
+
+IMPLICIT NONE
+
+
+
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
+REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMOM_R.GE.2) THEN
+ CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PCRT, PRRT, &
+ P_CR_BRKU, &
+ PB_CR )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMOM_G.GE.1 .AND. NMOM_R.GE.1) THEN
+ CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCRT, &
+ P_TH_HONR, P_RR_HONR, P_CR_HONR, &
+ PB_TH, PB_RR, PB_CR, PB_RG )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMOM_C.GE.1 .AND. NMOM_I.GE.1) THEN
+ CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PEXNREF, PPABST, & ! but ice fraction becomes cloud fraction
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & ! -> where ?
+ PCIT, PINT, &
+ P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
+ PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+ !
+ !PCF1D(:)=MAX(PCF1D(:),PIF1D(:))
+ !PIF1D(:)=0.
+ !
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_INST_PROCS
+END MODULE MODE_LIMA_INST_PROCS
diff --git a/src/mesonh/micro/lima_meyers_nucleation.f90 b/src/common/micro/mode_lima_meyers_nucleation.F90
similarity index 71%
rename from src/mesonh/micro/lima_meyers_nucleation.f90
rename to src/common/micro/mode_lima_meyers_nucleation.F90
index f0c38fd6ad95ec88b8b3517646347640ce7f9091..989c3562cbcac6400404794c726c1c6f7237fe2d 100644
--- a/src/mesonh/micro/lima_meyers_nucleation.f90
+++ b/src/common/micro/mode_lima_meyers_nucleation.F90
@@ -3,58 +3,17 @@
!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_LIMA_MEYERS_NUCLEATION
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
-!
-END SUBROUTINE LIMA_MEYERS_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_MEYERS_NUCLEATION
-!
+MODULE MODE_LIMA_MEYERS_NUCLEATION
+ IMPLICIT NONE
+CONTAINS
! #############################################################################
- SUBROUTINE LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
+ SUBROUTINE LIMA_MEYERS_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #############################################################################
!!
!! PURPOSE
@@ -80,8 +39,7 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
@@ -92,6 +50,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -188,12 +147,12 @@ IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -202,7 +161,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
! the temperature is negative only !!!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
IF( INEGT >= 1 ) THEN
@@ -251,14 +210,14 @@ IF( INEGT >= 1 ) THEN
ALLOCATE(ZSSI(INEGT))
ALLOCATE(ZTCELSIUS(INEGT))
!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZTCELSIUS(:) = MAX( ZZT(:)-CST%XTT,-50.0 )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
- ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:)) ) ! es_i
+ ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) - 1.0
! Supersaturation over ice
!
!---------------------------------------------------------------------------
@@ -272,7 +231,7 @@ IF( INEGT >= 1 ) THEN
ZZX(:) = 0.0
ZZY(:) = 0.0
!
- WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ WHERE( ZZT(:)<CST%XTT-5.0 .AND. ZSSI(:)>0.0 )
ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/ZRHODREF(:)
ZZX(:) = MAX( ZZY(:)-ZINT(:,1) , 0.0 ) ! number of ice crystals formed at this time step #/kg
ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVT(:) ) ! mass of ice formed at this time step (kg/kg)
@@ -299,7 +258,7 @@ IF( INEGT >= 1 ) THEN
ZZX(:) = 0.0
ZZY(:) = 0.0
!
- WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
+ WHERE( ZZT(:)<CST%XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
/ZRHODREF(:) , ZCCT(:) )
ZZX(:) = MAX( ZZY(:)-ZINT(:,1),0.0 )
@@ -346,3 +305,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_MEYERS_NUCLEATION
+END MODULE MODE_LIMA_MEYERS_NUCLEATION
diff --git a/src/common/micro/mode_lima_nucleation_procs.F90 b/src/common/micro/mode_lima_nucleation_procs.F90
new file mode 100644
index 0000000000000000000000000000000000000000..502d8a3c52e2dd9f4b57e27a66b7051cf96a1244
--- /dev/null
+++ b/src/common/micro/mode_lima_nucleation_procs.F90
@@ -0,0 +1,380 @@
+!MNH_LIC Copyright 2018-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_LIMA_NUCLEATION_PROCS
+ IMPLICIT NONE
+CONTAINS
+! #############################################################################
+ SUBROUTINE LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+! #############################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute nucleation processes for the time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
+! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
+! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! B. Vie 03/2022: Add option for 1-moment pristine ice
+!-------------------------------------------------------------------------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+use modd_budget, only: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1
+!USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+ NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+USE MODD_PARAM_LIMA, ONLY : LNUCL, LMEYERS, LACTI, LHHONI, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
+USE MODD_TURB_n, ONLY : LSUBG_COND
+
+use mode_budget, only: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
+USE MODE_LIMA_CCN_HOM_FREEZING, ONLY: LIMA_CCN_HOM_FREEZING
+USE MODE_LIMA_MEYERS_NUCLEATION, ONLY: LIMA_MEYERS_NUCLEATION
+USE MODE_LIMA_PHILLIPS_IFN_NUCLEATION, ONLY: LIMA_PHILLIPS_IFN_NUCLEATION
+USE MODE_LIMA_ICE4_NUCLEATION, ONLY: LIMA_ICE4_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+!TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHT ! Hail m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
+!-------------------------------------------------------------------------------
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZCIT, ZLSFACT, ZRVHENIMR
+!
+integer :: idx, jl
+INTEGER :: JI,JJ
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
+
+ IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
+
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_CCN_ACTIVATION( CST, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ END IF
+
+ WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_sv ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_PHILLIPS_IFN_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ if (nmom_c.ge.2) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
+ CALL LIMA_MEYERS_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+ !
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ifn_nucl), 'HIND', &
+ z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rc ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ if (nmom_c.ge.2) then
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ifn_nucl), 'HINC', &
+ -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LNUCL .AND. NMOM_I.EQ.1) THEN
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+ !
+ ZLSFACT(:,:,:)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(PT(:,:,:)-CST%XTT)) / &
+ ( ( CST%XCPD + &
+ CST%XCPV*PRVT(:,:,:) + &
+ CST%XCL*(PRCT(:,:,:)+PRRT(:,:,:)) + &
+ CST%XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)) ) * PEXNREF(:,:,:) )
+ DO JI = 1, SIZE(PTHT,1)
+ DO JJ = 1, SIZE(PTHT,2)
+ CALL LIMA_ICE4_NUCLEATION(CST, SIZE(PTHT,3), &
+ PTHT(JI,JJ,:), PPABST(JI,JJ,:), PRHODREF(JI,JJ,:), PEXNREF(JI,JJ,:), ZLSFACT(JI,JJ,:), PT(JI,JJ,:), &
+ PRVT(JI,JJ,:), &
+ ZCIT(JI,JJ,:), ZRVHENIMR(JI,JJ,:) )
+ END DO
+ END DO
+ !
+! Z_TH_HIND=ZTHS*PTSTEP-PTHT
+! Z_RI_HIND=ZRIS*PTSTEP-PRIT
+! Z_CI_HIND=ZCIT-PCIT
+ PRIT(:,:,:)=PRIT(:,:,:)+ZRVHENIMR(:,:,:)
+ PTHT(:,:,:)=PTHT(:,:,:)+ZRVHENIMR(:,:,:)*ZLSFACT(:,:,:)
+ PRVT(:,:,:)=PRVT(:,:,:)-ZRVHENIMR(:,:,:)
+! Z_TH_HINC=0.
+! Z_RC_HINC=0.
+! Z_CC_HINC=0.
+! !
+! if ( BUCONF%lbu_enable ) then
+! if ( BUCONF%lbudget_th ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_rv ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_ri ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_sv ) then
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if (nmod_ifn > 0 ) &
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+! z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! end if
+!
+! if ( BUCONF%lbudget_th ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_rc ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_ri ) call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( BUCONF%lbudget_sv ) then
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if (nmod_ifn > 0 ) &
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! end if
+! end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_INIT_PHY(D,TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni),'HONH',PCIT(:, :, :)*prhodj(:, :, :)/ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call BUDGET_STORE_INIT_PHY(D,TBUDGETS(NBUDGET_SV1-1+nsv_lima_hom_haze),'HONH',PNHT(:, :, :)*prhodj(:, :, :)/ptstep)
+ end if
+ end if
+
+ CALL LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( BUCONF%lbu_enable ) then
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_rv ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_ri ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( BUCONF%lbudget_sv ) then
+ call BUDGET_STORE_END_PHY(D,TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni),'HONH',PCIT(:, :, :)*prhodj(:, :, :)/ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call BUDGET_STORE_END_PHY(D,TBUDGETS(NBUDGET_SV1-1+nsv_lima_hom_haze),'HONH',PNHT(:, :, :)*prhodj(:, :, :)/ptstep)
+ end if
+ end if
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_NUCLEATION_PROCS
+END MODULE MODE_LIMA_NUCLEATION_PROCS
diff --git a/src/mesonh/micro/lima_phillips_ifn_nucleation.f90 b/src/common/micro/mode_lima_phillips_ifn_nucleation.F90
similarity index 77%
rename from src/mesonh/micro/lima_phillips_ifn_nucleation.f90
rename to src/common/micro/mode_lima_phillips_ifn_nucleation.F90
index 1010555ff86b477d3fd0dcebb638a0b9b0b32959..37d4b321f11f73814c63fb5fd163bd87b9ecf614 100644
--- a/src/mesonh/micro/lima_phillips_ifn_nucleation.f90
+++ b/src/common/micro/mode_lima_phillips_ifn_nucleation.F90
@@ -3,61 +3,17 @@
!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_LIMA_PHILLIPS_IFN_NUCLEATION
-! ########################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN conc. used for immersion nucl.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
-!
-END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-!
+MODULE MODE_LIMA_PHILLIPS_IFN_NUCLEATION
+ IMPLICIT NONE
+CONTAINS
! #################################################################################
- SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC, &
- PICEFR )
+ SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION (CST, PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ P_TH_HIND, P_RI_HIND, P_CI_HIND, &
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #################################################################################
!!
!! PURPOSE
@@ -115,10 +71,7 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
@@ -127,13 +80,14 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_tools, only: Countjv
-USE MODI_LIMA_PHILLIPS_INTEG
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+USE MODE_LIMA_PHILLIPS_INTEG, ONLY : LIMA_PHILLIPS_INTEG
+USE MODE_LIMA_PHILLIPS_REF_SPECTRUM, ONLY : LIMA_PHILLIPS_REF_SPECTRUM
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -240,12 +194,12 @@ IKE=SIZE(PTHT,3) - JPVEXT
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -256,7 +210,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-2.0 .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
!
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
@@ -334,17 +288,17 @@ IF (INEGT > 0) THEN
! -----------------------------------------
!
!
- ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
- ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+ ZZY(:) = EXP( CST%XALPW - CST%XBETAW/ZZT(:) - CST%XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((CST%XMV/CST%XMD)*ZZY(:)) ! Saturation over water
!
ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
!
@@ -373,12 +327,12 @@ IF (INEGT > 0) THEN
!
! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
!
- CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+ CALL LIMA_PHILLIPS_REF_SPECTRUM(CST, ZZT, ZSI, ZSI_W, ZZY)
!
! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
!
- CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+ CALL LIMA_PHILLIPS_INTEG(CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!
!
!-------------------------------------------------------------------------------
@@ -510,3 +464,4 @@ END IF ! INEGT > 0
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
+END MODULE MODE_LIMA_PHILLIPS_IFN_NUCLEATION
diff --git a/src/arome/micro/lima_phillips_integ.F90 b/src/common/micro/mode_lima_phillips_integ.F90
similarity index 78%
rename from src/arome/micro/lima_phillips_integ.F90
rename to src/common/micro/mode_lima_phillips_integ.F90
index 3af3048c6be9e97c9e7f21db12995e446ec2c802..210dd08f9009aee84bcec0a9b8997d1cbe681e46 100644
--- a/src/arome/micro/lima_phillips_integ.F90
+++ b/src/common/micro/mode_lima_phillips_integ.F90
@@ -1,23 +1,8 @@
-! ###############################
- MODULE MODI_LIMA_PHILLIPS_INTEG
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT
-REAL, DIMENSION(:), INTENT(IN) :: ZSI
-REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
-REAL, DIMENSION(:), INTENT(IN) :: ZSW
-REAL, DIMENSION(:), INTENT(IN) :: ZZY
-REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
-!
-END SUBROUTINE LIMA_PHILLIPS_INTEG
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_INTEG
-!
+MODULE MODE_LIMA_PHILLIPS_INTEG
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+ SUBROUTINE LIMA_PHILLIPS_INTEG (CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
! ######################################################################
!!
!! PURPOSE
@@ -48,17 +33,18 @@ END MODULE MODI_LIMA_PHILLIPS_INTEG
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT, XPI
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_LIMA, ONLY : XMDIAM_IFN, XSIGMA_IFN, NSPECIE, XFRAC_REF, &
XH, XAREA1, XGAMMA, XABSCISS, XWEIGHT, NDIAM, &
XT0, XDT0, XDSI0, XSW0, XTX1, XTX2
-USE MODI_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
+USE MODE_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
USE MODI_GAMMA_INC
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(:), INTENT(IN) :: ZZT
REAL, DIMENSION(:), INTENT(IN) :: ZSI
REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
@@ -105,15 +91,15 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
! For T warmer than -35°C, the integration is approximated with µ_X << 1
! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
!
-! WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
-! ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+! WHERE (ZZT(:)>(CST%XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
+! ZZX(:) = ZZX(:) + ZEMBRYO(:) * CST%XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
! * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
! * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
! END WHERE
DO JL = 1, SIZE(ZZT)
- IF (ZZT(JL)>(XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
- ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+ IF (ZZT(JL)>(CST%XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
+ ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * CST%XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
* EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
* (1.0+SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
END IF
@@ -124,12 +110,12 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
! Beware : here, weights are normalized : XWEIGHT = wi/sqrt(pi)
!
- GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
+ GINTEG(:) = ZZT(:)<=(CST%XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
!
DO JL = 1, NDIAM
DO JL2 = 1, SIZE(GINTEG)
IF (GINTEG(JL2)) THEN
- ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
+ ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*CST%XPI*(XMDIAM_IFN(JSPECIE))**2 &
* EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
END IF
ENDDO
@@ -137,7 +123,7 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
!
! DO JL2 = 1, SIZE(GINTEG)
! IF (GINTEG(JL2)) THEN
-! ZZX(JL2) = ZZX(JL2) + 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
+! ZZX(JL2) = ZZX(JL2) + 0.5* CST%XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
! * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
! * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
! END IF
@@ -145,7 +131,7 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
DO JL2 = 1, SIZE(GINTEG)
IF (GINTEG(JL2)) THEN
ZZX(JL2) = 1 + ZZX(JL2) &
- - ( 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ - ( 0.5* CST%XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
* ( 1.0-SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) )
END IF
ENDDO
@@ -161,3 +147,4 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
ENDDO
!
END SUBROUTINE LIMA_PHILLIPS_INTEG
+END MODULE MODE_LIMA_PHILLIPS_INTEG
diff --git a/src/arome/micro/lima_phillips_ref_spectrum.F90 b/src/common/micro/mode_lima_phillips_ref_spectrum.F90
similarity index 76%
rename from src/arome/micro/lima_phillips_ref_spectrum.F90
rename to src/common/micro/mode_lima_phillips_ref_spectrum.F90
index a49a998bd0cacca500e97c68598e35b8af3b9c8e..b1492d450bab9ae445a17bc7be1ec4594f091600 100644
--- a/src/arome/micro/lima_phillips_ref_spectrum.F90
+++ b/src/common/micro/mode_lima_phillips_ref_spectrum.F90
@@ -1,21 +1,8 @@
-! ######################################
- MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-! ######################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
-REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
-REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
-!
-END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-!
+MODULE MODE_LIMA_PHILLIPS_REF_SPECTRUM
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (CST, ZZT, ZSI, ZSI_W, ZZY)
! ######################################################################
!!
!! PURPOSE
@@ -46,14 +33,15 @@ END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_LIMA, ONLY : XGAMMA, XRHO_CFDC
-USE MODI_LIMA_FUNCTIONS, ONLY : RECT, DELTA
+USE MODE_LIMA_FUNCTIONS, ONLY : RECT, DELTA
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
@@ -93,7 +81,7 @@ WHERE( ZSI(:)>1.0 )
!
ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
* ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-80.),(CST%XTT-35.))
!
!* -35 C < T <= -25 C (in Appendix A)
!
@@ -106,13 +94,13 @@ WHERE( ZSI(:)>1.0 )
!
ZMAX(:) =1000.*XGAMMA/XRHO_CFDC &
* ( EXP(12.96*(ZSI_W(:)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-35.),(XTT-30.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-35.),(CST%XTT-30.))
!
!* -30 C < T <= -25 C
!
ZMAX(:) = ZMAX(:) +1000.*XPSI &
* EXP( 12.96*(ZSI_W(:)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-30.),(XTT-25.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-30.),(CST%XTT-25.))
Z1(:) = MIN(ZZY1(:), ZMAX(:))
Z2(:) = MIN(ZZY2(:), ZMAX(:))
!
@@ -120,11 +108,11 @@ WHERE( ZSI(:)>1.0 )
!
ZZY(:) = ZZY(:) + 1000.*XPSI &
* EXP( 12.96*(MIN(ZSI2(:),7.)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
+ * RECT(1.,0.,ZZT(:),(CST%XTT-25.),(CST%XTT-2.))
END WHERE
!
WHERE (Z2(:)>0.0 .AND. Z1(:)>0.0)
- ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(XTT-35.),(XTT-25.))
+ ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(CST%XTT-35.),(CST%XTT-25.))
ZZY(:) = ZZY(:) + MIN(ZMOY(:),ZMAX(:)) ! N_{IN,1,*}
END WHERE
!
@@ -136,3 +124,4 @@ DEALLOCATE(Z1)
DEALLOCATE(Z2)
!
END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
+END MODULE MODE_LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/mesonh/micro/lima_rain_accr_snow.f90 b/src/common/micro/mode_lima_rain_accr_snow.F90
similarity index 87%
rename from src/mesonh/micro/lima_rain_accr_snow.f90
rename to src/common/micro/mode_lima_rain_accr_snow.F90
index a63ac24a4b9c776d316c18074682e61dddff53ed..66f06a67fe17542a7f11409800e09a9ea9f75d8e 100644
--- a/src/mesonh/micro/lima_rain_accr_snow.f90
+++ b/src/common/micro/mode_lima_rain_accr_snow.F90
@@ -3,47 +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_LIMA_RAIN_ACCR_SNOW
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
-!
-END SUBROUTINE LIMA_RAIN_ACCR_SNOW
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_ACCR_SNOW
-!
+MODULE MODE_LIMA_RAIN_ACCR_SNOW
+ IMPLICIT NONE
+CONTAINS
! ###################################################################################
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
+ SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
! ###################################################################################
!
!! PURPOSE
@@ -398,3 +365,4 @@ CONTAINS
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_ACCR_SNOW
+END MODULE MODE_LIMA_RAIN_ACCR_SNOW
diff --git a/src/mesonh/micro/lima_rain_evaporation.f90 b/src/common/micro/mode_lima_rain_evaporation.F90
similarity index 66%
rename from src/mesonh/micro/lima_rain_evaporation.f90
rename to src/common/micro/mode_lima_rain_evaporation.F90
index c7211f2fcd62960a43373cb63f19c38314ea6d0f..86e59a8d7778eba2ba80b4263a1d9edea2980a3f 100644
--- a/src/mesonh/micro/lima_rain_evaporation.f90
+++ b/src/common/micro/mode_lima_rain_evaporation.F90
@@ -3,48 +3,15 @@
!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_LIMA_RAIN_EVAPORATION
-! ##########################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PCRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- PEVAP3D )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: PLV !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PEVSAT !
-REAL, DIMENSION(:), INTENT(IN) :: PRVSAT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-!
-END SUBROUTINE LIMA_RAIN_EVAPORATION
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_EVAPORATION
+MODULE MODE_LIMA_RAIN_EVAPORATION
+ IMPLICIT NONE
+CONTAINS
! ###############################################################################
- SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
- PRVT, PRCT, PRRT, PCRT, PLBDR, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- PEVAP3D )
+ SUBROUTINE LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
+ PRVT, PRCT, PRRT, PCRT, PLBDR, &
+ P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
+ PEVAP3D )
! ###############################################################################
!
!!
@@ -168,3 +135,4 @@ END IF
!-----------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_EVAPORATION
+END MODULE MODE_LIMA_RAIN_EVAPORATION
diff --git a/src/mesonh/micro/lima_rain_freezing.f90 b/src/common/micro/mode_lima_rain_freezing.F90
similarity index 65%
rename from src/mesonh/micro/lima_rain_freezing.f90
rename to src/common/micro/mode_lima_rain_freezing.F90
index a6c9504a1cef696a5003a099c293a41060ed4fa7..b3bee2145b48b566fd0673e947a804fe0f37a8d4 100644
--- a/src/mesonh/micro/lima_rain_freezing.f90
+++ b/src/common/micro/mode_lima_rain_freezing.F90
@@ -3,44 +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_LIMA_RAIN_FREEZING
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT !
-REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
-!
-END SUBROUTINE LIMA_RAIN_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_RAIN_FREEZING
-!
+MODULE MODE_LIMA_RAIN_FREEZING
+ IMPLICIT NONE
+CONTAINS
! #######################################################################################
- SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
- PRHODREF, PT, PLVFACT, PLSFACT, &
- PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+ SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
+ PRHODREF, PT, PLVFACT, PLSFACT, &
+ PRRT, PCRT, PRIT, PCIT, PLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
! #######################################################################################
!
!! PURPOSE
@@ -133,3 +103,4 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_FREEZING
+END MODULE MODE_LIMA_RAIN_FREEZING
diff --git a/src/mesonh/micro/lima_raindrop_shattering_freezing.f90 b/src/common/micro/mode_lima_raindrop_shattering_freezing.F90
similarity index 74%
rename from src/mesonh/micro/lima_raindrop_shattering_freezing.f90
rename to src/common/micro/mode_lima_raindrop_shattering_freezing.F90
index dc7c14066214dfb589ad8428291dbc1c9262706d..43f20e08f1825fe23736064c7fb91e1c1694c8ad 100644
--- a/src/mesonh/micro/lima_raindrop_shattering_freezing.f90
+++ b/src/common/micro/mode_lima_raindrop_shattering_freezing.F90
@@ -3,41 +3,15 @@
!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_LIMA_RAINDROP_SHATTERING_FREEZING
-! #############################################
-!
-INTERFACE
- SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
- PRHODREF, &
- PRRT, PCRT, PRIT, PCIT, PRGT, &
- PLBDR, &
- P_RI_RDSF, P_CI_RDSF )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRRT
-REAL, DIMENSION(:), INTENT(IN) :: PCRT
-REAL, DIMENSION(:), INTENT(IN) :: PRIT
-REAL, DIMENSION(:), INTENT(IN) :: PCIT
-REAL, DIMENSION(:), INTENT(IN) :: PRGT
-REAL, DIMENSION(:), INTENT(IN) :: PLBDR
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_RDSF
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_RDSF
-!
-END SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING
-END INTERFACE
-END MODULE MODI_LIMA_RAINDROP_SHATTERING_FREEZING
-!
+MODULE MODE_LIMA_RAINDROP_SHATTERING_FREEZING
+ IMPLICIT NONE
+CONTAINS
! #######################################################################
- SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
- PRHODREF, &
- PRRT, PCRT, PRIT, PCIT, PRGT, &
- PLBDR, &
- P_RI_RDSF, P_CI_RDSF )
+ SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING (LDCOMPUTE, &
+ PRHODREF, &
+ PRRT, PCRT, PRIT, PCIT, PRGT, &
+ PLBDR, &
+ P_RI_RDSF, P_CI_RDSF )
! #######################################################################
!
!! PURPOSE
@@ -157,3 +131,4 @@ ENDIF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAINDROP_SHATTERING_FREEZING
+END MODULE MODE_LIMA_RAINDROP_SHATTERING_FREEZING
diff --git a/src/mesonh/micro/lima_read_xker_gweth.f90 b/src/common/micro/mode_lima_read_xker_gweth.F90
similarity index 97%
rename from src/mesonh/micro/lima_read_xker_gweth.f90
rename to src/common/micro/mode_lima_read_xker_gweth.F90
index 25a567ec83399fb73d1774df9bacf5d879b67240..b0a514a0ba2fce4e6724da3ed87984e1d1496e74 100644
--- a/src/mesonh/micro/lima_read_xker_gweth.f90
+++ b/src/common/micro/mode_lima_read_xker_gweth.F90
@@ -3,49 +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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_GWETH
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,PKER_GWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PEHG
-REAL, INTENT(OUT) :: PBG
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAG_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAG_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
-!
-END SUBROUTINE LIMA_READ_XKER_GWETH
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_GWETH
+MODULE MODE_LIMA_READ_XKER_GWETH
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,PKER_GWETH )
+ SUBROUTINE LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,PKER_GWETH )
! ########################################################################
!
!!**** * * - initialize the kernels for the graupel-hail wet growth process
@@ -1735,3 +1700,4 @@ PKER_GWETH( 40, 40) = 0.197923E-01
END IF
!
END SUBROUTINE LIMA_READ_XKER_GWETH
+END MODULE MODE_LIMA_READ_XKER_GWETH
diff --git a/src/mesonh/micro/lima_read_xker_raccs.f90 b/src/common/micro/mode_lima_read_xker_raccs.F90
similarity index 98%
rename from src/mesonh/micro/lima_read_xker_raccs.f90
rename to src/common/micro/mode_lima_read_xker_raccs.F90
index 5a75adf255339c49ec3c786f1d70c08083274e16..55afa459085921cb76b02b6471ce22c7da2a5612 100644
--- a/src/mesonh/micro/lima_read_xker_raccs.f90
+++ b/src/common/micro/mode_lima_read_xker_raccs.F90
@@ -3,53 +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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_RACCS
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
- PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
-!
-INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PESR
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PACCLBDAS_MAX
-REAL, INTENT(OUT) :: PACCLBDAR_MAX
-REAL, INTENT(OUT) :: PACCLBDAS_MIN
-REAL, INTENT(OUT) :: PACCLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
-!
-END SUBROUTINE LIMA_READ_XKER_RACCS
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_RACCS
+MODULE MODE_LIMA_READ_XKER_RACCS
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
- SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
- PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+ SUBROUTINE LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
+ PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
! ##########################################################################
!
!!**** * * - initialize the kernels for the rain-snow accretion process
@@ -4951,3 +4912,4 @@ IF( PRESENT(PKER_SACCRG) ) THEN
END IF
!
END SUBROUTINE LIMA_READ_XKER_RACCS
+END MODULE MODE_LIMA_READ_XKER_RACCS
diff --git a/src/mesonh/micro/lima_read_xker_rdryg.f90 b/src/common/micro/mode_lima_read_xker_rdryg.F90
similarity index 97%
rename from src/mesonh/micro/lima_read_xker_rdryg.f90
rename to src/common/micro/mode_lima_read_xker_rdryg.F90
index de1a4287401dc151fb785ab4e23b24010b8988e0..160392c58731e22c56e5fb8a5b96b161d6bcccde 100644
--- a/src/mesonh/micro/lima_read_xker_rdryg.f90
+++ b/src/common/micro/mode_lima_read_xker_rdryg.F90
@@ -3,49 +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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_RDRYG
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,PKER_RDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PEGR
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAR_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
-!
-END SUBROUTINE LIMA_READ_XKER_RDRYG
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_RDRYG
+MODULE MODE_LIMA_READ_XKER_RDRYG
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,PKER_RDRYG )
+ SUBROUTINE LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,PKER_RDRYG )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -1734,3 +1699,4 @@ PKER_RDRYG( 40, 40) = 0.603544E-02
END IF
!
END SUBROUTINE LIMA_READ_XKER_RDRYG
+END MODULE MODE_LIMA_READ_XKER_RDRYG
diff --git a/src/mesonh/micro/lima_read_xker_sdryg.f90 b/src/common/micro/mode_lima_read_xker_sdryg.F90
similarity index 98%
rename from src/mesonh/micro/lima_read_xker_sdryg.f90
rename to src/common/micro/mode_lima_read_xker_sdryg.F90
index f3c2377e598d75bfa99128901bc11047e768d4ee..d12ca6142379d89ae956366a15b105784e13f08c 100644
--- a/src/mesonh/micro/lima_read_xker_sdryg.f90
+++ b/src/common/micro/mode_lima_read_xker_sdryg.F90
@@ -3,50 +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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_SDRYG
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,PKER_SDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEGS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAS_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
-!
-END SUBROUTINE LIMA_READ_XKER_SDRYG
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_SDRYG
+MODULE MODE_LIMA_READ_XKER_SDRYG
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,PKER_SDRYG )
+ SUBROUTINE LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,PKER_SDRYG )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -3338,3 +3302,4 @@ PKER_SDRYG( 40, 80) = 0.332823E+00
END IF
!
END SUBROUTINE LIMA_READ_XKER_SDRYG
+END MODULE MODE_LIMA_READ_XKER_SDRYG
diff --git a/src/mesonh/micro/lima_read_xker_sweth.f90 b/src/common/micro/mode_lima_read_xker_sweth.F90
similarity index 98%
rename from src/mesonh/micro/lima_read_xker_sweth.f90
rename to src/common/micro/mode_lima_read_xker_sweth.F90
index a034ec708a09071c4185be149cc4ef3c89d294fa..fe423f89a53fda3abfc716d9fdc36d6d52f0ef64 100644
--- a/src/mesonh/micro/lima_read_xker_sweth.f90
+++ b/src/common/micro/mode_lima_read_xker_sweth.F90
@@ -3,50 +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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_LIMA_READ_XKER_SWETH
-! ###########################
-!
-INTERFACE
- SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,PKER_SWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEHS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAS_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
-!
-END SUBROUTINE LIMA_READ_XKER_SWETH
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_READ_XKER_SWETH
+MODULE MODE_LIMA_READ_XKER_SWETH
+ IMPLICIT NONE
+CONTAINS
! ########################################################################
- SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,PKER_SWETH )
+ SUBROUTINE LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,PKER_SWETH )
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-hail wet growth process
@@ -3338,3 +3302,4 @@ PKER_SWETH( 40, 80) = 0.310319E+00
END IF
!
END SUBROUTINE LIMA_READ_XKER_SWETH
+END MODULE MODE_LIMA_READ_XKER_SWETH
diff --git a/src/mesonh/micro/lima_sedimentation.f90 b/src/common/micro/mode_lima_sedimentation.F90
similarity index 70%
rename from src/mesonh/micro/lima_sedimentation.f90
rename to src/common/micro/mode_lima_sedimentation.F90
index 23072bb81dab233cfbfdb920e0ee5b995c6a6848..dc6164d492aedbacd1aa7819285d9289d210e909 100644
--- a/src/mesonh/micro/lima_sedimentation.f90
+++ b/src/common/micro/mode_lima_sedimentation.F90
@@ -3,40 +3,13 @@
!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_LIMA_SEDIMENTATION
-! ###################################
-!
-INTERFACE
- SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
-CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
-INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
-INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
-INTEGER, INTENT(IN) :: KSPLITG !
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRT_SUM ! total water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
-!
-END SUBROUTINE LIMA_SEDIMENTATION
-END INTERFACE
-END MODULE MODI_LIMA_SEDIMENTATION
-!
-!
+MODULE MODE_LIMA_SEDIMENTATION
+ IMPLICIT NONE
+CONTAINS
! ######################################################################
- SUBROUTINE LIMA_SEDIMENTATION (KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR )
+ SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR )
! ######################################################################
!
!! PURPOSE
@@ -72,7 +45,8 @@ END MODULE MODI_LIMA_SEDIMENTATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XRHOLW, XCL, XCI, XPI
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
XLB, XLBEX, XD, XFSEDR, XFSEDC, &
@@ -89,7 +63,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
@@ -104,6 +79,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCPT ! Cp
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFPR ! Precip. fluxes in altitude
!
!* 0.2 Declarations of local variables :
!
@@ -114,9 +90,10 @@ LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GSEDIM ! Test where to compute the SED processes
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZW, & ! Work array
- ZWSEDR, & ! Sedimentation of MMR
- ZWSEDC, & ! Sedimentation of number conc.
ZWDT ! Temperature change
+REAL, DIMENSION(D%NIT,D%NJT,0:D%NKT+1) &
+ :: ZWSEDR, & ! Sedimentation of MMR
+ ZWSEDC ! Sedimentation of number conc.
!
REAL, DIMENSION(:), ALLOCATABLE &
:: ZRS, & ! m.r. source
@@ -147,19 +124,21 @@ ZTSPLITG= PTSTEP / REAL(NSPLITSED(KID))
!
ZWDT=0.
PINPR(:,:) = 0.
+ZWSEDR(:,:,:) = 0.
+ZWSEDC(:,:,:) = 0.
!
PRS(:,:,:) = PRS(:,:,:) * PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) * PTSTEP
-DO JK = KKTB , KKTE
+DO JK = D%NKTB , D%NKTE
ZW(:,:,JK)=ZTSPLITG/PDZZ(:,:,JK)
END DO
!
-IF (HPHASE=='L') ZC=XCL
-IF (HPHASE=='I') ZC=XCI
+IF (HPHASE=='L') ZC=CST%XCL
+IF (HPHASE=='I') ZC=CST%XCI
!
IF (KID==4 .AND. ZMOMENTS==1) THEN
ZMOMENTS=2
- WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*XPI*900.) * PRS(:,:,:) * &
+ WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*CST%XPI*900.) * PRS(:,:,:) * &
MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(:,:,:)*PRS(:,:,:)))**3
END IF
!
@@ -170,7 +149,7 @@ END IF
DO JN = 1 , NSPLITSED(KID)
! Computation only where enough ice, snow, graupel or hail
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = PRS(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(KID)
+ GSEDIM(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE) = PRS(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)>XRTMIN(KID)
IF (ZMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
!
@@ -224,26 +203,29 @@ DO JN = 1 , NSPLITSED(KID)
ZZX(:) = ZCC(:) * ZZX(:)
END IF
- ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDR(:,:,KKTB:KKTE) = MIN( ZWSEDR(:,:,KKTB:KKTE), PRS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ ZWSEDR(:,:,1:D%NKT) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDR(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDR(:,:,D%NKTB:D%NKTE), PRS(:,:,D%NKTB:D%NKTE) &
+ * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
IF (KMOMENTS==2) THEN
- ZWSEDC(:,:,:) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,KKTB:KKTE) = MIN( ZWSEDC(:,:,KKTB:KKTE), PCS(:,:,KKTB:KKTE) * PRHODREF(:,:,KKTB:KKTE) / ZW(:,:,KKTB:KKTE) )
+ ZWSEDC(:,:,1:D%NKT) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDC(:,:,D%NKTB:D%NKTE), PCS(:,:,D%NKTB:D%NKTE) &
+ * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
END IF
- DO JK = KKTB , KKTE
+ DO JK = D%NKTB , D%NKTE
PRS(:,:,JK) = PRS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDR(:,:,JK+KKL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ (ZWSEDR(:,:,JK+D%NKL)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PFPR(:,:,JK) = ZWSEDR(:,:,JK)
IF (KMOMENTS==2) PCS(:,:,JK) = PCS(:,:,JK) + ZW(:,:,JK)* &
- (ZWSEDC(:,:,JK+KKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ (ZWSEDC(:,:,JK+D%NKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
! Heat transport
- !PRT_SUM(:,:,JK-KKL) = PRT_SUM(:,:,JK-KKL) + ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL)
+ !PRT_SUM(:,:,JK-D%NKL) = PRT_SUM(:,:,JK-D%NKL) + ZW(:,:,JK-D%NKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-D%NKL)
!PRT_SUM(:,:,JK) = PRT_SUM(:,:,JK) - ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK)
- !PCPT(:,:,JK-KKL) = PCPT(:,:,JK-KKL) + ZC * (ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL))
+ !PCPT(:,:,JK-D%NKL) = PCPT(:,:,JK-D%NKL) + ZC * (ZW(:,:,JK-D%NKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-D%NKL))
!PCPT(:,:,JK) = PCPT(:,:,JK) - ZC * (ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK))
- !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
- ! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+KKL)) / &
- ! (PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+KKL)*ZC)
+ !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+D%NKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
+ ! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+D%NKL)) / &
+ ! (PRHODREF(:,:,JK+D%NKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+D%NKL)*ZC)
!ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
END DO
DEALLOCATE(ZRHODREF)
@@ -257,7 +239,7 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
!
- PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,KKB)/XRHOLW/NSPLITSED(KID) ! in m/s
+ PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,D%NKB)/CST%XRHOLW/NSPLITSED(KID) ! in m/s
!PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
END IF
@@ -267,5 +249,4 @@ PRS(:,:,:) = PRS(:,:,:) / PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) / PTSTEP
!
END SUBROUTINE LIMA_SEDIMENTATION
-!
-!-------------------------------------------------------------------------------
+END MODULE MODE_LIMA_SEDIMENTATION
diff --git a/src/mesonh/micro/lima_snow_deposition.f90 b/src/common/micro/mode_lima_snow_deposition.F90
similarity index 74%
rename from src/mesonh/micro/lima_snow_deposition.f90
rename to src/common/micro/mode_lima_snow_deposition.F90
index 3bd8d0141f23ef6c013ba7738e1da65518be4811..0a520c063aa1e96b4c6631a836ab3c4470b62023 100644
--- a/src/mesonh/micro/lima_snow_deposition.f90
+++ b/src/common/micro/mode_lima_snow_deposition.F90
@@ -3,45 +3,15 @@
!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_LIMA_SNOW_DEPOSITION
-! #####################
-!
-INTERFACE
- SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRST, PCST, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
-REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow/aggregate concentration
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
-REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
-!
-END SUBROUTINE LIMA_SNOW_DEPOSITION
-END INTERFACE
-END MODULE MODI_LIMA_SNOW_DEPOSITION
-!
+MODULE MODE_LIMA_SNOW_DEPOSITION
+ IMPLICIT NONE
+CONTAINS
! ##########################################################################
-SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
- PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
- PRST, PCST, PLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS )
+ SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PCST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
! ##########################################################################
!
!! PURPOSE
@@ -177,3 +147,4 @@ ELSE
END IF
!
END SUBROUTINE LIMA_SNOW_DEPOSITION
+END MODULE MODE_LIMA_SNOW_DEPOSITION
diff --git a/src/mesonh/micro/lima_snow_self_collection.f90 b/src/common/micro/mode_lima_snow_self_collection.F90
similarity index 78%
rename from src/mesonh/micro/lima_snow_self_collection.f90
rename to src/common/micro/mode_lima_snow_self_collection.F90
index ea38870b87d715c9d5d556b1ea1d9353c44bf41e..50339a87f9cfab882ee4e4ea81fea509d1aebfd2 100644
--- a/src/mesonh/micro/lima_snow_self_collection.f90
+++ b/src/common/micro/mode_lima_snow_self_collection.F90
@@ -3,36 +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_LIMA_SNOW_SELF_COLLECTION
-! #################################
-!
-INTERFACE
- SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, PT, &
- PRST, PCST, PLBDS, &
- P_CS_SSC )
-!
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
-REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
-REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
-!
-REAL, DIMENSION(:), INTENT(OUT) :: P_CS_SSC
-!
-END SUBROUTINE LIMA_SNOW_SELF_COLLECTION
-END INTERFACE
-END MODULE MODI_LIMA_SNOW_SELF_COLLECTION
-!
+MODULE MODE_LIMA_SNOW_SELF_COLLECTION
+ IMPLICIT NONE
+CONTAINS
! #############################################################
- SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, PT, &
- PRST, PCST, PLBDS, &
- P_CS_SSC )
+ SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRST, PCST, PLBDS, &
+ P_CS_SSC )
! #############################################################
!
!! PURPOSE
@@ -147,3 +125,4 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_SNOW_SELF_COLLECTION
+END MODULE MODE_LIMA_SNOW_SELF_COLLECTION
diff --git a/src/mesonh/micro/lima_tendencies.f90 b/src/common/micro/mode_lima_tendencies.F90
similarity index 64%
rename from src/mesonh/micro/lima_tendencies.f90
rename to src/common/micro/mode_lima_tendencies.F90
index d8c8d18d9c1ee8371d6c0ef6274f5af50d85ac3d..d25250bcc03b6020789d727a7b4d915fce8ef20c 100644
--- a/src/mesonh/micro/lima_tendencies.f90
+++ b/src/common/micro/mode_lima_tendencies.F90
@@ -3,273 +3,50 @@
!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_LIMA_TENDENCIES
-!###############################
- INTERFACE
- SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS, &
- P_CS_SSC, &
- P_RI_AGGS, P_CI_AGGS, &
- P_TH_DEPG, P_RG_DEPG, &
- P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
- P_RS_CMEL, P_CS_CMEL, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- P_RI_CIBU, P_CI_CIBU, &
- P_RI_RDSF, P_CI_RDSF, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- P_TH_DEPH, P_RH_DEPH, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH, &
- PEVAP3D, &
- PCF1D, PIF1D, PPF1D )
-!
-REAL, INTENT(IN) :: PTSTEP
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF !
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Potential temperature
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRVT !
-REAL, DIMENSION(:), INTENT(IN) :: PRCT !
-REAL, DIMENSION(:), INTENT(IN) :: PRRT !
-REAL, DIMENSION(:), INTENT(IN) :: PRIT !
-REAL, DIMENSION(:), INTENT(IN) :: PRST !
-REAL, DIMENSION(:), INTENT(IN) :: PRGT !
-REAL, DIMENSION(:), INTENT(IN) :: PRHT ! Mixing ratios (kg/kg)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT !
-REAL, DIMENSION(:), INTENT(IN) :: PCRT !
-REAL, DIMENSION(:), INTENT(IN) :: PCIT !
-REAL, DIMENSION(:), INTENT(IN) :: PCST !
-REAL, DIMENSION(:), INTENT(IN) :: PCGT !
-REAL, DIMENSION(:), INTENT(IN) :: PCHT ! Number concentrations (/kg)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_HONC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_HONC ! droplets homogeneous freezing (HONC) : rc, Nc, ri=-rc, Ni=-Nc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF ! self collection of droplets (SELF) : Nc
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU ! self collectio break up of drops (SCBU) : Nr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_EVAP ! evaporation of rain drops (EVAP) : rr, Nr, rv=-rr
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_SSC ! self collection of snow (SSC) : Ns
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_CMEL ! conversion-melting (CMEL) : rs, Ns, rg=-rs, Ng=-Ns
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CIBU
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CIBU ! collisional ice break-up (CIBU) : ri, Ni, rs=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_RDSF
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_RDSF ! rain drops freezing shattering (RDSF) : ri, Ni, rg=-ri
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETG ! wet growth of graupel (WETG) : rc, NC, rr, Nr, ri, Ni, rs, Ns, rg, Ng, rh, Nh=-Ng, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_DRYG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DRYG ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, Ns, rg, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_HMG ! hallett mossop graupel (HMG) : ri, Ni, rg
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_GMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_GMLT ! graupel melting (GMLT) : rr, Nr, rg=-rr, Ng, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_DEPH ! deposition of vapor on hail (DEPH) : rv=-rh, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_WETH
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RH_WETH ! wet growth of hail (WETH) : rc, NC, rr, Nr, ri, Ni, rs, Ns, rg, Ng, rh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_COHG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CG_COHG ! conversion hail -> graupel (COHG) : rg, Ng, rh=-rg; Nh=-Ng
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_HMLT
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CH_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, Nh, th
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CG
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCF1D
-REAL, DIMENSION(:), INTENT(IN) :: PIF1D
-REAL, DIMENSION(:), INTENT(IN) :: PPF1D
-!
- END SUBROUTINE LIMA_TENDENCIES
- END INTERFACE
-END MODULE MODI_LIMA_TENDENCIES
-!#####################################################################
-!
+MODULE MODE_LIMA_TENDENCIES
+ IMPLICIT NONE
+CONTAINS
!#####################################################################
-SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
- PEXNREF, PRHODREF, PPABST, PTHT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
- P_TH_HONC, P_RC_HONC, P_CC_HONC, &
- P_CC_SELF, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- P_RC_ACCR, P_CC_ACCR, &
- P_CR_SCBU, &
- P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_TH_DEPI, P_RI_DEPI, &
- P_RI_CNVS, P_CI_CNVS, &
- P_CS_SSC, &
- P_RI_AGGS, P_CI_AGGS, &
- P_TH_DEPG, P_RG_DEPG, &
- P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
- P_RS_CMEL, P_CS_CMEL, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- P_RI_CIBU, P_CI_CIBU, &
- P_RI_RDSF, P_CI_RDSF, &
- P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
- P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
- P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
- P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
- P_RI_HMG, P_CI_HMG, P_RG_HMG, &
- P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
- P_TH_DEPH, P_RH_DEPH, &
- P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
- P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
- P_RG_COHG, P_CG_COHG, &
- P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
- PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
- PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH, &
- PEVAP3D, &
- PCF1D, PIF1D, PPF1D )
+ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE, &
+ PEXNREF, PRHODREF, PPABST, PTHT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ PCCT, PCRT, PCIT, PCST, PCGT, PCHT, &
+ P_TH_HONC, P_RC_HONC, P_CC_HONC, &
+ P_CC_SELF, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
+ P_RC_ACCR, P_CC_ACCR, &
+ P_CR_SCBU, &
+ P_TH_EVAP, P_RR_EVAP, P_CR_EVAP, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS, &
+ P_CS_SSC, &
+ P_RI_AGGS, P_CI_AGGS, &
+ P_TH_DEPG, P_RG_DEPG, &
+ P_TH_BERFI, P_RC_BERFI, &
+ P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
+ P_RS_CMEL, P_CS_CMEL, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
+ P_RI_CIBU, P_CI_CIBU, &
+ P_RI_RDSF, P_CI_RDSF, &
+ P_TH_WETG, P_RC_WETG, P_CC_WETG, P_RR_WETG, P_CR_WETG, &
+ P_RI_WETG, P_CI_WETG, P_RS_WETG, P_CS_WETG, P_RG_WETG, P_CG_WETG, P_RH_WETG, &
+ P_TH_DRYG, P_RC_DRYG, P_CC_DRYG, P_RR_DRYG, P_CR_DRYG, &
+ P_RI_DRYG, P_CI_DRYG, P_RS_DRYG, P_CS_DRYG, P_RG_DRYG, &
+ P_RI_HMG, P_CI_HMG, P_RG_HMG, &
+ P_TH_GMLT, P_RR_GMLT, P_CR_GMLT, P_CG_GMLT, &
+ P_TH_DEPH, P_RH_DEPH, &
+ P_TH_WETH, P_RC_WETH, P_CC_WETH, P_RR_WETH, P_CR_WETH, &
+ P_RI_WETH, P_CI_WETH, P_RS_WETH, P_CS_WETH, P_RG_WETH, P_CG_WETH, P_RH_WETH, &
+ P_RG_COHG, P_CG_COHG, &
+ P_TH_HMLT, P_RR_HMLT, P_CR_HMLT, P_CH_HMLT, &
+ PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
+ PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH, &
+ PEVAP3D, &
+ PCF1D, PIF1D, PPF1D )
! ######################################################################
!!
!! PURPOSE
@@ -296,35 +73,35 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE,
USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, &
XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUS, LCIBU, LRDSF, &
- LCOLD, LNUCL, LSNOW, LHAIL, LWARM, LACTI, LRAIN, LKHKO, LSNOW_T, &
+ LNUCL, LACTI, LKHKO, LSNOW_T, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR, XCCR, XCXR
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XCCG, XCXG, XLBH, XLBEXH, XCCH, XCXH, XLBDAG_MAX
USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX, XTRANS_MP_GAMMAS, &
XFVELOS, XLBDAS_MIN, XCCS, XCXS, XBS, XNS
!
-USE MODI_LIMA_DROPLETS_HOM_FREEZING
-USE MODI_LIMA_DROPLETS_SELF_COLLECTION
-USE MODI_LIMA_DROPLETS_AUTOCONVERSION
-USE MODI_LIMA_DROPLETS_ACCRETION
-USE MODI_LIMA_DROPS_SELF_COLLECTION
-USE MODI_LIMA_RAIN_EVAPORATION
-USE MODI_LIMA_ICE_DEPOSITION
-USE MODI_LIMA_SNOW_DEPOSITION
-USE MODI_LIMA_SNOW_SELF_COLLECTION
-USE MODI_LIMA_ICE_AGGREGATION_SNOW
-USE MODI_LIMA_GRAUPEL_DEPOSITION
-USE MODI_LIMA_DROPLETS_RIMING_SNOW
-USE MODI_LIMA_RAIN_ACCR_SNOW
-USE MODI_LIMA_CONVERSION_MELTING_SNOW
-USE MODI_LIMA_RAIN_FREEZING
-USE MODI_LIMA_COLLISIONAL_ICE_BREAKUP
-USE MODI_LIMA_RAINDROP_SHATTERING_FREEZING
-USE MODI_LIMA_GRAUPEL
-USE MODI_LIMA_HAIL_DEPOSITION
-USE MODI_LIMA_HAIL
-!
-USE MODI_LIMA_BERGERON
+USE MODE_LIMA_DROPLETS_HOM_FREEZING, ONLY: LIMA_DROPLETS_HOM_FREEZING
+USE MODE_LIMA_DROPLETS_SELF_COLLECTION, ONLY: LIMA_DROPLETS_SELF_COLLECTION
+USE MODE_LIMA_DROPLETS_AUTOCONVERSION, ONLY: LIMA_DROPLETS_AUTOCONVERSION
+USE MODE_LIMA_DROPLETS_ACCRETION, ONLY: LIMA_DROPLETS_ACCRETION
+USE MODE_LIMA_DROPS_SELF_COLLECTION, ONLY: LIMA_DROPS_SELF_COLLECTION
+USE MODE_LIMA_RAIN_EVAPORATION, ONLY: LIMA_RAIN_EVAPORATION
+USE MODE_LIMA_ICE_DEPOSITION, ONLY: LIMA_ICE_DEPOSITION
+USE MODE_LIMA_SNOW_DEPOSITION, ONLY: LIMA_SNOW_DEPOSITION
+USE MODE_LIMA_SNOW_SELF_COLLECTION, ONLY: LIMA_SNOW_SELF_COLLECTION
+USE MODE_LIMA_ICE_AGGREGATION_SNOW, ONLY: LIMA_ICE_AGGREGATION_SNOW
+USE MODE_LIMA_GRAUPEL_DEPOSITION, ONLY: LIMA_GRAUPEL_DEPOSITION
+USE MODE_LIMA_DROPLETS_RIMING_SNOW, ONLY: LIMA_DROPLETS_RIMING_SNOW
+USE MODE_LIMA_RAIN_ACCR_SNOW, ONLY: LIMA_RAIN_ACCR_SNOW
+USE MODE_LIMA_CONVERSION_MELTING_SNOW, ONLY: LIMA_CONVERSION_MELTING_SNOW
+USE MODE_LIMA_RAIN_FREEZING, ONLY: LIMA_RAIN_FREEZING
+USE MODE_LIMA_COLLISIONAL_ICE_BREAKUP, ONLY: LIMA_COLLISIONAL_ICE_BREAKUP
+USE MODE_LIMA_RAINDROP_SHATTERING_FREEZING, ONLY: LIMA_RAINDROP_SHATTERING_FREEZING
+USE MODE_LIMA_GRAUPEL, ONLY: LIMA_GRAUPEL
+USE MODE_LIMA_HAIL_DEPOSITION, ONLY: LIMA_HAIL_DEPOSITION
+USE MODE_LIMA_HAIL, ONLY: LIMA_HAIL
+!
+USE MODE_LIMA_BERGERON, ONLY: LIMA_BERGERON
!
IMPLICIT NONE
!
@@ -722,7 +499,7 @@ END IF
!-------------------------------------------------------------------------------
! Call microphysical processes
!
-IF (LCOLD .AND. LWARM) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_I.GE.1) THEN
CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! independent from CF,IF,PF
ZT, ZLVFACT, ZLSFACT, &
ZRCT, PCCT, ZLBDC, &
@@ -735,7 +512,7 @@ IF (LCOLD .AND. LWARM) THEN
PA_TH(:) = PA_TH(:) + P_TH_HONC(:)
END IF
!
-IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
+IF ((.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF
PRHODREF, &
PCCT/ZCF1D, ZLBDC3, &
@@ -744,7 +521,7 @@ IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_C.GE.2) THEN
PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_R.GE.1) THEN
CALL LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, & ! depends on CF
PRHODREF, &
ZRCT/ZCF1D, PCCT/ZCF1D, ZLBDC, ZLBDR, &
@@ -759,7 +536,7 @@ IF (LWARM .AND. LRAIN) THEN
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_R.GE.1) THEN
CALL LIMA_DROPLETS_ACCRETION (LDCOMPUTE, & ! depends on CF, PF
PRHODREF, &
ZRCT/ZCF1D, ZRRT/ZPF1D, PCCT/ZCF1D, PCRT/ZPF1D,&
@@ -774,7 +551,7 @@ IF (LWARM .AND. LRAIN) THEN
PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
END IF
!
-IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
+IF ((.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
PRHODREF, &
PCRT/ZPF1D(:), ZLBDR, ZLBDR3, &
@@ -785,7 +562,7 @@ IF (LWARM .AND. LRAIN .AND. (.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_R.GE.2) THEN
CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF
PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
PRVT, ZRCT/ZPF1D, ZRRT/ZPF1D, PCRT/ZPF1D, ZLBDR, &
@@ -802,7 +579,7 @@ IF (LWARM .AND. LRAIN) THEN
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_EVAP(:)
END IF
!
-IF (LCOLD) THEN
+IF (NMOM_I.GE.1) THEN
!
! Includes vapour deposition on ice, ice -> snow conversion
!
@@ -826,7 +603,7 @@ IF (LCOLD) THEN
END IF
!
-IF (LCOLD .AND. LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
! Includes vapour deposition on snow, snow -> ice conversion
!
@@ -850,7 +627,7 @@ IF (LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LSNOW .AND. NMOM_S.GE.2) THEN
+IF (NMOM_S.GE.2) THEN
CALL LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
PRHODREF, &
ZRST(:)/ZPF1D(:), PCST/ZPF1D(:), ZLBDS, ZLBDS3, &
@@ -867,7 +644,7 @@ END IF
!ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:))
!
!
-IF (LCOLD .AND. LSNOW) THEN
+IF (NMOM_I.GE.1 .AND. NMOM_S.GE.1) THEN
CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, & ! depends on IF, PF
ZT, PRHODREF, &
ZRIT/ZIF1D, ZRST/ZPF1D, PCIT/ZIF1D, PCST/ZPF1D, ZLBDI, ZLBDS, &
@@ -880,7 +657,7 @@ IF (LCOLD .AND. LSNOW) THEN
PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
END IF
!
-IF (LWARM .AND. LCOLD) THEN
+IF (NMOM_G.GE.1) THEN
CALL LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
ZRGT/ZPF1D, PCGT/ZPF1D, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
P_TH_DEPG, P_RG_DEPG )
@@ -892,7 +669,7 @@ IF (LWARM .AND. LCOLD) THEN
PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
END IF
!
-IF (LWARM .AND. LCOLD .AND. NMOM_I.EQ.1) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_I.EQ.1) THEN
CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF
ZRCT/ZCF1D, ZRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, &
ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
@@ -905,7 +682,7 @@ IF (LWARM .AND. LCOLD .AND. NMOM_I.EQ.1) THEN
PA_TH(:) = PA_TH(:) + P_TH_BERFI(:)
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+IF (NMOM_C.GE.1 .AND. NMOM_S.GE.1) THEN
!
! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
@@ -937,7 +714,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
+IF (NMOM_R.GE.1 .AND. NMOM_S.GE.1) THEN
CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
PRHODREF, ZT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
@@ -959,7 +736,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -978,7 +755,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
+IF (NMOM_R.GE.1) THEN
CALL LIMA_RAIN_FREEZING (LDCOMPUTE, & ! depends on PF, IF
PRHODREF, ZT, ZLVFACT, ZLSFACT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRIT/ZIF1D, PCIT/ZIF1D, ZLBDR, &
@@ -999,7 +776,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
END IF
!
-IF (LWARM .AND. LCOLD .AND. LSNOW .AND. LCIBU) THEN
+IF (NMOM_S.GE.1 .AND. NMOM_G.GE.1 .AND. LCIBU) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -1018,7 +795,7 @@ IF (LWARM .AND. LCOLD .AND. LSNOW .AND. LCIBU) THEN
END IF
!
-IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW .AND. LRDSF) THEN
+IF (NMOM_R.GE.1 .AND. NMOM_I.GE.1 .AND. LRDSF) THEN
!
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
@@ -1037,7 +814,7 @@ IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW .AND. LRDSF) THEN
END IF
!
-IF (LWARM .AND. LCOLD) THEN
+IF (NMOM_G.GE.1) THEN
!
! Melting of graupel should account for collected droplets and drops where T>0C, but does not !
! Collection and water shedding should also happen where T>0C, but do not !
@@ -1061,7 +838,7 @@ IF (LWARM .AND. LCOLD) THEN
PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH )
END IF
!
-IF (LWARM .AND. LCOLD .AND. LHAIL) THEN
+IF (NMOM_H.GE.1) THEN
CALL LIMA_HAIL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
ZRHT/ZPF1D, PCHT/ZPF1D, ZSSI, ZLBDH, ZAI, ZCJ, ZLSFACT, &
P_TH_DEPH, P_RH_DEPH )
@@ -1087,3 +864,4 @@ IF (LWARM .AND. LCOLD .AND. LHAIL) THEN
END IF
!
END SUBROUTINE LIMA_TENDENCIES
+END MODULE MODE_LIMA_TENDENCIES
diff --git a/src/common/micro/mode_nrcolss.F90 b/src/common/micro/mode_nrcolss.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3da87d0a49abb048b03c968b8334228ac906dd62
--- /dev/null
+++ b/src/common/micro/mode_nrcolss.F90
@@ -0,0 +1,271 @@
+!MNH_LIC Copyright 1994-2014 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_NRCOLSS
+ IMPLICIT NONE
+CONTAINS
+! ########################################################################
+ SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
+ PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PNRCOLSS, PAG, PBS, PAS )
+! ########################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of aggregates and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between aggregates and rain for use in collection
+!! kernels FOR CONCENTRATIONS. A first integral of the form
+!!
+!! infty Dz_max
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0 Dz_min
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of aggregates and Z
+!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
+!! specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CST : XPI,XRHOLW
+!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!! M. Taufour 03/2022 Adapted from rrcolss for concentration
+!! J. Wurtz 03/2022 New snow characteristics
+!!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODI_GENERAL_GAMMA
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
+REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNRCOLSS! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
+INTEGER :: JLBDAR ! Slope index of the size distribution of rain
+INTEGER :: JDS ! Diameter index of a particle of aggregates
+INTEGER :: JDR ! Diameter index of a particle of rain
+!
+INTEGER :: INR ! Number of diameter step for the partial integration
+!
+!
+REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
+REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
+REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
+REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
+REAL :: ZDDS ! Integration step of the diameter of aggregates
+REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
+REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
+REAL :: ZDS ! Current diameter of the particle aggregates
+REAL :: ZDR ! Current diameter of the rain
+REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
+REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of rain
+REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
+REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of aggregates and rain
+REAL :: ZSCALR ! Single integral of the scaling factor over
+ ! the spectrum of rain
+REAL :: ZSCALSR ! Double integral of the scaling factor over
+ ! the spectra of aggregates and rain
+REAL :: ZFUNC ! Ancillary function
+REAL :: ZCST1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!
+!* 1.0 Initialization
+!
+PNRCOLSS(:,:) = 0.0
+ZCST1 = (3.0/XPI)/XRHOLW
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNRCOLSS(:,:),1)-1) )
+ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNRCOLSS(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAS = 1,SIZE(PNRCOLSS(:,:),1)
+ ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
+!
+!* 1.3 Compute the diameter steps
+!
+ ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
+ DO JLBDAR = 1,SIZE(PNRCOLSS(:,:),2)
+ ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
+!
+!* 1.4 Initialize the collection integrals
+!
+ ZSCALSR = 0.0
+ ZCOLLSR = 0.0
+!
+!* 1.5 Compute the diameter steps
+!
+ ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
+!
+!* 1.6 Scan over the diameters DS and DR
+!
+ DO JDS = 1,KND-1
+ ZDS = ZDDS * REAL(JDS)
+ ZSCALR = 0.0
+ ZCOLLR = 0.0
+ DO JDR = 1,KND-1
+ ZDR = ZDDSCALR * REAL(JDR)
+!
+!* 1.7 Compute the normalization factor by integration over the
+! dimensional spectrum of rain
+!
+ ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+!
+!* 1.8 Compute the scaled fall speed difference by partial
+! integration over the dimensional spectrum of rain
+!
+ ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
+ IF( ZFUNC>0.0 ) THEN
+ ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
+ ELSE
+ ZDRMAX = PDINFTY / ZLBDAR
+ END IF
+ IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
+ ! corresponding to a maximal density of the aggregates of XRHOLW
+ IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
+ INR = CEILING( ZDRMAX/ZDDSCALR )
+ ZDDCOLLR = ZDRMAX / REAL(INR)
+ IF (INR>=KND ) THEN
+ INR = KND
+ ZDDCOLLR = ZDDSCALR
+ END IF
+ DO JDR = 1,INR-1
+ ZDR = ZDDCOLLR * REAL(JDR)
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+ ZCOLLDRMAX = (ZDS+ZDRMAX)**2 &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
+ ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
+!
+!* 1.9 Compute the normalization factor by integration over the
+! dimensional spectrum of aggregates
+!
+ ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
+ ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
+!
+!* 1.10 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of aggregates
+!
+ ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
+ END IF
+!
+! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
+! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+ END DO
+!
+!* 1.11 Scale the fall speed difference
+!
+ IF( ZSCALSR>0.0 ) PNRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
+ END DO
+END DO
+!
+END SUBROUTINE NRCOLSS
+END MODULE MODE_NRCOLSS
diff --git a/src/common/micro/mode_nscolrg.F90 b/src/common/micro/mode_nscolrg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..593d838d6951769c140653ea40fecdaac2352948
--- /dev/null
+++ b/src/common/micro/mode_nscolrg.F90
@@ -0,0 +1,272 @@
+!MNH_LIC Copyright 1994-2014 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_NSCOLRG
+ IMPLICIT NONE
+CONTAINS
+! ########################################################################
+ SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
+ PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
+ PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
+ PDINFTY, PNSCOLRG,PAG, PBS, PAS )
+! ########################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of the aggregates and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between aggregates and rain for use in collection
+!! kernels. A first integral of the form
+!!
+!! infty Dz_max
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0 Dz_min
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of the aggregates
+!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
+!! in a specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CST : XPI,XRHOLW
+!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!! M. Taufour 03/2022 Adapted from rscolrg for concentration
+!! J. Wurtz 03/2022 New snow characteristics
+!!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GENERAL_GAMMA
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
+!
+REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
+REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
+REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
+REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
+REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
+REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
+REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
+REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
+REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+REAL, INTENT(IN) :: PAG, PBS, PAS
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNSCOLRG! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
+INTEGER :: JLBDAR ! Slope index of the size distribution of rain
+INTEGER :: JDS ! Diameter index of a particle of the aggregates
+INTEGER :: JDR ! Diameter index of a particle of rain
+!
+INTEGER :: INR ! Number of diameter step for the partial integration
+!
+REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
+REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
+REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
+REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
+REAL :: ZDDS ! Integration step of the diameter of the aggregates
+REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
+REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
+REAL :: ZDS ! Current diameter of the particle aggregates
+REAL :: ZDR ! Current diameter of the raindrops
+REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
+REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
+REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of rain
+REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
+REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of the aggregates and rain
+REAL :: ZSCALR ! Single integral of the scaling factor over
+ ! the spectrum of rain
+REAL :: ZSCALSR ! Double integral of the scaling factor over
+ ! the spectra of the aggregates and rain
+REAL :: ZFUNC ! Ancillary function
+REAL :: ZCST1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!* 1.0 Initialization
+!
+PNSCOLRG(:,:) = 0.0
+ZCST1 = (3.0/XPI)/XRHOLW
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNSCOLRG(:,:),1)-1) )
+ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNSCOLRG(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAR = 1,SIZE(PNSCOLRG(:,:),1)
+ ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
+ ZDRMAX = PDINFTY / ZLBDAR
+!
+!* 1.3 Compute the diameter steps
+!
+ ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
+ DO JLBDAS = 1,SIZE(PNSCOLRG(:,:),2)
+ ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
+!
+!* 1.4 Initialize the collection integrals
+!
+ ZSCALSR = 0.0
+ ZCOLLSR = 0.0
+!
+!* 1.5 Compute the diameter steps
+!
+ ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
+!
+!* 1.6 Scan over the diameters DS and DR
+!
+ DO JDS = 1,KND-1
+ ZDS = ZDDS * REAL(JDS)
+ ZSCALR = 0.0
+ ZCOLLR = 0.0
+ DO JDR = 1,KND-1
+ ZDR = ZDDSCALR * REAL(JDR)
+!
+!* 1.7 Compute the normalization factor by integration over the
+! dimensional spectrum of rain
+!
+ ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+ END DO
+!
+!* 1.8 Compute the scaled fall speed difference by partial
+! integration over the dimensional spectrum of rain
+!
+ ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
+ IF( ZFUNC>0.0 ) THEN
+ ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
+ ELSE
+ ZDRMIN = 0.0
+ END IF
+ IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
+ ! corresponding to a maximal density of the aggregates of XRHOLW
+ IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
+ INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
+ ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
+ DO JDR = 1,INR-1
+ ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
+ END DO
+ IF( ZDRMIN>0.0 ) THEN
+ ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
+ ELSE
+ ZCOLLDRMIN = 0.0
+ END IF
+ ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
+!
+!* 1.9 Compute the normalization factor by integration over the
+! dimensional spectrum of the aggregates
+!
+ ZFUNC = GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS) ! MTaufour : !*(ZDS**PEXMASSS)
+ ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
+!
+!* 1.10 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of the aggregates
+!
+ ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
+!
+! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+!
+! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
+! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
+!
+ END IF
+ END DO
+!
+!* 1.10 Scale the fall speed difference
+!
+ IF( ZSCALSR>0.0 ) PNSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
+ END DO
+END DO
+!
+END SUBROUTINE NSCOLRG
+END MODULE MODE_NSCOLRG
diff --git a/src/common/micro/mode_nzcolx.F90 b/src/common/micro/mode_nzcolx.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5a3932bf461543d85ba4226d0c1d02531cd242fe
--- /dev/null
+++ b/src/common/micro/mode_nzcolx.F90
@@ -0,0 +1,232 @@
+!MNH_LIC Copyright 1994-2014 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_NZCOLX
+ IMPLICIT NONE
+CONTAINS
+! ################################################################
+ SUBROUTINE NZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
+ PEXZ, PFALLX, PEXFALLX, PFALLEXPX, &
+ PFALLZ, PEXFALLZ, PFALLEXPZ, &
+ PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
+ PDINFTY, PNZCOLX )
+! ################################################################
+!
+!
+!
+!!**** * - Build up a look-up table containing the scaled fall speed
+!! difference between size distributed particles of specy X and Z
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to integrate numerically the scaled fall
+!! speed difference between specy X and specy Z for use in collection
+!! kernels. A first integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| g(Dz) dDz} g(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! is evaluated and normalised by a second integral of the form
+!!
+!! infty
+!! / /
+!! |{| }
+!! |{| (Dx+Dz)^2 g(Dz) dDz} g(Dx) dDx
+!! |{| }
+!! / /
+!! 0
+!!
+!! where E_xz is a collection efficiency, g(D) is the generalized Gamma
+!! distribution law. The 'infty' diameter is defined according to the
+!! current value of the Lbda that is D_x=PDINFTY/Lbda_x or
+!! D_z=PINFTY/Lbda_z.
+!! The result is stored in a two-dimensional array.
+!!
+!!** METHOD
+!! ------
+!! The free parameters of the size distribution function of specy X and Z
+!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
+!! specific range
+!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
+!! The two above integrals are performed using the trapezoidal scheme and
+!! the [0,infty] interval is discretized over KND values of D_x or D_z.
+!!
+!! EXTERNAL
+!! --------
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
+!! Bulk Ice Scheme,JAS,51,249-280.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 8/11/95
+!! M. Taufour 03/2022: adapted from rzcolx for concentration
+!! J. Wurtz 03/2022: new snow characteristics
+!!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GENERAL_GAMMA
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
+!
+!
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
+!
+!
+REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
+REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
+REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X
+REAL, INTENT(IN) :: PFALLEXPX ! Fall speed exponential constant of specy X
+REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z
+REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z
+REAL, INTENT(IN) :: PFALLEXPZ ! Fall speed exponential constant of specy Z
+REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
+REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
+REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
+ ! which the diameter integration is performed
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNZCOLX ! Scaled fall speed difference in
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JLBDAX ! Slope index of the size distribution of specy X
+INTEGER :: JLBDAZ ! Slope index of the size distribution of specy Z
+INTEGER :: JDX ! Diameter index of a particle of specy X
+INTEGER :: JDZ ! Diameter index of a particle of specy Z
+!
+!
+REAL :: ZLBDAX ! Current slope parameter LAMBDA of specy X
+REAL :: ZLBDAZ ! Current slope parameter LAMBDA of specy Z
+REAL :: ZDLBDAX ! Growth rate of the slope parameter LAMBDA of specy X
+REAL :: ZDLBDAZ ! Growth rate of the slope parameter LAMBDA of specy Z
+REAL :: ZDDX ! Integration step of the diameter of specy X
+REAL :: ZDDZ ! Integration step of the diameter of specy Z
+REAL :: ZDX ! Current diameter of the particle specy X
+REAL :: ZDZ ! Current diameter of the particle specy Z
+REAL :: ZCOLLZ ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of specy Z
+REAL :: ZCOLLXZ ! Double integral of the mass weighted fall speed difference
+ ! over the spectra of specy X and specy Z
+REAL :: ZSCALZ ! Single integral of the scaling factor over
+ ! the spectrum of specy Z
+REAL :: ZSCALXZ ! Double integral of the scaling factor over
+ ! the spectra of specy X and specy Z
+REAL :: ZFUNC ! Ancillary function
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1 COMPUTE THE SCALED VELOCITZ DIFFERENCE IN THE MASS
+!* COLLECTION KERNEL,
+! -------------------------------------------------
+!
+!
+!
+!* 1.1 Compute the growth rate of the slope factors LAMBDA
+!
+ZDLBDAX = EXP( LOG(PLBDAXMAX/PLBDAXMIN)/REAL(SIZE(PNZCOLX(:,:),1)-1) )
+ZDLBDAZ = EXP( LOG(PLBDAZMAX/PLBDAZMIN)/REAL(SIZE(PNZCOLX(:,:),2)-1) )
+!
+!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
+!
+DO JLBDAX = 1,SIZE(PNZCOLX(:,:),1)
+ ZLBDAX = PLBDAXMIN * ZDLBDAX ** (JLBDAX-1)
+ DO JLBDAZ = 1,SIZE(PNZCOLX(:,:),2)
+ ZLBDAZ = PLBDAZMIN * ZDLBDAZ ** (JLBDAZ-1)
+!
+!* 1.3 Initialize the collection integrals
+!
+ ZSCALXZ = 0.0
+ ZCOLLXZ = 0.0
+!
+!* 1.4 Compute the diameter steps
+!
+ ZDDX = PDINFTY / (REAL(KND) * ZLBDAX)
+ ZDDZ = PDINFTY / (REAL(KND) * ZLBDAZ)
+!
+!* 1.5 Scan over the diameters DX and DZ
+!
+ DO JDX = 1,KND-1
+ ZDX = ZDDX * REAL(JDX)
+!
+ ZSCALZ = 0.0
+ ZCOLLZ = 0.0
+ DO JDZ = 1,KND-1
+ ZDZ = ZDDZ * REAL(JDZ)
+!
+!* 1.6 Compute the normalization factor by integration over the
+! dimensional spectrum of specy Z
+!
+ ZFUNC = (ZDX+ZDZ)**2 * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ)
+ ZSCALZ = ZSCALZ + ZFUNC
+!
+!* 1.7 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of specy Z
+!
+ ZCOLLZ = ZCOLLZ + ZFUNC * PEXZ * ABS( PFALLX*ZDX**PEXFALLX * EXP(-(ZDX*PFALLEXPX)**PALPHAX) &
+ - PFALLZ*ZDZ**PEXFALLZ * EXP(-(ZDZ*PFALLEXPZ)**PALPHAZ))
+ END DO
+!
+!* 1.8 Compute the normalization factor by integration over the
+! dimensional spectrum of specy X
+!
+ ZFUNC = GENERAL_GAMMA(PALPHAX,PNUX,ZLBDAX,ZDX)
+ ZSCALXZ = ZSCALXZ + ZSCALZ * ZFUNC
+!
+!* 1.9 Compute the scaled fall speed difference by integration over
+! the dimensional spectrum of specy X
+!
+ ZCOLLXZ = ZCOLLXZ + ZCOLLZ * ZFUNC
+ END DO
+!
+!* 1.10 Scale the fall speed difference
+!
+ PNZCOLX(JLBDAX,JLBDAZ) = ZCOLLXZ / ZSCALXZ
+ END DO
+END DO
+!
+END SUBROUTINE NZCOLX
+END MODULE MODE_NZCOLX
diff --git a/src/mesonh/micro/set_conc_lima.f90 b/src/common/micro/mode_set_conc_lima.F90
similarity index 87%
rename from src/mesonh/micro/set_conc_lima.f90
rename to src/common/micro/mode_set_conc_lima.F90
index 09e6bc1e51c5658584cd908ebddbd8803ee797db..1a439bafcf36c03bb0f5afe28b8d639f4a823fe0 100644
--- a/src/mesonh/micro/set_conc_lima.f90
+++ b/src/common/micro/mode_set_conc_lima.F90
@@ -73,7 +73,7 @@ contains
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM, LRAIN, NMOD_CCN, NMOD_IFN, &
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_CCN, NMOD_IFN, &
NMOM_C, NMOM_R, NMOM_I
USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI, XAS, XBS
USE MODD_PARAM_LIMA_MIXED,ONLY : XAG, XBG, XAH, XBH
@@ -81,8 +81,6 @@ USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, N
NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, NSV_LIMA_IFN_NUCL_A
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
USE MODD_CONF, ONLY : NVERB
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_LUNIT_n, ONLY : TLUOUT
!
IMPLICIT NONE
!
@@ -99,20 +97,17 @@ REAL, DIMENSION(:,:,:,NSV_LIMA_BEG_A(kmi):), INTENT(INOUT):: PSVT ! microph
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
REAL :: ZCONC
!
!-------------------------------------------------------------------------------
!* 1. RETRIEVE LOGICAL UNIT NUMBER
! ----------------------------
!
-ILUOUT = TLUOUT%NLU
!
!* 2. INITIALIZATION
! --------------
!
-IF (LWARM .AND. NRR.GE.2 .AND. NMOM_C.GE.2) THEN
+IF (NMOM_C.GE.2) THEN
!
! droplets
!
@@ -134,13 +129,9 @@ IF (LWARM .AND. NRR.GE.2 .AND. NMOM_C.GE.2) THEN
END WHERE
END IF
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The droplet concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
END IF
!
-IF (LWARM .AND. LRAIN .AND. NRR.GE.3 .AND. NMOM_R.GE.2) THEN
+IF (NMOM_R.GE.2) THEN
!
! drops
!
@@ -156,14 +147,10 @@ IF (LWARM .AND. LRAIN .AND. NRR.GE.3 .AND. NMOM_R.GE.2) THEN
PRT(:,:,:,3) = 0.0
PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
END WHERE
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The raindrop concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
END IF
END IF
!
-IF (LCOLD .AND. NRR.GE.4 .AND. NMOM_I.GE.2) THEN
+IF (NMOM_I.GE.2) THEN
!
! ice crystals
!
@@ -190,11 +177,6 @@ IF (LCOLD .AND. NRR.GE.4 .AND. NMOM_I.GE.2) THEN
END WHERE
END IF
-! IF( NVERB >= 5 ) THEN
-! WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
-! WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
-! END IF
-!
END IF
!
IF (NSV_LIMA_NS_A(KMI).GE.1) THEN
diff --git a/src/common/micro/modi_lima.F90 b/src/common/micro/modi_lima.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6cd5fa338a4bde2175fa985d0e14d370718c9ec7
--- /dev/null
+++ b/src/common/micro/modi_lima.F90
@@ -0,0 +1,65 @@
+MODULE MODI_LIMA
+!
+INTERFACE
+!
+ SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ PTSTEP, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+INTEGER, INTENT(IN) :: NCCN ! for array size declarations
+INTEGER, INTENT(IN) :: NIFN ! for array size declarations
+INTEGER, INTENT(IN) :: NIMM ! for array size declarations
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRI ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
+!
+END SUBROUTINE LIMA
+END INTERFACE
+END MODULE MODI_LIMA
diff --git a/src/common/micro/modi_lima_adjust_split.F90 b/src/common/micro/modi_lima_adjust_split.F90
new file mode 100644
index 0000000000000000000000000000000000000000..aeb84748a1a24cd73f99e9c042969df03f645deb
--- /dev/null
+++ b/src/common/micro/modi_lima_adjust_split.F90
@@ -0,0 +1,71 @@
+! #############################
+ MODULE MODI_LIMA_ADJUST_SPLIT
+! #############################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ KRR, KMI, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
+ PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF)
+!
+!USE MODD_IO, ONLY: TFILEDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Absolute Pressure at t+dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
+END INTERFACE
+END MODULE MODI_LIMA_ADJUST_SPLIT
diff --git a/src/common/micro/modi_lima_precip_scavenging.F90 b/src/common/micro/modi_lima_precip_scavenging.F90
new file mode 100644
index 0000000000000000000000000000000000000000..918e2982eba4d565648da504c0051aa88922fb34
--- /dev/null
+++ b/src/common/micro/modi_lima_precip_scavenging.F90
@@ -0,0 +1,40 @@
+!#################################
+MODULE MODI_LIMA_PRECIP_SCAVENGING
+!#################################
+!
+ INTERFACE
+!
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ use modd_budget, only: TBUDGETDATA,TBUDGETCONF_t
+ USE MODD_CST, ONLY: CST_t
+!
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CST_t), INTENT(IN) :: CST
+ TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+ TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+ INTEGER, INTENT(IN) :: KBUDGETS
+!
+ CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+ INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+ INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+ REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+ END SUBROUTINE LIMA_PRECIP_SCAVENGING
+ END INTERFACE
+END MODULE MODI_LIMA_PRECIP_SCAVENGING
diff --git a/src/common/turb/turb.F90 b/src/common/turb/turb.F90
index 58e0ba1847373e468597bdfa8ed1590f97281dc0..0cfafc17ae355cf3decb1037417d15745a7df402 100644
--- a/src/common/turb/turb.F90
+++ b/src/common/turb/turb.F90
@@ -1025,12 +1025,12 @@ CALL TURB_VER(D,CST,CSTURB,TURBN,TLES, &
PSSTFL, PSSTFL_C, PSSRFL_C,PSSUFL_C,PSSVFL_C, &
PSSUFL,PSSVFL )
-IF (HCLOUD == 'LIMA') THEN
- IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
- IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
- IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
- IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
-END IF
+!IF (HCLOUD == 'LIMA') THEN
+! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+! IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
+!END IF
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:,:) )
@@ -1127,12 +1127,12 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
#endif
!
- IF (HCLOUD == 'LIMA') THEN
- IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
- IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
- IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
- IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
- END IF
+! IF (HCLOUD == 'LIMA') THEN
+! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+! IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
+! END IF
!
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:,:) )
diff --git a/src/mesonh/aux/sources_neg_correct.f90 b/src/mesonh/aux/sources_neg_correct.f90
index a1e83273438f5385109ad6a35844d083b44317ca..0302839408bb4045ae0b78adc29bdc812452c071 100644
--- a/src/mesonh/aux/sources_neg_correct.f90
+++ b/src/mesonh/aux/sources_neg_correct.f90
@@ -53,7 +53,7 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
use modd_cst, only: xci, xcl, xcpd, xcpv, xlstt, xlvtt, xp00, xrd, xtt
use modd_nsv, only: nsv_c2r2beg, nsv_c2r2end, nsv_lima_beg, nsv_lima_end, nsv_lima_nc, nsv_lima_nr,&
nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh
-use modd_param_lima, only: lcold_lima => lcold, lrain_lima => lrain, lspro_lima => lspro, lwarm_lima => lwarm, &
+use modd_param_lima, only: lspro_lima => lspro, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
use mode_budget, only: Budget_store_init, Budget_store_end
diff --git a/src/mesonh/ext/boundaries.f90 b/src/mesonh/ext/boundaries.f90
new file mode 100644
index 0000000000000000000000000000000000000000..111dbc701d5c112ccc4d00cbf6331afb089f129c
--- /dev/null
+++ b/src/mesonh/ext/boundaries.f90
@@ -0,0 +1,1281 @@
+!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_BOUNDARIES
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE BOUNDARIES
+!
+END INTERFACE
+!
+
+END MODULE MODI_BOUNDARIES
+!
+!
+! ####################################################################
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+! ####################################################################
+!
+!!**** *BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
+!! all variables at a scalar localization relative to the
+!! considered boundary.
+!!
+!! PURPOSE
+!! -------
+! Fill up the left and right lateral EXTernal zones, for all prognostic
+! variables, at time t and t-dt, to avoid particular cases close to
+! the Lateral Boundaries in routines computing the evolution terms, in
+! particular in the advection routines.
+!
+!!** METHOD
+!! ------
+!! 3 different options are proposed: 'WALL' 'CYCL' 'OPEN'
+!! to define the Boundary Condition type,
+!! though the variables HLBCX and HLBCY (for the X and Y-directions
+!! respectively).
+!! For the 'OPEN' type of LBC, the treatment depends
+!! on the flow configuration: i.e. INFLOW or OUTFLOW conditions.
+!!
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS :
+!! JPHEXT ,JPVEXT
+!!
+!! Module MODD_CONF :
+!! CCONF
+!!
+!! Module MODE_UPDATE_NSV :
+!! NSV_CHEM, NSV_CHEMBEG, NSV_CHEMEND
+!!
+!! Module MODD_CTURB :
+!! XTKEMIN
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 of documentation (routine BOUNDARIES)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Lafore J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/10/94
+!! Modification 02/11/94 (J.Stein) copy for t-dt at the external points
+!! + change the copy formulation
+!! Modification 18/11/94 (J.Stein) bug correction in the normal velocity
+!! prescription in the WALL cases
+!! Modification 13/02/95 (Lafore) to account for the OPEN case and
+!! for the LS fields introduction
+!! Modification 03/03/95 (Mallet) corrections in variables names in
+!! the Y-OPEN case
+!! 16/03/95 (J.Stein) remove R from the historical variables
+!! Modification 31/05/95 (Lafore) MASTER_DEV2.1 preparation after the
+!! LBC tests performed by I. Mallet
+!! Modification 15/03/96 (Richard) bug correction for OPEN CASE: (TOP Y-LBC)
+!! Rv case
+!! Modification 15/03/96 (Shure) bug correction for SV variable in
+!! open x right case
+!! Modification 24/10/96 (Masson) initialization of outer points in
+!! wall cases for spawning interpolations
+!! Modification 13/03/97 (Lafore) "surfacic" LS-fields introduction
+!! Modification 10/04/97 (Lafore) proper treatment of minima for TKE and EPS
+!! Modification 01/09/97 (Masson) minimum value for water and passive
+!! scalars set to zero at instants M,T
+!! Modification 20/10/97 (Lafore) introduction of DAVI type of lbc
+!! suppression of NEST type
+!! Modification 12/11/97 ( Stein ) use the lB fields
+!! Modification 02/06/98 (Lafore) declaration of local variables (PLBXUM
+!! and PLBXWM do'nt have the same size)
+!! Modification 24/08/98 (Jabouille) parallelize the code
+!! Modification 20/04/99 ( Stein ) use the same conditions for times t
+!! and t-dt
+!! Modification 11/04/00 (Mari) special conditions for chemical variables
+!! Modification 10/01/01 (Tulet) update for MOCAGE boundary conditions
+!! Modification 22/01/01 (Gazen) use NSV_CHEM,NSV_CHEMBEG,NSV_CHEMEND variables
+!! Modification 22/06/01(Jabouille) use XSVMIN
+!! Modification 20/11/01(Gazen & Escobar) rewrite GCHBOUNDARY for portability
+!! Modification 14/03/05 (Tulet) bug : in case of CYCL do not call ch_boundaries
+!! Modification 14/05/05 (Tulet) add aerosols / dust
+!! Modification 05/06 Suppression of DAVI type of lbc
+!! Modification 05/06 Remove EPS
+!! Modification 12/2010 (Chong) Add boundary condition for ions
+!! (fair weather profiles)
+!! Modification 07/2013 (Bosseur & Filippi) adds Forefire
+!! Modification 04/2013 (C.Lac) Remove instant M
+!! Modification 01/2015 (JL Redelsperger) Introduction of ponderation
+!! for non normal velocity and potential temp
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
+!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
+!! Modification 18/07/17 (Vionnet) Add blowing snow variables
+!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,NBLOWSNOW_2D
+USE MODD_BLOWSNOW_n
+USE MODD_CH_AEROSOL , ONLY : LORILAM
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_DUST
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE, ONLY : LFOREFIRE
+#endif
+USE MODD_LBC_n, ONLY : XPOND
+USE MODE_ll
+USE MODD_NESTING, ONLY : NDAD
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND
+USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
+USE MODD_PASPOL, ONLY : LPASPOL
+USE MODD_PRECISION, ONLY: MNHREAL32
+USE MODD_REF_n
+USE MODD_SALT, ONLY : LSALT
+
+USE MODE_MODELN_HANDLER
+USE MODE_SET_CONC_LIMA
+
+USE MODI_CH_BOUNDARIES
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODI_ION_BOUNDARIES
+
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JEXT ! Loop index for EXTernal points
+INTEGER :: JRR ! Loop index for RR variables (water)
+INTEGER :: JSV ! Loop index for Scalar Variables
+INTEGER :: IMI ! Model Index
+REAL :: ZTSTEP ! effective time step
+REAL :: ZPOND ! Coeff PONDERATION LS
+INTEGER :: ILBX,ILBY ! size of LB fields' arrays
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GCHBOUNDARY, GAERBOUNDARY,&
+ GDSTBOUNDARY, GSLTBOUNDARY, GPPBOUNDARY, &
+ GCSBOUNDARY, GICBOUNDARY, GLIMABOUNDARY,GSNWBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALL1 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL2 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL3 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL5 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLPP = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLCS = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLIC = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLLIMA = .TRUE.
+!
+REAL, DIMENSION(SIZE(PLBXWM,1),SIZE(PLBXWM,2),SIZE(PLBXWM,3)) :: &
+ ZLBXVT,ZLBXWT,ZLBXTHT
+REAL, DIMENSION(SIZE(PLBYWM,1),SIZE(PLBYWM,2),SIZE(PLBYWM,3)) :: &
+ ZLBYUT,ZLBYWT,ZLBYTHT
+REAL, DIMENSION(SIZE(PLBXTKEM,1),SIZE(PLBXTKEM,2),SIZE(PLBXTKEM,3)) :: &
+ ZLBXTKET
+REAL, DIMENSION(SIZE(PLBYTKEM,1),SIZE(PLBYTKEM,2),SIZE(PLBYTKEM,3)) :: &
+ ZLBYTKET
+REAL, DIMENSION(SIZE(PLBXRM,1),SIZE(PLBXRM,2),SIZE(PLBXRM,3),SIZE(PLBXRM,4)) :: &
+ ZLBXRT
+REAL, DIMENSION(SIZE(PLBYRM,1),SIZE(PLBYRM,2),SIZE(PLBYRM,3),SIZE(PLBYRM,4)) :: &
+ ZLBYRT
+REAL, DIMENSION(SIZE(PLBXSVM,1),SIZE(PLBXSVM,2),SIZE(PLBXSVM,3),SIZE(PLBXSVM,4)) :: &
+ ZLBXSVT
+REAL, DIMENSION(SIZE(PLBYSVM,1),SIZE(PLBYSVM,2),SIZE(PLBYSVM,3),SIZE(PLBYSVM,4)) :: &
+ ZLBYSVT
+LOGICAL :: GCHTMP
+LOGICAL :: GPPTMP
+LOGICAL :: GCSTMP
+!
+LOGICAL, SAVE :: GFIRSTCALL4 = .TRUE.
+!
+#ifdef MNH_FOREFIRE
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GFFBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALLFF = .TRUE.
+LOGICAL :: GFFTMP
+#endif
+!
+INTEGER :: JI,JJ
+!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+
+!
+! at the instant t
+!
+IF(SIZE(PUT) /= 0) PUT (:,:,IKB-1) = PUT (:,:,IKB)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKB-1) = PVT (:,:,IKB)
+IF(SIZE(PWT) /= 0) PWT (:,:,IKB-1) = PWT (:,:,IKB)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKB-1) = PTHT (:,:,IKB)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKB-1) = PTKET(:,:,IKB)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKB-1,:)= PRT (:,:,IKB,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKB-1,:)= PSVT (:,:,IKB,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKB-1) = PSRCT(:,:,IKB)
+!
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+! at the instant t
+!
+IF(SIZE(PWT) /= 0) PWT (:,:,IKE+1) = 0.
+IF(SIZE(PUT) /= 0) PUT (:,:,IKE+1) = PUT (:,:,IKE)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKE+1) = PVT (:,:,IKE)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKE+1) = PTHT (:,:,IKE)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKE+1) = PTKET(:,:,IKE)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKE+1,:) = PRT (:,:,IKE,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKE+1,:) = PSVT (:,:,IKE,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKE+1) = PSRCT(:,:,IKE)
+
+! specific for positive and negative ions mixing ratios (1/kg)
+
+IF (NSV_ELEC .NE. 0) THEN
+!
+ IF (SIZE(PWT) /= 0) THEN
+ WHERE ( PWT(:,:,IKE+1) .GE. 0.) ! Outflow
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = 2.*PSVT (:,:,IKE,NSV_ELECBEG) - &
+ PSVT (:,:,IKE-1,NSV_ELECBEG)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = 2.*PSVT (:,:,IKE,NSV_ELECEND) - &
+ PSVT (:,:,IKE-1,NSV_ELECEND)
+ ELSE WHERE ! Inflow from the top
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = XCION_POS_FW(:,:,IKE+1)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
+ END WHERE
+ ENDIF
+!
+END IF
+
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE LB FIELDS AT TIME T
+! ---------------------------
+!
+!
+IF ( KTCOUNT == 1) THEN
+ ZTSTEP = 0.
+ELSE
+ ZTSTEP = PTSTEP
+END IF
+!
+!
+IF ( SIZE(PLBXTHS,1) /= 0 .AND. &
+ ( HLBCX(1)=='OPEN' .OR. HLBCX(2)=='OPEN') ) THEN
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:) + ZTSTEP * PLBXVS(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:) + ZTSTEP * PLBXWS(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:) + ZTSTEP * PLBXTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:) + ZTSTEP * PLBXTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:) + ZTSTEP * PLBXRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:) + ZTSTEP * PLBXSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBXVT(:,:,:) = real(ZLBXVT(:,:,:),kind=MNHREAL32)
+ZLBXWT(:,:,:) = real(ZLBXWT(:,:,:),kind=MNHREAL32)
+ZLBXTHT(:,:,:) = real(ZLBXTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = real(ZLBXTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = real(ZLBXRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = real(ZLBXSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+IF ( SIZE(PLBYTHS,1) /= 0 .AND. &
+ ( HLBCY(1)=='OPEN' .OR. HLBCY(2)=='OPEN' )) THEN
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:) + ZTSTEP * PLBYWS(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:) + ZTSTEP * PLBYTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:) + ZTSTEP * PLBYTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:) + ZTSTEP * PLBYRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:) + ZTSTEP * PLBYSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBYUT(:,:,:) = real(ZLBYUT(:,:,:),kind=MNHREAL32)
+ZLBYWT(:,:,:) = real(ZLBYWT(:,:,:),kind=MNHREAL32)
+ZLBYTHT(:,:,:) = real(ZLBYTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = real(ZLBYTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = real(ZLBYRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = real(ZLBYSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+!-------------------------------------------------------------------------------
+! PONDERATION COEFF for Non-Normal velocities and pot temperature
+!
+ZPOND = XPOND
+!
+!* 4. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LWEST_ll( )) THEN
+!
+!
+SELECT CASE ( HLBCX(1) )
+!
+!* 4.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIB-JEXT,:,:) = PUT (IIB ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIB-JEXT,:,:) = PVT (IIB-1+JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIB-JEXT,:,:) = PWT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT(IIB-JEXT,:,:) = PTHT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTKET)/= 0) PTKET(IIB-JEXT,:,:) = PTKET(IIB-1+JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIB-JEXT,:,:,:) = PRT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIB-JEXT,:,:,:) = PSVT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIB-JEXT,:,:) = PSRCT (IIB-1+JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIB-JEXT,:,:) = XSNWCANO(IIB-1+JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIB ,:,:) = 0. ! set the normal velocity
+!
+!
+!* 4.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PVT (JI,:,:) = 2.*PVT (JI+1,:,:) -PVT (JI+2,:,:)
+ PWT (JI,:,:) = 2.*PWT (JI+1,:,:) -PWT (JI+2,:,:)
+ PTHT (JI,:,:) = 2.*PTHT (JI+1,:,:) -PTHT (JI+2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (JI,:,:) = ZPOND*ZLBXVT (JI,:,:) + (1.-ZPOND)* PVT(JI+1,:,:) ! 1
+ PWT (JI,:,:) = ZPOND*ZLBXWT (JI,:,:) + (1.-ZPOND)* PWT(JI+1,:,:) ! 1
+ PTHT (JI,:,:) = ZPOND*ZLBXTHT (JI,:,:) + (1.-ZPOND)* PTHT(JI+1,:,:)! 1
+ ENDWHERE
+ ENDDO
+ ENDIF
+!
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, 2.*PTKET(JI+1,:,:)-PTKET(JI+2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(JI,:,:) + (1.-ZPOND)*PTKET(JI+1,:,:))
+ ENDWHERE
+ ENDDO
+ END IF
+ !
+! Case with KRR moist variables
+!
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,2.*PRT(JI+1,:,:,JRR) -PRT(JI+2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,ZLBXRT(JI,:,:,JRR)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PSRCT (JI,:,:) = PSRCT (JI+1,:,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(JI+1,:,:,JSV) - &
+ PSVT(JI+2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(JI,:,:,JSV)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+ !
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,NBLOWSNOW_2D
+ WHERE ( PUT(IIB,:,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = MAX(0.,2.*XSNWCANO(IIB,:,JSV) - &
+ XSNWCANO(IIB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(IIB-1,:,:,JSV) = MAX(0.,2.*PSVT(IIB,:,:,JSV) - &
+ PSVT(IIB+1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIB-1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5 LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
+! ===============--------------------------------
+!
+IF (LEAST_ll( )) THEN
+!
+SELECT CASE ( HLBCX(2) )
+!
+!* 5.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIE+JEXT,:,:) = PUT (IIE ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIE+JEXT,:,:) = PVT (IIE+1-JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIE+JEXT,:,:) = PWT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT (IIE+JEXT,:,:) = PTHT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTKET) /= 0) PTKET(IIE+JEXT,:,:) = PTKET(IIE+1-JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIE+JEXT,:,:,:) = PRT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIE+JEXT,:,:,:) = PSVT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIE+JEXT,:,:)= PSRCT (IIE+1-JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIE+JEXT,:,:) = XSNWCANO(IIE+1-JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIE+1 ,:,:) = 0. ! set the normal velocity
+!
+!* 5.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ ILBX = SIZE(PLBXVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PVT (IIE+JI,:,:) = 2.*PVT (IIE+JI-1,:,:) -PVT (IIE+JI-2,:,:)
+ PWT (IIE+JI,:,:) = 2.*PWT (IIE+JI-1,:,:) -PWT (IIE+JI-2,:,:)
+ PTHT (IIE+JI,:,:) = 2.*PTHT (IIE+JI-1,:,:) -PTHT (IIE+JI-2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (IIE+JI,:,:) = ZPOND*ZLBXVT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PVT(IIE+JI-1,:,:)
+ PWT (IIE+JI,:,:) = ZPOND*ZLBXWT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PWT(IIE+JI-1,:,:)
+ PTHT (IIE+JI,:,:) = ZPOND*ZLBXTHT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PTHT(IIE+JI-1,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBX = SIZE(PLBXTKEM,1)
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, 2.*PTKET(IIE+JI-1,:,:)-PTKET(IIE+JI-2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(ILBX-JPHEXT+JI,:,:) + &
+ (1.-ZPOND)*PTKET(IIE+JI-1,:,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBX=SIZE(PLBXRM,1)
+ !
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,2.*PRT(IIE+JI-1,:,:,JRR) -PRT(IIE+JI-2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,ZLBXRT(ILBX-JPHEXT+JI,:,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=1,JPHEXT
+ PSRCT (IIE+JI,:,:) = PSRCT (IIE+JI-1,:,:)
+ END DO
+ END IF
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBX=SIZE(PLBXSVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(IIE+JI-1,:,:,JSV) - &
+ PSVT(IIE+JI-2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(ILBX-JPHEXT+JI,:,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PUT(IIE+1,:,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = MAX(0.,2.*XSNWCANO(IIE,:,JSV) - &
+ XSNWCANO(IIE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+1,:,:,JSV) = MAX(0.,2.*PSVT(IIE,:,:,JSV) - &
+ PSVT(IIE-1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 6. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------
+IF (LSOUTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(1) )
+!
+!* 6.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJB-JEXT,:) = PUT (:,IJB-1+JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJB-JEXT,:) = PVT (:,IJB ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJB-JEXT,:) = PWT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJB-JEXT,:) = PTHT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJB-JEXT,:) = PTKET(:,IJB-1+JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJB-JEXT,:,:) = PRT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJB-JEXT,:,:)= PSVT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-JEXT,:) = PSRCT(:,IJB-1+JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJB-JEXT,:) = XSNWCANO(:,IJB-1+JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJB ,:) = 0. ! set the normal velocity
+!
+!* 6.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PUT (:,JJ,:) = 2.*PUT (:,JJ+1,:) -PUT (:,JJ+2,:)
+ PWT (:,JJ,:) = 2.*PWT (:,JJ+1,:) -PWT (:,JJ+2,:)
+ PTHT (:,JJ,:) = 2.*PTHT (:,JJ+1,:) -PTHT (:,JJ+2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,JJ,:) = ZPOND*ZLBYUT (:,JJ,:) + (1.-ZPOND)* PUT(:,JJ+1,:)
+ PWT (:,JJ,:) = ZPOND*ZLBYWT (:,JJ,:) + (1.-ZPOND)* PWT(:,JJ+1,:)
+ PTHT (:,JJ,:) = ZPOND*ZLBYTHT (:,JJ,:) + (1.-ZPOND)* PTHT(:,JJ+1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,JJ+1,:)-PTKET(:,JJ+2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,JJ,:) + &
+ (1.-ZPOND)*PTKET(:,JJ+1,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,2.*PRT(:,JJ+1,:,JRR) -PRT(:,JJ+2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,ZLBYRT(:,JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PSRCT(:,JJ,:) = PSRCT(:,JJ+1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+!
+ DO JSV=1 ,KSV
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,JJ+1,:,JSV) - &
+ PSVT(:,JJ+2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJB,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = MAX(0.,2.*XSNWCANO(:,IJB,JSV) - &
+ XSNWCANO(:,IJB+1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,IJB-1,:,JSV) = MAX(0.,2.*PSVT(:,IJB,:,JSV) - &
+ PSVT(:,IJB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 7. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
+! ===============
+!
+IF (LNORTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(2) )
+!
+!* 4.3.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJE+JEXT,:) = PUT (:,IJE+1-JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJE+JEXT,:) = PVT (:,IJE ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJE+JEXT,:) = PWT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJE+JEXT,:) = PTHT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJE+JEXT,:) = PTKET(:,IJE+1-JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJE+JEXT,:,:) = PRT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJE+JEXT,:,:)= PSVT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+JEXT,:) = PSRCT(:,IJE+1-JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJE+JEXT,:) = XSNWCANO(:,IJE+1-JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJE+1 ,:) = 0. ! set the normal velocity
+!
+!* 4.3.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+!
+ ILBY=SIZE(PLBYUM,2)
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PUT (:,IJE+JJ,:) = 2.*PUT (:,IJE+JJ-1,:) -PUT (:,IJE+JJ-2,:)
+ PWT (:,IJE+JJ,:) = 2.*PWT (:,IJE+JJ-1,:) -PWT (:,IJE+JJ-2,:)
+ PTHT (:,IJE+JJ,:) = 2.*PTHT (:,IJE+JJ-1,:) -PTHT (:,IJE+JJ-2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,IJE+JJ,:) = ZPOND*ZLBYUT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PUT(:,IJE+JJ-1,:)
+ PWT (:,IJE+JJ,:) = ZPOND*ZLBYWT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PWT(:,IJE+JJ-1,:)
+ PTHT (:,IJE+JJ,:) = ZPOND*ZLBYTHT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PTHT(:,IJE+JJ-1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBY=SIZE(PLBYTKEM,2)
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,IJE+JJ-1,:)-PTKET(:,IJE+JJ-2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,ILBY-JPHEXT+JJ,:) + &
+ (1.-ZPOND)*PTKET(:,IJE+JJ-1,:))
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBY=SIZE(PLBYRM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,2.*PRT(:,IJE+JJ-1,:,JRR) -PRT(:,IJE+JJ-2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,ZLBYRT(:,ILBY-JPHEXT+JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ PSRCT(:,IJE+JJ,:) = PSRCT(:,IJE+JJ-1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBY=SIZE(PLBYSVM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,IJE+JJ-1,:,JSV) - &
+ PSVT(:,IJE+JJ-2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,ILBY-JPHEXT+JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJE+1,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = MAX(0.,2.*XSNWCANO(:,IJE,JSV) - &
+ XSNWCANO(:,IJE-1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+1,:,JSV) = MAX(0.,2.*PSVT(:,IJE,:,JSV) - &
+ PSVT(:,IJE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+END SELECT
+END IF
+!
+!
+IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
+
+ ZSVT=PSVT
+ ZRT=PRT
+
+ IF (GFIRSTCALLLIMA) THEN
+ ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
+ GFIRSTCALLLIMA = .FALSE.
+ DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
+ DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+ DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+
+ CALL SET_CONC_LIMA( IMI, 'NONE', PRHODREF, ZRT(:, :, :, :), ZSVT(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
+ IF (NSV_LIMA_NC.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NC-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
+ PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
+ PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
+ PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NR.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NR-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
+ PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
+ PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
+ PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NI.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NI-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
+ PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
+ PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
+ PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
+ ENDIF
+ END IF
+END IF
+!
+!
+IF (LUSECHEM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL1) THEN
+ ALLOCATE(GCHBOUNDARY(NSV_CHEM))
+ GFIRSTCALL1 = .FALSE.
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCHBOUNDARY(JSV-NSV_CHEMBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LUSECHIC .AND. IMI == 1) THEN
+ IF (GFIRSTCALLIC) THEN
+ ALLOCATE(GICBOUNDARY(NSV_CHIC))
+ GFIRSTCALLIC = .FALSE.
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GICBOUNDARY(JSV-NSV_CHICBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+IF (LORILAM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL2) THEN
+ ALLOCATE(GAERBOUNDARY(NSV_AER))
+ GFIRSTCALL2 = .FALSE.
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GAERBOUNDARY(JSV-NSV_AERBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LDUST .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GDSTBOUNDARY(NSV_DST))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GDSTBOUNDARY(JSV-NSV_DSTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LSALT .AND. IMI == 1) THEN
+ IF (GFIRSTCALL5) THEN
+ ALLOCATE(GSLTBOUNDARY(NSV_SLT))
+ GFIRSTCALL5 = .FALSE.
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GSLTBOUNDARY(JSV-NSV_SLTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LPASPOL .AND. IMI == 1) THEN
+ IF (GFIRSTCALLPP) THEN
+ ALLOCATE(GPPBOUNDARY(NSV_PP))
+ GFIRSTCALLPP = .FALSE.
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ GPPTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GPPBOUNDARY(JSV-NSV_PPBEG+1) = GPPTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LCONDSAMP .AND. IMI == 1) THEN
+ IF (GFIRSTCALLCS) THEN
+ ALLOCATE(GCSBOUNDARY(NSV_CS))
+ GFIRSTCALLCS = .FALSE.
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ GCSTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCSBOUNDARY(JSV-NSV_CSBEG+1) = GCSTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+
+IF (LBLOWSNOW .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GSNWBOUNDARY(NSV_SNW))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(1,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,1,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY,:,JSV)==0)
+ GSNWBOUNDARY(JSV-NSV_SNWBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ENDIF
+
+#ifdef MNH_FOREFIRE
+!ForeFire
+IF ( LFOREFIRE .AND. IMI == 1) THEN
+ IF (GFIRSTCALLFF) THEN
+ ALLOCATE(GFFBOUNDARY(NSV_FF))
+ GFIRSTCALLFF = .FALSE.
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ GFFTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GFFBOUNDARY(JSV-NSV_FFBEG+1) = GFFTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ IF (GFFBOUNDARY(JSV-NSV_FFBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+#endif
+!
+IF ( CELEC /= 'NONE' .AND. (NSV_ELEC_A(NDAD(IMI)) == 0 .OR. IMI == 1)) THEN
+ CALL ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BOUNDARIES
diff --git a/src/mesonh/ext/default_desfmn.f90 b/src/mesonh/ext/default_desfmn.f90
index 0597b379c5aeca8cd26e19d71a7b33d4fa478296..b5b8b062cd9e131280a96e635a6a1c5bf0cf6636 100644
--- a/src/mesonh/ext/default_desfmn.f90
+++ b/src/mesonh/ext/default_desfmn.f90
@@ -278,13 +278,13 @@ USE MODD_ALLPROFILER_n
USE MODD_ALLSTATION_n
!
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, &
+USE MODD_PARAM_LIMA, ONLY : LNUCL, LSEDI, LHHONI, LMEYERS, &
NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
CINT_MIXING, NMOD_IMM, NIND_SPECIE, LMURAKAMI, &
YSNOW_T=>LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
XFACTNUC_DEP, XFACTNUC_CON, &
- OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
+ LACTI, OSEDC=>LSEDC, &
OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, LKHKO, NMOM_C, NMOM_R, &
NMOD_CCN, XCCN_CONC, LKESSLERAC, &
LCCN_HOM, CCCN_MODES, &
@@ -311,7 +311,7 @@ USE MODD_IBM_LSF
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
-USE MODD_FIRE
+USE MODD_FIRE_n
!
IMPLICIT NONE
!
@@ -1009,9 +1009,7 @@ IF (KMI == 1) THEN
YNUR = 2.0
YALPHAR = 1.0
!
- OWARM = .TRUE.
LACTI = .TRUE.
- ORAIN = .TRUE.
OSEDC = .TRUE.
OACTIT = .FALSE.
LADJ = .TRUE.
@@ -1049,11 +1047,8 @@ IF (KMI == 1) THEN
XCCN_CONC(:)=300.
!
LHHONI = .FALSE.
- LCOLD = .TRUE.
LNUCL = .TRUE.
LSEDI = .TRUE.
- LSNOW = .TRUE.
- LHAIL = .FALSE.
YSNOW_T = .FALSE.
LMURAKAMI = .TRUE.
CPRISTINE_ICE_LIMA = 'PLAT'
@@ -1431,68 +1426,66 @@ ENDIF
XARECYCLS = 0.
XDRECYCLE = 0.
XARECYCLE = 0.
- XTMOY = 0.
- XTMOYCOUNT = 0.
- XNUMBELT = 28.
+ NTMOY = 0
+ NTMOYCOUNT = 0
+ NNUMBELT = 28
XRCOEFF = 0.2
XTBVTOP = 500.
XTBVBOT = 300.
!
!-------------------------------------------------------------------------------
!
-!* 33. SET DEFAULT VALUES FOR MODD_FIRE
-! --------------------------------
+!* 33. SET DEFAULT VALUES FOR MODD_FIRE_n
+! ----------------------------------
!
! Blaze fire model namelist
!
-IF (KMI == 1) THEN
- LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
- !
- CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
- !
- CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
- CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
- XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
- !
- CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
- CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
- LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
- LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
- !
- NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
- NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
- !
- NREFINX = 1 ! Refinement ratio X
- NREFINY = 1 ! Refinement ratio Y
- !
- XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
- XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
- XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
- !
- XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
- XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
- !
- XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
- !
- LWINDFILTER = .FALSE. ! Fire wind filtering flag
- CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
- XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
- XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
- XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
- !
- NNBSMOKETRACER = 1 ! Nb of smoke tracers
- !
- NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
- !
- !
- !
- !! DO NOT CHANGE BELOW PARAMETERS
- XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
- LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
- LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
- LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
- LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
-ENDIF
+LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
+!
+CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
+!
+CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
+CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
+XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
+!
+CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
+CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
+LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
+LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
+!
+NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
+NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
+!
+NREFINX = 1 ! Refinement ratio X
+NREFINY = 1 ! Refinement ratio Y
+!
+XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
+XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
+XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
+!
+XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
+XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
+!
+XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
+!
+LWINDFILTER = .FALSE. ! Fire wind filtering flag
+CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
+XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
+XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
+XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+!
+NNBSMOKETRACER = 1 ! Nb of smoke tracers
+!
+NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+!
+!
+!
+!! DO NOT CHANGE BELOW PARAMETERS
+XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
+LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
+LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
+LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
+LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
!-------------------------------------------------------------------------------
END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/mesonh/ext/drag_veg.f90 b/src/mesonh/ext/drag_veg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de7fba893e0ef87438979ff249a803c7fd382864
--- /dev/null
+++ b/src/mesonh/ext/drag_veg.f90
@@ -0,0 +1,362 @@
+!MNH_LIC Copyright 2009-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_DRAG_VEG
+! #######################
+!
+INTERFACE
+
+SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
+ HCLOUD,PPABST,PTHT,PRT,PSVT, &
+ PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
+ PRRS,PSVS)
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
+REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
+!
+END SUBROUTINE DRAG_VEG
+
+END INTERFACE
+
+END MODULE MODI_DRAG_VEG
+!
+! ###################################################################
+SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
+ HCLOUD,PPABST,PTHT,PRT,PSVT, &
+ PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
+ PRRS,PSVS)
+! ###################################################################
+!
+!!**** *DRAG_VEG_n * -
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Aumond
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2009
+!! C.Lac 07/2011 : Add budgets
+!! S. Donier 06/2015 : bug surface aerosols
+!! C.Lac 07/2016 : Add droplet deposition
+!! C.Lac 10/2017 : Correction on deposition
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! C. Lac 02/2020: correction missing condition for budget on RC and SV
+! P. Wautelet 04/02/2021: budgets: bugfixes for LDRAGTREE if LIMA + small optimisations and verifications
+! R. Schoetter 04/2022: bug add update halo for vegetation drag variables
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_rc, lbudget_sv, lbudget_tke, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_RC, NBUDGET_SV1, NBUDGET_TKE, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_GROUND_PAR
+USE MODD_NSV
+USE MODD_PARAM_C2R2
+USE MODD_PARAM_LIMA, ONLY: NMOM_C
+USE MODD_PARAM_n, only: CSURF, CTURB
+USE MODD_PGDFIELDS
+USE MODD_VEG_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_msg
+USE MODE_ll
+
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_SHUMAN
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
+REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
+INTEGER :: JI, JJ, JK ! loop index
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
+ ZUS, ZVS, ZTKES, ZTKET
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZCDRAG, ZDENSITY
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
+ ZH,ZLAI ! LAI, Vegetation height
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
+LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
+ :: GDEP
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
+
+IF ( CSURF /= 'EXTE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CSURF/=EXTE not allowed' )
+
+!Condition necessary because PTKET is used (and must be allocated)
+IF ( CTURB /= 'TKEL' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CTURB/=TKEL not allowed' )
+!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
+IIU = SIZE(PUT,1)
+IJU = SIZE(PUT,2)
+IKU = SIZE(PUT,3)
+!
+ZUS (:,:,:) = 0.0
+ZVS (:,:,:) = 0.0
+ZTKES (:,:,:) = 0.0
+!
+ZH (:,:) = XUNDEF
+ZLAI(:,:) = XUNDEF
+!
+ZCDRAG (:,:,:) = 0.
+ZDENSITY (:,:,:) = 0.
+!
+CALL MNHGET_SURF_PARAM_n( PH_TREE = ZH, PLAI_TREE = ZLAI )
+!
+WHERE ( ZH (:,:) > (XUNDEF-1.) ) ZH (:,:) = 0.0
+WHERE ( ZLAI (:,:) > (XUNDEF-1.) ) ZLAI (:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
+! -------------------------------------
+!
+ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ZTKET(:,:,:) = PTKET(:,:,:)
+!
+! Update halo
+!
+NULLIFY(TZFIELDS_ll)
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZUT_SCAL, 'DRAG_VEG::ZUT_SCAL')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZVT_SCAL, 'DRAG_VEG::ZVT_SCAL')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTKET , 'DRAG_VEG::ZTKET' )
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Computations of wind tendency due to canopy drag
+! ------------------------------------------------
+!
+!
+!
+! Ext = - Cdrag * u- * u- * Sv tree canopy drag
+! - u'w'(ground) * Sh horizontal surfaces (ground)
+!
+!* 1.1 Drag coefficient by vegetation (Patton et al 2001)
+! ------------------------------
+!
+GDEP(:,:,:) = .FALSE.
+!
+DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for vegetation
+ !
+ IF (ZH(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH(JI,JJ) ) THEN
+ !
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
+ IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
+ GDEP(JI,JJ,JK) = .TRUE.
+ ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
+ IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
+ ENDIF
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2 !0.075
+ ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (ZH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
+ ZH(JI,JJ)**3)-&
+ (0.30*((ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
+ (ZH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
+ ZH(JI,JJ), 0.)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ENDDO
+!
+! To exclude the first vertical level already dealt in rain_ice or rain_c2r2_khko
+GDEP(:,:,2) = .FALSE.
+!
+! Update halo
+!
+NULLIFY(TZFIELDS_ll)
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZCDRAG , 'DRAG_VEG::ZCDRAG')
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZDENSITY, 'DRAG_VEG::ZDENSITY')
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!
+!* 1.2 Drag force by wall surfaces
+! ---------------------------
+!
+!* drag force by vertical surfaces
+!
+ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+!
+ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+!
+PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
+!
+PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
+!
+IF (ODEPOTREE) THEN
+ IF ( HCLOUD == 'NONE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=NONE' )
+ IF ( HCLOUD == 'LIMA' .AND. NMOM_C.EQ.0 ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=LIMA and NMOM_C=0' )
+
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
+ ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ ZWDEPR(:,:,:)= 0.
+ ZWDEPS(:,:,:)= 0.
+ WHERE (GDEP)
+ ZWDEPR(:,:,:)= PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
+ END WHERE
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
+ END WHERE
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:)
+ END WHERE
+ END IF
+ DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ DO JK=2,(IKU-2)
+ IF (GDEP(JI,JJ,JK)) THEN
+ PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
+ (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ PSVS(JI,JJ,JK,NSV_LIMA_NC) = PSVS(JI,JJ,JK,NSV_LIMA_NC) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+!
+!
+END IF
+!
+!* 3. Computations of TKE tendency due to canopy drag
+! ------------------------------------------------
+
+!* 3.1 Creation of TKE by wake
+! -----------------------
+!
+! from Kanda and Hino (1994)
+!
+! Ext = + Cd * u+^3 * Sv/Vair vertical surfaces or trees
+! Ext = - Cd * e * u * Sv trees Destruction of TKE due to
+! small-scale motions forced by leaves from Kanda and Hino (1994)
+!
+! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
+! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
+!
+ZTKES(:,:,:)= ( ZTKET(:,:,:) + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3 ) / &
+ ( 1. + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2))
+!
+PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
+END SUBROUTINE DRAG_VEG
diff --git a/src/mesonh/ext/ini_budget.f90 b/src/mesonh/ext/ini_budget.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bc66bd58749351a9fbec8e702134909d600f6089
--- /dev/null
+++ b/src/mesonh/ext/ini_budget.f90
@@ -0,0 +1,4886 @@
+!MNH_LIC Copyright 1995-2022 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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 17/08/2020: add Budget_preallocate subroutine
+!-----------------------------------------------------------------
+module mode_ini_budget
+
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: Budget_preallocate, Ini_budget
+
+ integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget
+
+contains
+
+subroutine Budget_preallocate()
+
+use modd_budget, only: nbudgets, tbudgets, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
+ NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, &
+ NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+use modd_nsv, only: nsv, tsvlist
+
+integer :: ibudget
+integer :: jsv
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' )
+
+if ( allocated( tbudgets ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' )
+ return
+end if
+
+nbudgets = NBUDGET_SV1 - 1 + nsv
+allocate( tbudgets( nbudgets ) )
+
+tbudgets(NBUDGET_U)%cname = "UU"
+tbudgets(NBUDGET_U)%ccomment = "Budget for U"
+tbudgets(NBUDGET_U)%nid = NBUDGET_U
+
+tbudgets(NBUDGET_V)%cname = "VV"
+tbudgets(NBUDGET_V)%ccomment = "Budget for V"
+tbudgets(NBUDGET_V)%nid = NBUDGET_V
+
+tbudgets(NBUDGET_W)%cname = "WW"
+tbudgets(NBUDGET_W)%ccomment = "Budget for W"
+tbudgets(NBUDGET_W)%nid = NBUDGET_W
+
+tbudgets(NBUDGET_TH)%cname = "TH"
+tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
+tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
+
+tbudgets(NBUDGET_TKE)%cname = "TK"
+tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
+tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
+
+tbudgets(NBUDGET_RV)%cname = "RV"
+tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio"
+tbudgets(NBUDGET_RV)%nid = NBUDGET_RV
+
+tbudgets(NBUDGET_RC)%cname = "RC"
+tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
+tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
+
+tbudgets(NBUDGET_RR)%cname = "RR"
+tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio"
+tbudgets(NBUDGET_RR)%nid = NBUDGET_RR
+
+tbudgets(NBUDGET_RI)%cname = "RI"
+tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
+tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
+
+tbudgets(NBUDGET_RS)%cname = "RS"
+tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio"
+tbudgets(NBUDGET_RS)%nid = NBUDGET_RS
+
+tbudgets(NBUDGET_RG)%cname = "RG"
+tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
+tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
+
+tbudgets(NBUDGET_RH)%cname = "RH"
+tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
+tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
+
+do jsv = 1, nsv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+ tbudgets(ibudget)%cname = Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%nid = ibudget
+end do
+
+
+end subroutine Budget_preallocate
+
+
+! #################################################################
+ SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, &
+ ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
+ OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
+ OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
+ OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
+! #################################################################
+!
+!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set or compute the parameters used
+! by the MESONH budgets. Names of files for budget recording are processed
+! and storage arrays are initialized.
+!
+!!** METHOD
+!! ------
+!! The essential of information is passed by modules. The choice of budgets
+!! and processes set by the user as integers is converted in "actions"
+!! readable by the subroutine BUDGET under the form of string characters.
+!! For each complete process composed of several elementary processes, names
+!! of elementary processes are concatenated in order to have an explicit name
+!! in the comment of the recording file for budget.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Modules MODD_*
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/03/95
+!! J. Stein 25/06/95 put the sources in phase with the code
+!! J. Stein 20/07/95 reset to FALSE of all the switches when
+!! CBUTYPE /= MASK or CART
+!! J. Stein 26/06/96 add the new sources + add the increment between
+!! 2 active processes
+!! J.-P. Pinty 13/12/96 Allowance of multiple SVs
+!! J.-P. Pinty 11/01/97 Includes deep convection ice and forcing processes
+!! J.-P. Lafore 10/02/98 Allocation of the RHODJs for budget
+!! V. Ducrocq 04/06/99 //
+!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments,
+!! GET_DIM_EXT_ll initializes the dimensions of the
+!! extended local domain.
+!! LBU_MASK and NBUSURF are allocated on the extended
+!! local domain.
+!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
+!! to define the dimensions of the budget arrays
+!! in the different cases CART and MASK
+!! J.-P. Pinty 23/09/00 add budget for C2R2
+!! V. Masson 18/11/02 add budget for 2way nesting
+!! O.Geoffroy 03/2006 Add KHKO scheme
+!! J.-P. Pinty 22/04/97 add the explicit hail processes
+!! C.Lac 10/08/07 Add ADV for PPM without contribution
+!! of each direction
+!! C. Barthe 19/11/09 Add atmospheric electricity
+!! C.Lac 01/07/11 Add vegetation drag
+!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
+!! terms in term 2DFRC search for modif PP . but Not very clean!
+!! C .Lac 27/05/14 add negativity corrections for chemical species
+!! C.Lac 29/01/15 Correction for NSV_USER
+!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
+!! C.Lac 04/12/15 Correction for LSUPSAT
+! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+! C. Barthe 01/2016: add budget for LIMA
+! C. Lac 10/2016: add budget for droplet deposition
+! S. Riette 11/2016: new budgets for ICE3/ICE4
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! P. Wautelet 25/03/2020: add missing ove_relax_grd
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: use NADVSV when possible
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval)
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
+! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA
+! M. Taufour 01/07/2022: budgets: add concentration for snow, graupel, hail
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc
+use modd_blowsnow, only: lblowsnow
+use modd_blowsnow_n, only: lsnowsubl
+use modd_budget
+use modd_ch_aerosol, only: lorilam
+use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel
+use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
+use modd_dragbldg_n, only: ldragbldg
+use modd_dust, only: ldust
+use modd_dyn, only: lcorio, xseglen
+use modd_dyn_n, only: xtstep, locean
+use modd_elec_descr, only: linductive, lrelax2fw_ion
+use modd_field, only: TYPEREAL
+use modd_fire_n, only: lblaze
+use modd_nsv, only: nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, &
+ nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, &
+ nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, &
+#ifdef MNH_FOREFIRE
+ nsv_ffbeg, nsv_ffend, &
+#endif
+ nsv_lgbeg, nsv_lgend, &
+ nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, &
+ nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, &
+ nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh, &
+ nsv_lima_scavmass, nsv_lima_spro, &
+ nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
+ nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
+ nsv_user, tsvlist
+use modd_parameters, only: jphext
+use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat
+use modd_param_ice, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm
+use modd_param_n, only: cactccn, celec
+use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, ldepoc_lima => ldepoc, &
+ lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
+ lptsplit, &
+ lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
+ lspro_lima => lspro, lcibu, lrdsf, &
+ nmom_c, nmom_r, nmom_i, nmom_s, nmom_g, nmom_h, nmod_ccn, nmod_ifn, nmod_imm
+use modd_ref, only: lcouples
+use modd_salt, only: lsalt
+use modd_turb_n, only: lsubg_cond
+use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
+
+USE MODE_ll
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of argument
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+REAL, INTENT(IN) :: PTSTEP ! time step
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
+ ! diffusion for momentum
+LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
+LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
+LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
+ ! horizontal relaxation for U,V,W,TH
+LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
+ ! horizontal relaxation for Rv
+LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
+ ! horizontal relaxation for Rc
+LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
+ ! horizontal relaxation for Rr
+LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
+ ! horizontal relaxation for Ri
+LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
+ ! horizontal relaxation for Rs
+LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
+ ! horizontal relaxation for Rg
+LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
+ ! horizontal relaxation for Rh
+LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
+ ! horizontal relaxation for tke
+LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
+ ! horizontal relaxation for scalar variables
+LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
+ ! relaxation
+logical, intent(in) :: ove_relax_grd ! switch to activate the vertical
+ ! relaxation to the lowest verticals
+LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
+ !transport for SV
+LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
+LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
+LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
+CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
+ ! scheme
+CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
+!
+!* 0.2 declarations of local variables
+!
+real, parameter :: ITOL = 1e-6
+
+INTEGER :: JI, JJ ! loop indices
+INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
+INTEGER :: IIU, IJU ! size along x and y directions
+ ! of the extended subdomain
+INTEGER :: IBUDIM1 ! first dimension of the budget arrays
+ ! = NBUIMAX in CART case
+ ! = NBUKMAX in MASK case
+INTEGER :: IBUDIM2 ! second dimension of the budget arrays
+ ! = NBUJMAX in CART case
+ ! = nbusubwrite in MASK case
+INTEGER :: IBUDIM3 ! third dimension of the budget arrays
+ ! = NBUKMAX in CART case
+ ! = NBUMASK in MASK case
+INTEGER :: JSV ! loop indice for the SVs
+INTEGER :: IINFO_ll ! return status of the interface routine
+integer :: ibudget
+logical :: gtmp
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
+!
+!* 1. COMPUTE BUDGET VARIABLES
+! ------------------------
+!
+NBUSTEP = NINT (XBULEN / PTSTEP)
+NBUTSHIFT=0
+!
+! common dimension for all CBUTYPE values
+!
+IF (LBU_KCP) THEN
+ NBUKMAX = 1
+ELSE
+ NBUKMAX = NBUKH - NBUKL +1
+END IF
+!
+if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
+ !Check if xbulen is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' )
+
+ if ( cbutype == 'CART' ) then
+ !Check if xseglen is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' )
+
+ !Write cartesian budgets every xbulen time period (do not take xbuwri into account)
+ xbuwri = xbulen
+
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ !Check if xbuwri is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' )
+
+ !Check if xbuwri is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' )
+
+ !Check if xseglen is a multiple of xbuwri (within tolerance)
+ if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' )
+
+ nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
+end if
+
+IF (CBUTYPE=='CART') THEN ! cartesian case only
+!
+ IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' )
+ IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' )
+ IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' )
+ IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' )
+ IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' )
+ IF (LBU_ICP) THEN
+ NBUIMAX_ll = 1
+ ELSE
+ NBUIMAX_ll = NBUIH - NBUIL +1
+ END IF
+
+ IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' )
+ IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' )
+ IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' )
+ IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' )
+ IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' )
+ IF (LBU_JCP) THEN
+ NBUJMAX_ll = 1
+ ELSE
+ NBUJMAX_ll = NBUJH - NBUJL +1
+ END IF
+
+ IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' )
+ IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' )
+ IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' )
+ IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' )
+ IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' )
+
+ CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
+ NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
+ IF ( IINFO_ll /= 1 ) THEN !
+ IF (LBU_ICP) THEN
+ NBUIMAX = 1
+ ELSE
+ NBUIMAX = NBUSIH - NBUSIL +1
+ END IF
+ IF (LBU_JCP) THEN
+ NBUJMAX = 1
+ ELSE
+ NBUJMAX = NBUSJH - NBUSJL +1
+ END IF
+ ELSE ! the intersection is void
+ CBUTYPE='SKIP' ! no budget on this processor
+ NBUIMAX = 0 ! in order to allocate void arrays
+ NBUJMAX = 0
+ ENDIF
+! three first dimensions of budget arrays in cart and skip cases
+ IBUDIM1=NBUIMAX
+ IBUDIM2=NBUJMAX
+ IBUDIM3=NBUKMAX
+! these variables are not be used
+ NBUMASK=-1
+!
+ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
+!
+ LBU_ENABLE=.TRUE.
+ ! result on the FM_FILE
+ NBUTIME = 1
+
+ CALL GET_DIM_EXT_ll ('B', IIU,IJU)
+ ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
+ LBU_MASK(:,:,:)=.FALSE.
+ ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) )
+ NBUSURF(:,:,:,:) = 0
+!
+! three first dimensions of budget arrays in mask case
+! the order of the dimensions are the order expected in WRITE_DIACHRO routine:
+! x,y,z,time,mask,processus and in this case x and y are missing
+! first dimension of the arrays : dimension along K
+! second dimension of the arrays : number of the budget time period
+! third dimension of the arrays : number of the budget masks zones
+ IBUDIM1=NBUKMAX
+ IBUDIM2=nbusubwrite
+ IBUDIM3=NBUMASK
+! these variables are not used in this case
+ NBUIMAX=-1
+ NBUJMAX=-1
+! the beginning and the end along x and y direction : global extended domain
+ ! get dimensions of the physical global domain
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ NBUIL=1
+ NBUIH=IIMAX_ll + 2 * JPHEXT
+ NBUJL=1
+ NBUJH=IJMAX_ll + 2 * JPHEXT
+!
+ELSE ! default case
+!
+ LBU_ENABLE=.FALSE.
+ NBUIMAX = -1
+ NBUJMAX = -1
+ LBU_RU = .FALSE.
+ LBU_RV = .FALSE.
+ LBU_RW = .FALSE.
+ LBU_RTH= .FALSE.
+ LBU_RTKE= .FALSE.
+ LBU_RRV= .FALSE.
+ LBU_RRC= .FALSE.
+ LBU_RRR= .FALSE.
+ LBU_RRI= .FALSE.
+ LBU_RRS= .FALSE.
+ LBU_RRG= .FALSE.
+ LBU_RRH= .FALSE.
+ LBU_RSV= .FALSE.
+!
+! three first dimensions of budget arrays in default case
+ IBUDIM1=0
+ IBUDIM2=0
+ IBUDIM3=0
+!
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
+! ------------------------------------------------
+!
+LBU_BEG =.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITALIZE VARIABLES
+! -------------------
+!
+!Create intermediate variable to store rhodj for scalar variables
+if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. &
+ lbu_rri .or. lbu_rrs .or. lbu_rrg .or. lbu_rrh .or. lbu_rsv ) then
+ allocate( tburhodj )
+
+ tburhodj%cmnhname = 'RhodJS'
+ tburhodj%cstdname = ''
+ tburhodj%clongname = 'RhodJS'
+ tburhodj%cunits = 'kg'
+ tburhodj%ccomment = 'RhodJ for Scalars variables'
+ tburhodj%ngrid = 1
+ tburhodj%ntype = TYPEREAL
+ tburhodj%ndims = 3
+
+ allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tburhodj%xdata(:, :, :) = 0.
+end if
+
+
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
+
+! Budget of RU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
+
+if ( lbu_ru ) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_U) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru )
+end if
+
+! Budget of RV
+tbudgets(NBUDGET_V)%lenabled = lbu_rv
+
+if ( lbu_rv ) then
+ allocate( tbudgets(NBUDGET_V)%trhodj )
+
+ tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_V)%trhodj%ngrid = 3
+ tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_V)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Y axis'
+ tzsource%ngrid = 3
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_V) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv )
+end if
+
+! Budget of RW
+tbudgets(NBUDGET_W)%lenabled = lbu_rw
+
+if ( lbu_rw ) then
+ allocate( tbudgets(NBUDGET_W)%trhodj )
+
+ tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis'
+ tbudgets(NBUDGET_W)%trhodj%ngrid = 4
+ tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_W)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Z axis'
+ tzsource%ngrid = 4
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'GRAV'
+ tzsource%clongname = 'gravity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw )
+end if
+
+! Budget of RTH
+tbudgets(NBUDGET_TH)%lenabled = lbu_rth
+
+if ( lbu_rth ) then
+ tbudgets(NBUDGET_TH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of potential temperature'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'K'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'K s-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'PREF'
+ tzsource%clongname = 'reference pressure'
+ tzsource%lavailable = krr > 0 .and. .not.l1d
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RAD'
+ tzsource%clongname = 'radiation'
+ tzsource%lavailable = hrad /= 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DISSH'
+ tzsource%clongname = 'dissipation'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_th
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'heat transport by hydrometeors sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_r.ge.1 ) .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. (hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'raindrop homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit &
+ .or. ( nmom_s.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth )
+end if
+
+! Budget of RTKE
+tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke
+
+if ( lbu_rtke ) then
+ tbudgets(NBUDGET_TKE)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of turbulent kinetic energy'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'm2 s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm2 s-3'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_tke
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DP'
+ tzsource%clongname = 'dynamic production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TP'
+ tzsource%clongname = 'thermal production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DISS'
+ tzsource%clongname = 'dissipation of TKE'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TR'
+ tzsource%clongname = 'turbulent transport'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke )
+end if
+
+! Budget of RRV
+tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1
+
+if ( tbudgets(NBUDGET_RV)%lenabled ) then
+ tbudgets(NBUDGET_RV)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of water vapor mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rv
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1 )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on HAIL'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv )
+end if
+
+! Budget of RRC
+tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2
+
+if ( tbudgets(NBUDGET_RC)%lenabled ) then
+ if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// &
+ 'DEPO and SEDI source terms are mixed and stored in SEDI' )
+
+ tbudgets(NBUDGET_RC)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rc
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of cloud'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lsedc_lima ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. ldepoc_lima ) &
+ .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc )
+end if
+
+! Budget of RRR
+tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3
+
+if ( tbudgets(NBUDGET_RR)%lenabled ) then
+ tbudgets(NBUDGET_RR)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of rain water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rr
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. hcloud == 'KESS' &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. hcloud == 'C2R2' &
+ .or. hcloud == 'KHKO'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection of droplets by snow and conversion into rain'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+!PW: a documenter
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr )
+end if
+
+! Budget of RRI
+tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4
+
+if ( tbudgets(NBUDGET_RI)%lenabled ) then
+ tbudgets(NBUDGET_RI)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud ice mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_ri
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lsedi_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri )
+end if
+
+! Budget of RRS
+tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5
+
+if ( tbudgets(NBUDGET_RS)%lenabled ) then
+ tbudgets(NBUDGET_RS)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of snow/aggregate mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rs
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs )
+end if
+
+! Budget of RRG
+tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6
+
+if ( tbudgets(NBUDGET_RG)%lenabled ) then
+ tbudgets(NBUDGET_RG)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rg
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion of hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. (lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg )
+end if
+
+! Budget of RRH
+tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7
+
+if ( tbudgets(NBUDGET_RH)%lenabled ) then
+ tbudgets(NBUDGET_RH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of hail mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rh
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 &
+ .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion from hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh )
+end if
+
+! Budgets of RSV (scalar variables)
+
+if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' )
+
+SV_BUDGETS: do jsv = 1, ksv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+
+ tbudgets(ibudget)%lenabled = lbu_rsv
+
+ if ( lbu_rsv ) then
+ tbudgets(ibudget)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(ibudget)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(ibudget)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of scalar variable ' // tsvlist(jsv)%cmnhname
+ tzsource%ngrid = 1
+
+ tzsource%cunits = '1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifsv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion &
+ .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_sv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA2'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Add specific source terms to different scalar variables
+ SV_VAR: if ( jsv <= nsv_user ) then
+ ! nsv_user case
+ ! Nothing to do
+
+ else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR
+ ! C2R2 or KHKO Case
+
+ ! Source terms in common for all C2R2/KHKO budgets
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Source terms specific to each budget
+ SV_C2R2: select case( jsv - nsv_c2r2beg + 1 )
+ case ( 1 ) SV_C2R2
+ ! Concentration of activated nuclei
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_C2R2
+ ! Concentration of cloud droplets
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource)
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ldepoc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_C2R2
+ ! Concentration of raindrops
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = hcloud /= 'KHKO'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 4 ) SV_C2R2
+ ! Supersaturation
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end select SV_C2R2
+
+
+ else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
+ ! LIMA case
+
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+ end if
+
+
+ ! Source terms specific to each budget
+ SV_LIMA: if ( jsv == nsv_lima_nc ) then
+ ! Cloud droplets concentration
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lsedc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = nmom_c.ge.1 .and. ldepoc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_nr ) then SV_LIMA
+ ! Rain drops concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_r.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
+ ! Free CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
+ ! Activated CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_scavmass ) then SV_LIMA
+ ! Scavenged mass variable
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_ni ) then SV_LIMA
+ ! Pristine ice crystals concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lsedi_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ns ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lptsplit .or. ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'break up of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SSC'
+ tzsource%clongname = 'snow self collection'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ng ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of raindrop'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_nh .and. nmom_h.ge.1) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 .and. nmom_h.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'hail melting'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
+ ! Free IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA
+ ! Nucleated IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima &
+ .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA
+ ! Nucleated IMM concentration
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA
+ ! Homogeneous freezing of CCN
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. &
+ ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. nmom_c.ge.1 ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_spro ) then SV_LIMA
+ ! Supersaturation
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end if SV_LIMA
+
+
+ else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
+ ! Electricity case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ SV_ELEC: select case( jsv - nsv_elecbeg + 1 )
+ case ( 1 ) SV_ELEC
+ ! volumetric charge of water vapor
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_ELEC
+ ! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedic_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_ELEC
+ ! volumetric charge of rain drops
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ case ( 4 ) SV_ELEC
+ ! volumetric charge of ice crystals
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 5 ) SV_ELEC
+ ! volumetric charge of snow
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 6 ) SV_ELEC
+ ! volumetric charge of graupel
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 7: ) SV_ELEC
+ if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ ! volumetric charge of hail
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) &
+ .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
+ ! Negative ions (NSV_ELECEND case)
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
+ end if
+
+ end select SV_ELEC
+
+
+ else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR
+ !Lagrangian variables
+
+
+ else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR
+ !Passive pollutants
+
+
+#ifdef MNH_FOREFIRE
+ else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR
+ !Forefire
+
+#endif
+ else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR
+ !Conditional sampling
+
+
+ else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR
+ !Chemical case
+ tzsource%cmnhname = 'CHEM'
+ tzsource%clongname = 'chemistry activity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR
+ !Ice phase chemistry
+
+
+ else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
+ !Chemical aerosol case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = lorilam
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR
+ !Aerosol wet deposition
+
+ else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR
+ !Dust
+
+ else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR
+ !Dust wet deposition
+
+ else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR
+ !Salt
+
+ else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR
+ !Salt wet deposition
+
+ else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR
+ !Snow
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SNSED'
+ tzsource%clongname = 'blowing snow sedimentation'
+ tzsource%lavailable = lblowsnow
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR
+ !LiNOX passive tracer
+
+ else SV_VAR
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' )
+ end if SV_VAR
+
+
+ call Sourcelist_sort_compact( tbudgets(ibudget) )
+
+ call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv )
+ end if
+end do SV_BUDGETS
+
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
+if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru )
+if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv )
+if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw )
+if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth )
+if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke )
+if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv )
+if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc )
+if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr )
+if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri )
+if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs )
+if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg )
+if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh )
+if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv )
+end subroutine Ini_budget
+
+
+subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite )
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ type(tbusourcedata), intent(in) :: tpsource ! Metadata basis
+ logical, optional, intent(in) :: odonotinit
+ logical, optional, intent(in) :: ooverwrite
+
+ character(len=4) :: ynum
+ integer :: isourcenumber
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) &
+ // ': ' // Trim( tpsource%cmnhname ) )
+
+ isourcenumber = tpbudget%nsources + 1
+ if ( isourcenumber > tpbudget%nsourcesmax ) then
+ Write( ynum, '( i4 )' ) tpbudget%nsourcesmax
+ cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname )
+ cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX'
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' )
+ else
+ tpbudget%nsources = tpbudget%nsources + 1
+ end if
+
+ ! Copy metadata from provided tpsource
+ ! Modifications to source term metadata done with the other dummy arguments
+ tpbudget%tsources(isourcenumber) = tpsource
+
+ if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit
+
+ if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite
+end subroutine Budget_source_add
+
+
+subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 )
+ use modd_budget, only: tbudgetdata
+ use modd_field, only: TYPEINT, TYPEREAL
+ use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX, NCOMMENTLGTMAX
+
+ use mode_tools, only: Quicksort
+
+ type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets
+ integer, intent(in) :: kbudim1
+ integer, intent(in) :: kbudim2
+ integer, intent(in) :: kbudim3
+
+ character(len=NMNHNAMELGTMAX) :: ymnhname
+ character(len=NSTDNAMELGTMAX) :: ystdname
+ character(len=NLONGNAMELGTMAX) :: ylongname
+ character(len=NUNITLGTMAX) :: yunits
+ character(len=NCOMMENTLGTMAX) :: ycomment
+ integer :: ji, jj, jk
+ integer :: isources ! Number of source terms in a budget
+ integer :: inbgroups ! Number of budget groups
+ integer :: ival
+ integer :: icount
+ integer :: ivalmax, ivalmin
+ integer :: igrid
+ integer :: itype
+ integer :: idims
+ integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers
+ integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers
+ real :: zval
+ real :: zvalmax, zvalmin
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' )
+
+ BUDGETS: do ji = 1, size( tpbudgets )
+ ENABLED: if ( tpbudgets(ji)%lenabled ) then
+ isources = size( tpbudgets(ji)%tsources )
+ do jj = 1, isources
+ ! Check if ngroup is an allowed value
+ if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' )
+ tpbudgets(ji)%tsources(jj)%ngroup = 0
+ end if
+
+ if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true.
+ end do
+
+ !Count the number of groups of source terms
+ !ngroup=1 is for individual entries, >1 values are groups
+ allocate( igroups(isources ) )
+ allocate( ipos (isources ) )
+ igroups(:) = tpbudgets(ji)%tsources(:)%ngroup
+ ipos(:) = [ ( jj, jj = 1, isources ) ]
+
+ !Sort the group list number
+ call Quicksort( igroups, 1, isources, ipos )
+
+ !Count the number of different groups
+ !and renumber the entries (from 1 to inbgroups)
+ inbgroups = 0
+ ival = igroups(1)
+ if ( igroups(1) /= 0 ) then
+ inbgroups = 1
+ igroups(1) = inbgroups
+ end if
+ do jj = 2, isources
+ if ( igroups(jj) == 1 ) then
+ inbgroups = inbgroups + 1
+ igroups(jj) = inbgroups
+ else if ( igroups(jj) > 0 ) then
+ if ( igroups(jj) /= ival ) then
+ ival = igroups(jj)
+ inbgroups = inbgroups + 1
+ end if
+ igroups(jj) = inbgroups
+ end if
+ end do
+
+ !Write the igroups values to the budget structure
+ do jj = 1, isources
+ tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj)
+ end do
+
+ !Allocate the group structure + populate it
+ tpbudgets(ji)%ngroups = inbgroups
+ allocate( tpbudgets(ji)%tgroups(inbgroups) )
+
+ do jj = 1, inbgroups
+ !Search the list of sources for each group
+ !not the most efficient algorithm but do the job
+ icount = 0
+ do jk = 1, isources
+ if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then
+ icount = icount + 1
+ ipos(icount) = jk !ipos is reused as a temporary work array
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nsources = icount
+
+ allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) )
+ tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount)
+
+ ! Set the name of the field
+ ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname )
+ end do
+ tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname
+
+ ! Set the standard name (CF convention)
+ if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then
+ ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname
+ else
+ ! The CF standard name is probably wrong if combining several source terms => set to ''
+ ystdname = ''
+ end if
+ tpbudgets(ji)%tgroups(jj)%cstdname = ystdname
+
+ ! Set the long name (CF convention)
+ ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname
+ end do
+ tpbudgets(ji)%tgroups(jj)%clongname = ylongname
+
+ ! Set the units
+ yunits = tpbudgets(ji)%tsources(ipos(1))%cunits
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'incompatible units for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ yunits = 'unknown'
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%cunits = yunits
+
+ ! Set the comment
+ ! It is composed of the source comment followed by the clongnames of the different sources
+ ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname )
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname )
+ end do
+ ycomment = trim( ycomment ) // ' source term'
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's'
+ tpbudgets(ji)%tgroups(jj)%ccomment = ycomment
+
+ ! Set the Arakawa grid
+ igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different Arakawa grid positions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ngrid = igrid
+
+ ! Set the data type
+ itype = tpbudgets(ji)%tsources(ipos(1))%ntype
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible data types for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ntype = itype
+
+ ! Set the number of dimensions
+ idims = tpbudgets(ji)%tsources(ipos(1))%ndims
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible number of dimensions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ndims = idims
+
+ ! Set the fill values
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (integer) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nfillvalue = ival
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (real) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%xfillvalue = zval
+ end if
+
+ ! Set the valid min/max values
+ ! Take the min or max of all the sources
+ ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type)
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin
+ ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin )
+ ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin
+ tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin
+ zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin )
+ zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin
+ tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax
+ end if
+
+ allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) )
+ tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0.
+ end do
+
+ deallocate( igroups )
+ deallocate( ipos )
+
+ !Check that a group does not contain more than 1 source term with ldonotinit=.true.
+ do jj = 1, inbgroups
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then
+ do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with ldonotinit=true' )
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with loverwrite=true' )
+ end do
+ end if
+ end do
+
+ end if ENABLED
+ end do BUDGETS
+
+end subroutine Ini_budget_groups
+
+
+subroutine Sourcelist_sort_compact( tpbudget )
+ !Sort the list of sources to put the non-available source terms at the end of the list
+ !and compact the list
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+
+ integer :: ji
+ integer :: isrc_avail, isrc_notavail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_avail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail
+
+ isrc_avail = 0
+ isrc_notavail = 0
+
+ Allocate( tzsources_avail (tpbudget%nsources) )
+ Allocate( tzsources_notavail(tpbudget%nsources) )
+
+ !Separate source terms available or not during the execution
+ !(based on the criteria provided to Budget_source_add and stored in lavailable field)
+ do ji = 1, tpbudget%nsources
+ if ( tpbudget%tsources(ji)%lavailable ) then
+ isrc_avail = isrc_avail + 1
+ tzsources_avail(isrc_avail) = tpbudget%tsources(ji)
+ else
+ isrc_notavail = isrc_notavail + 1
+ tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji)
+ end if
+ end do
+
+ !Reallocate/compact the source list
+ if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources )
+ Allocate( tpbudget%tsources( tpbudget%nsources ) )
+
+ tpbudget%nsourcesmax = tpbudget%nsources
+ !Limit the number of sources to the available list
+ tpbudget%nsources = isrc_avail
+
+ !Fill the source list beginning with the available sources and finishing with the non-available ones
+ do ji = 1, isrc_avail
+ tpbudget%tsources(ji) = tzsources_avail(ji)
+ end do
+
+ do ji = 1, isrc_notavail
+ tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji)
+ end do
+
+end subroutine Sourcelist_sort_compact
+
+
+subroutine Sourcelist_scan( tpbudget, hbulist )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ character(len=*), dimension(:), intent(in) :: hbulist
+
+ character(len=:), allocatable :: yline
+ character(len=:), allocatable :: ysrc
+ character(len=:), dimension(:), allocatable :: ymsg
+ integer :: idx
+ integer :: igroup
+ integer :: igroup_idx
+ integer :: ipos
+ integer :: istart
+ integer :: ji
+
+ istart = 1
+
+ ! Case 'LIST_AVAIL': list all the available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsources
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'LIST_ALL': list all the source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsourcesmax
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'ALL': enable all available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'ALL' ) then
+ do ji = 1, tpbudget%nsources
+ tpbudget%tsources(ji)%ngroup = 1
+ end do
+ return
+ end if
+ end if
+
+ !Always enable INIF, ENDF and AVEF terms
+ ipos = Source_find( tpbudget, 'INIF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': INIF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'ENDF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ENDF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'AVEF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': AVEF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ !igroup_idx start at 2 because 1 is reserved for individually stored source terms
+ igroup_idx = 2
+
+ do ji = istart, Size( hbulist )
+ if ( Len_trim( hbulist(ji) ) > 0 ) then
+ ! Scan the line and separate the different sources (separated by + signs)
+ yline = Trim(hbulist(ji))
+
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ igroup = 1
+ else
+ igroup = igroup_idx
+ igroup_idx = igroup_idx + 1
+ end if
+
+ do
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ ysrc = yline
+ else
+ ysrc = yline(1 : idx - 1)
+ yline = yline(idx + 1 :)
+ end if
+
+ !Check if the source is known
+ if ( Len_trim( ysrc ) > 0 ) then
+ ipos = Source_find( tpbudget, ysrc )
+
+ if ( ipos > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' found' )
+
+ if ( .not. tpbudget%tsources(ipos)%lavailable ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not available' )
+ tpbudget%tsources(ipos)%ngroup = 0
+ else
+ tpbudget%tsources(ipos)%ngroup = igroup
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not found' )
+ end if
+ end if
+
+ if ( idx < 1 ) exit
+ end do
+ end if
+ end do
+end subroutine Sourcelist_scan
+
+
+subroutine Sourcelist_nml_compact( tpbudget, hbulist )
+ !This subroutine reduce the size of the hbulist to the minimum
+ !The list is generated from the group list
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
+
+ integer :: idx
+ integer :: isource
+ integer :: jg
+ integer :: js
+
+ if ( Allocated( hbulist ) ) Deallocate( hbulist )
+
+ if ( tpbudget%ngroups < 3 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' )
+ return
+ end if
+
+ Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) )
+ hbulist(:) = ''
+
+ idx = 0
+ do jg = 1, tpbudget%ngroups
+ if ( tpbudget%tgroups(jg)%nsources < 1 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' )
+ cycle
+ end if
+
+ !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled
+ isource = tpbudget%tgroups(jg)%nsourcelist(1)
+ if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle
+
+ idx = idx + 1
+#if 0
+ !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN)
+ !and the name separator is different ('_')
+ hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname )
+#else
+ do js = 1, tpbudget%tgroups(jg)%nsources
+ isource = tpbudget%tgroups(jg)%nsourcelist(js)
+ hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname )
+ if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+'
+ end do
+#endif
+ end do
+end subroutine Sourcelist_nml_compact
+
+
+subroutine Sourcelist_sv_nml_compact( hbulist )
+ !This subroutine reduce the size of the hbulist
+ !For SV variables the reduction is simpler than for other variables
+ !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable)
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ character(len=*), dimension(:), allocatable, intent(inout) :: hbulist
+
+ character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new
+ integer :: ilines
+ integer :: ji
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1
+ end do
+
+ Allocate( ybulist_new(ilines) )
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) then
+ ilines = ilines + 1
+ ybulist_new(ilines) = Trim( hbulist(ji) )
+ end if
+ end do
+
+ call Move_alloc( from = ybulist_new, to = hbulist )
+end subroutine Sourcelist_sv_nml_compact
+
+
+pure function Source_find( tpbudget, hsource ) result( ipos )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=*), intent(in) :: hsource
+ integer :: ipos
+
+ integer :: ji
+ logical :: gfound
+
+ ipos = -1
+ gfound = .false.
+ do ji = 1, tpbudget%nsourcesmax
+ if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then
+ gfound = .true.
+ ipos = ji
+ exit
+ end if
+ end do
+
+end function Source_find
+
+end module mode_ini_budget
diff --git a/src/mesonh/ext/ini_nsv.f90 b/src/mesonh/ext/ini_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d1e5c5aaa2ccfd80acb3f95457177b15614e7890
--- /dev/null
+++ b/src/mesonh/ext/ini_nsv.f90
@@ -0,0 +1,1317 @@
+!MNH_LIC Copyright 2001-2023 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_INI_NSV
+! ###################
+INTERFACE
+!
+ SUBROUTINE INI_NSV(KMI)
+ INTEGER, INTENT(IN) :: KMI ! model index
+ END SUBROUTINE INI_NSV
+!
+END INTERFACE
+!
+END MODULE MODI_INI_NSV
+!
+!
+! ###########################
+ SUBROUTINE INI_NSV(KMI)
+! ###########################
+!
+!!**** *INI_NSV* - compute NSV_* values and indices for model KMI
+!!
+!! PURPOSE
+!! -------
+!
+!
+!
+!!** METHOD
+!! ------
+!!
+!! This routine is called from any routine which stores values in
+!! the first model module (for example READ_EXSEG).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_NSV : contains NSV_A array variable
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! Modification 29/11/02 (Pinty) add SV for C3R5 and ELEC
+!! Modification 01/2004 (Masson) add scalar names
+!! Modification 03/2006 (O.Geoffroy) add KHKO scheme
+!! Modification 04/2007 (Leriche) add SV for aqueous chemistry
+!! M. Chong 26/01/10 Add Small ions
+!! Modification 07/2010 (Leriche) add SV for ice chemistry
+!! X.Pialat & J.Escobar 11/2012 remove deprecated line NSV_A(KMI) = ISV
+!! Modification 15/02/12 (Pialat/Tulet) Add SV for ForeFire scalars
+!! 03/2013 (C.Lac) add supersaturation as
+!! the 4th C2R2 scalar variable
+!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
+!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition
+!! Modification 07/2017 (V. Vionnet) Add blowing snow condition
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: initialize TSVLIST_A
+! A. Costes 12/2021: smoke tracer for fire model
+! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
+! + NSV_CHEM_LIST(_A) the size of the list
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI
+USE MODD_CH_AEROSOL
+! USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, &
+! LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP
+USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ
+USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
+USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP
+USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB
+USE MODD_CST, ONLY: XMNH_TINY
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG
+USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, &
+ LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI
+USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVFIRE, LHORELAX_SVLIMA, &
+ LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
+ LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
+ LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
+ LHORELAX_SVSNW
+#ifdef MNH_FOREFIRE
+USE MODD_DYN_n, ONLY: LHORELAX_SVFF
+#endif
+USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
+USE MODD_FIRE_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX
+USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, LSCAV, LAERO_MASS, &
+ NMOD_IFN, NMOD_IMM, LHHONI, &
+ LSPRO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
+USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
+USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
+USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE
+USE MODD_PREP_REAL, ONLY: XT_LS
+USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, &
+ LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI
+
+USE MODE_MSG
+
+USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
+USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.1 Declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! model index
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=2) :: YNUM2
+CHARACTER(LEN=3) :: YNUM3
+CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+CHARACTER(LEN=NUNITLGTMAX) :: YUNITS
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YAEROLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YDUSTLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YSALTLONGNAMES
+INTEGER :: ILUOUT
+INTEGER :: ICHIDX ! Index for position in CSV_CHEM_LIST_A array
+INTEGER :: ISV ! total number of scalar variables
+INTEGER :: IMODEIDX
+INTEGER :: JAER
+INTEGER :: JI, JJ, JSV
+INTEGER :: JMODE, JMOM, JSV_NAME
+INTEGER :: INMOMENTS_DST, INMOMENTS_SLT !Number of moments for dust or salt
+!
+!-------------------------------------------------------------------------------
+!
+LINI_NSV(KMI) = .TRUE.
+
+ILUOUT = TLUOUT%NLU
+
+ICHIDX = 0
+NSV_CHEM_LIST_A(KMI) = 0
+!
+! Users scalar variables are first considered
+!
+NSV_USER_A(KMI) = NSV_USER
+ISV = NSV_USER
+!
+! scalar variables used in microphysical schemes C2R2,KHKO and C3R5
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) THEN
+ IF ((CCLOUD == 'C2R2' .AND. LSUPSAT) .OR. (CCLOUD == 'KHKO'.AND. LSUPSAT)) THEN
+ ! 4th scalar field = supersaturation
+ NSV_C2R2_A(KMI) = 4
+ ELSE
+ NSV_C2R2_A(KMI) = 3
+ END IF
+ NSV_C2R2BEG_A(KMI) = ISV+1
+ NSV_C2R2END_A(KMI) = ISV+NSV_C2R2_A(KMI)
+ ISV = NSV_C2R2END_A(KMI)
+ IF (CCLOUD == 'C3R5') THEN ! the SVs for C2R2 and C1R3 must be contiguous
+ NSV_C1R3_A(KMI) = 2
+ NSV_C1R3BEG_A(KMI) = ISV+1
+ NSV_C1R3END_A(KMI) = ISV+NSV_C1R3_A(KMI)
+ ISV = NSV_C1R3END_A(KMI)
+ ELSE
+ NSV_C1R3_A(KMI) = 0
+ ! force First index to be superior to last index
+ ! in order to create a null section
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+ END IF
+ELSE
+ NSV_C2R2_A(KMI) = 0
+ NSV_C1R3_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_C2R2BEG_A(KMI) = 1
+ NSV_C2R2END_A(KMI) = 0
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+END IF
+!
+! scalar variables used in the LIMA microphysical scheme
+!
+IF (CCLOUD == 'LIMA' ) THEN
+ ISV = ISV+1
+ NSV_LIMA_BEG_A(KMI) = ISV
+ IF (NMOM_C.GE.2) THEN
+! Nc
+ NSV_LIMA_NC_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Nr
+ IF (NMOM_R.GE.2) THEN
+ NSV_LIMA_NR_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! CCN
+ IF (NMOD_CCN .GT. 0) THEN
+ NSV_LIMA_CCN_FREE_A(KMI) = ISV
+ ISV = ISV + NMOD_CCN
+ NSV_LIMA_CCN_ACTI_A(KMI) = ISV
+ ISV = ISV + NMOD_CCN
+ END IF
+! Scavenging
+ IF (LSCAV .AND. LAERO_MASS) THEN
+ NSV_LIMA_SCAVMASS_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ni
+ IF (NMOM_I.GE.2) THEN
+ NSV_LIMA_NI_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ns
+ IF (NMOM_S.GE.2) THEN
+ NSV_LIMA_NS_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Ng
+ IF (NMOM_G.GE.2) THEN
+ NSV_LIMA_NG_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! Nh
+ IF (NMOM_H.GE.2) THEN
+ NSV_LIMA_NH_A(KMI) = ISV
+ ISV = ISV+1
+ END IF
+! IFN
+ IF (NMOD_IFN .GT. 0) THEN
+ NSV_LIMA_IFN_FREE_A(KMI) = ISV
+ ISV = ISV + NMOD_IFN
+ NSV_LIMA_IFN_NUCL_A(KMI) = ISV
+ ISV = ISV + NMOD_IFN
+ END IF
+! IMM
+ IF (NMOD_IMM .GT. 0) THEN
+ NSV_LIMA_IMM_NUCL_A(KMI) = ISV
+ ISV = ISV + MAX(1,NMOD_IMM)
+ END IF
+
+ IF ( NMOD_IFN > 0 ) THEN
+ IF ( .NOT. ALLOCATED( NIMM ) ) ALLOCATE( NIMM(NMOD_CCN) )
+ NIMM(:) = 0
+ IF ( ALLOCATED( NINDICE_CCN_IMM ) ) DEALLOCATE( NINDICE_CCN_IMM )
+ ALLOCATE( NINDICE_CCN_IMM(MAX( 1, NMOD_IMM )) )
+ IF (NMOD_IMM > 0 ) THEN
+ DO JI = 0, NMOD_IMM - 1
+ NIMM(NMOD_CCN - JI) = 1
+ NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+ END IF
+
+! Homogeneous freezing of CCN
+ IF (LHHONI) THEN
+ NSV_LIMA_HOM_HAZE_A(KMI) = ISV
+ ISV = ISV + 1
+ END IF
+! Supersaturation
+ IF (LSPRO) THEN
+ NSV_LIMA_SPRO_A(KMI) = ISV
+ ISV = ISV + 1
+ END IF
+!
+! End and total variables
+!
+ ISV = ISV - 1
+ NSV_LIMA_END_A(KMI) = ISV
+ NSV_LIMA_A(KMI) = NSV_LIMA_END_A(KMI) - NSV_LIMA_BEG_A(KMI) + 1
+ELSE
+ NSV_LIMA_A(KMI) = 0
+!
+! force First index to be superior to last index
+! in order to create a null section
+!
+ NSV_LIMA_BEG_A(KMI) = 1
+ NSV_LIMA_END_A(KMI) = 0
+END IF ! CCLOUD = LIMA
+!
+!
+! Add one scalar for negative ion
+! First variable: positive ion (NSV_ELECBEG_A index number)
+! Last --------: negative ion (NSV_ELECEND_A index number)
+! Correspondence for ICE3:
+! Relative index 1 2 3 4 5 6 7
+! Charge for ion+ cloud rain ice snow graupel ion-
+!
+! Correspondence for ICE4:
+! Relative index 1 2 3 4 5 6 7 8
+! Charge for ion+ cloud rain ice snow graupel hail ion-
+!
+IF (CELEC /= 'NONE') THEN
+ IF (CCLOUD == 'ICE3') THEN
+ NSV_ELEC_A(KMI) = 7
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ CELECNAMES(7) = CELECNAMES(8)
+ ELSE IF (CCLOUD == 'ICE4') THEN
+ NSV_ELEC_A(KMI) = 8
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ END IF
+ELSE
+ NSV_ELEC_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_ELECBEG_A(KMI) = 1
+ NSV_ELECEND_A(KMI) = 0
+END IF
+!
+! scalar variables used as lagragian variables
+!
+IF (LLG) THEN
+ NSV_LG_A(KMI) = 3
+ NSV_LGBEG_A(KMI) = ISV+1
+ NSV_LGEND_A(KMI) = ISV+NSV_LG_A(KMI)
+ ISV = NSV_LGEND_A(KMI)
+ELSE
+ NSV_LG_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LGBEG_A(KMI) = 1
+ NSV_LGEND_A(KMI) = 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (LPASPOL) THEN
+ NSV_PP_A(KMI) = NRELEASE
+ NSV_PPBEG_A(KMI)= ISV+1
+ NSV_PPEND_A(KMI)= ISV+NSV_PP_A(KMI)
+ ISV = NSV_PPEND_A(KMI)
+ELSE
+ NSV_PP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_PPBEG_A(KMI)= 1
+ NSV_PPEND_A(KMI)= 0
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire tracers
+IF (LFOREFIRE .AND. NFFSCALARS .GT. 0) THEN
+ NSV_FF_A(KMI) = NFFSCALARS
+ NSV_FFBEG_A(KMI) = ISV+1
+ NSV_FFEND_A(KMI) = ISV+NSV_FF_A(KMI)
+ ISV = NSV_FFEND_A(KMI)
+ELSE
+ NSV_FF_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FFBEG_A(KMI)= 1
+ NSV_FFEND_A(KMI)= 0
+END IF
+#endif
+! Blaze tracers
+IF (LBLAZE .AND. NNBSMOKETRACER .GT. 0) THEN
+ NSV_FIRE_A(KMI) = NNBSMOKETRACER
+ NSV_FIREBEG_A(KMI) = ISV+1
+ NSV_FIREEND_A(KMI) = ISV+NSV_FIRE_A(KMI)
+ ISV = NSV_FIREEND_A(KMI)
+ELSE
+ NSV_FIRE_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FIREBEG_A(KMI)= 1
+ NSV_FIREEND_A(KMI)= 0
+END IF
+!
+! Conditional sampling variables
+IF (LCONDSAMP) THEN
+ NSV_CS_A(KMI) = NCONDSAMP
+ NSV_CSBEG_A(KMI)= ISV+1
+ NSV_CSEND_A(KMI)= ISV+NSV_CS_A(KMI)
+ ISV = NSV_CSEND_A(KMI)
+ELSE
+ NSV_CS_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CSBEG_A(KMI)= 1
+ NSV_CSEND_A(KMI)= 0
+END IF
+!
+! scalar variables used in chemical core system
+!
+IF (LUSECHEM) THEN
+ CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
+ IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
+END IF
+
+IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN
+ NSV_CHEM_A(KMI) = NEQ
+ NSV_CHEMBEG_A(KMI)= ISV+1
+ NSV_CHEMEND_A(KMI)= ISV+NSV_CHEM_A(KMI)
+ ISV = NSV_CHEMEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHEM_A(KMI)
+ELSE
+ NSV_CHEM_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CHEMBEG_A(KMI)= 1
+ NSV_CHEMEND_A(KMI)= 0
+END IF
+!
+! aqueous chemistry (part of the "chem" variables)
+!
+IF ((LUSECHAQ .OR. LCHAQDIAG).AND.(NEQ .GT. 0)) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = NEQAQ
+ NSV_CHACBEG_A(KMI)= NSV_CHGSEND_A(KMI)+1
+ NSV_CHACEND_A(KMI)= NSV_CHEMEND_A(KMI)
+! ice phase chemistry
+ IF (LUSECHIC) THEN
+ NSV_CHIC_A(KMI) = NEQAQ/2. -1.
+ NSV_CHICBEG_A(KMI)= ISV+1
+ NSV_CHICEND_A(KMI)= ISV+NSV_CHIC_A(KMI)
+ ISV = NSV_CHICEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHIC_A(KMI)
+ ELSE
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+ELSE
+ IF (NEQ .GT. 0) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ELSE
+ NSV_CHGS_A(KMI) = 0
+ NSV_CHGSBEG_A(KMI)= 1
+ NSV_CHGSEND_A(KMI)= 0
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+END IF
+! aerosol variables
+IF (LORILAM.AND.(NEQ .GT. 0)) THEN
+ NM6_AER = 0
+ IF (LVARSIGI) NM6_AER = 1
+ IF (LVARSIGJ) NM6_AER = NM6_AER + 1
+ NSV_AER_A(KMI) = (NSP+NCARB+NSOA+1)*JPMODE + NM6_AER
+ NSV_AERBEG_A(KMI)= ISV+1
+ NSV_AEREND_A(KMI)= ISV+NSV_AER_A(KMI)
+ ISV = NSV_AEREND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AER_A(KMI)
+
+ ALLOCATE( YAEROLONGNAMES(NSV_AER_A(KMI)) )
+ELSE
+ NSV_AER_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERBEG_A(KMI)= 1
+ NSV_AEREND_A(KMI)= 0
+END IF
+IF (LORILAM .AND. LDEPOS_AER(KMI)) THEN
+ NSV_AERDEP_A(KMI) = JPMODE*2
+ NSV_AERDEPBEG_A(KMI)= ISV+1
+ NSV_AERDEPEND_A(KMI)= ISV+NSV_AERDEP_A(KMI)
+ ISV = NSV_AERDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AERDEP_A(KMI)
+ELSE
+ NSV_AERDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERDEPBEG_A(KMI)= 1
+ NSV_AERDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in dust model
+!
+IF (LDUST) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LDSTPRES)) LDSTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND.LDSTINIT) LVARSIG = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_DST ) THEN
+ INMOMENTS_DST = 1
+ IF ( LVARSIG ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG forced to FALSE because LRGFIX_DST is TRUE' )
+ LVARSIG = .FALSE.
+ ELSE IF ( LVARSIG ) THEN
+ INMOMENTS_DST = 3
+ ELSE
+ INMOMENTS_DST = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_DST_A(KMI) = NMODE_DST * INMOMENTS_DST
+ NSV_DSTBEG_A(KMI)= ISV+1
+ NSV_DSTEND_A(KMI)= ISV+NSV_DST_A(KMI)
+ ISV = NSV_DSTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DST_A(KMI)
+ELSE
+ NSV_DST_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTBEG_A(KMI)= 1
+ NSV_DSTEND_A(KMI)= 0
+END IF
+IF ( LDUST .AND. LDEPOS_DST(KMI) ) THEN
+ NSV_DSTDEP_A(KMI) = NMODE_DST*2
+ NSV_DSTDEPBEG_A(KMI)= ISV+1
+ NSV_DSTDEPEND_A(KMI)= ISV+NSV_DSTDEP_A(KMI)
+ ISV = NSV_DSTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DSTDEP_A(KMI)
+ELSE
+ NSV_DSTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTDEPBEG_A(KMI)= 1
+ NSV_DSTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+
+ END IF
+! scalar variables used in sea salt model
+!
+IF (LSALT) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LSLTPRES)) LSLTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG_SLT = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND. LSLTINIT ) LVARSIG_SLT = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_SLT ) THEN
+ INMOMENTS_SLT = 1
+ IF ( LVARSIG_SLT ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG_SLT forced to FALSE because LRGFIX_SLT is TRUE' )
+ LVARSIG_SLT = .FALSE.
+ ELSE IF ( LVARSIG_SLT ) THEN
+ INMOMENTS_SLT = 3
+ ELSE
+ INMOMENTS_SLT = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_SLT_A(KMI) = NMODE_SLT * INMOMENTS_SLT
+ NSV_SLTBEG_A(KMI)= ISV+1
+ NSV_SLTEND_A(KMI)= ISV+NSV_SLT_A(KMI)
+ ISV = NSV_SLTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLT_A(KMI)
+ELSE
+ NSV_SLT_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTBEG_A(KMI)= 1
+ NSV_SLTEND_A(KMI)= 0
+END IF
+IF ( LSALT .AND. LDEPOS_SLT(KMI) ) THEN
+ NSV_SLTDEP_A(KMI) = NMODE_SLT*2
+ NSV_SLTDEPBEG_A(KMI)= ISV+1
+ NSV_SLTDEPEND_A(KMI)= ISV+NSV_SLTDEP_A(KMI)
+ ISV = NSV_SLTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLTDEP_A(KMI)
+ELSE
+ NSV_SLTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTDEPBEG_A(KMI)= 1
+ NSV_SLTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in blowing snow model
+!
+IF (LBLOWSNOW) THEN
+ NSV_SNW_A(KMI) = NBLOWSNOW3D
+ NSV_SNWBEG_A(KMI)= ISV+1
+ NSV_SNWEND_A(KMI)= ISV+NSV_SNW_A(KMI)
+ ISV = NSV_SNWEND_A(KMI)
+ELSE
+ NSV_SNW_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SNWBEG_A(KMI)= 1
+ NSV_SNWEND_A(KMI)= 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (.NOT.(LUSECHEM.OR.LCHEMDIAG) .AND. (LCH_CONV_LINOX.OR.LLNOX_EXPLICIT)) THEN
+ NSV_LNOX_A(KMI) = 1
+ NSV_LNOXBEG_A(KMI)= ISV+1
+ NSV_LNOXEND_A(KMI)= ISV+NSV_LNOX_A(KMI)
+ ISV = NSV_LNOXEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_LNOX_A(KMI)
+ELSE
+ NSV_LNOX_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LNOXBEG_A(KMI)= 1
+ NSV_LNOXEND_A(KMI)= 0
+END IF
+!
+! Final number of NSV variables
+!
+NSV_A(KMI) = ISV
+!
+!
+!* Update LHORELAX_SV,CGETSVM,CGETSVT for NON USER SV
+!
+! C2R2 or KHKO SV case
+!*BUG*JPC*MAR2006
+! IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+!*BUG*JPC*MAR2006
+LHORELAX_SV(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=LHORELAX_SVC2R2
+! C3R5 SV case
+IF (CCLOUD == 'C3R5') &
+LHORELAX_SV(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=LHORELAX_SVC1R3
+! LIMA SV case
+IF (CCLOUD == 'LIMA') &
+LHORELAX_SV(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=LHORELAX_SVLIMA
+! Electrical SV case
+IF (CELEC /= 'NONE') &
+LHORELAX_SV(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=LHORELAX_SVELEC
+! Chemical SV case
+IF (LUSECHEM .OR. LCHEMDIAG) &
+LHORELAX_SV(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=LHORELAX_SVCHEM
+! Ice phase Chemical SV case
+IF (LUSECHIC) &
+LHORELAX_SV(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=LHORELAX_SVCHIC
+! LINOX SV case
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+LHORELAX_SV(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=LHORELAX_SVCHEM
+! Dust SV case
+IF (LDUST) &
+LHORELAX_SV(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=LHORELAX_SVDST
+! Sea Salt SV case
+IF (LSALT) &
+LHORELAX_SV(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=LHORELAX_SVSLT
+! Aerosols SV case
+IF (LORILAM) &
+LHORELAX_SV(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=LHORELAX_SVAER
+! Lagrangian variables
+IF (LLG) &
+LHORELAX_SV(NSV_LGBEG_A(KMI):NSV_LGEND_A(KMI))=LHORELAX_SVLG
+! Passive pollutants
+IF (LPASPOL) &
+LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP
+#ifdef MNH_FOREFIRE
+! Fire pollutants
+IF (LFOREFIRE) &
+LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF
+#endif
+! Blaze Fire pollutants
+IF (LBLAZE) &
+LHORELAX_SV(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=LHORELAX_SVFIRE
+! Conditional sampling
+IF (LCONDSAMP) &
+LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS
+! Blowing snow case
+IF (LBLOWSNOW) &
+LHORELAX_SV(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=LHORELAX_SVSNW
+! Update NSV* variables for model KMI
+CALL UPDATE_NSV(KMI)
+!
+! SET MINIMUN VALUE FOR DIFFERENT SV GROUPS
+!
+XSVMIN(1:NSV_USER_A(KMI))=0.
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+XSVMIN(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=0.
+IF (CCLOUD == 'C3R5') &
+XSVMIN(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=0.
+IF (CCLOUD == 'LIMA') &
+XSVMIN(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=0.
+IF (CELEC /= 'NONE') &
+XSVMIN(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=0.
+IF (LUSECHEM .OR. LCHEMDIAG) &
+XSVMIN(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=0.
+IF (LUSECHIC) &
+XSVMIN(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=0.
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+XSVMIN(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=0.
+IF (LORILAM .OR. LCHEMDIAG) &
+XSVMIN(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=0.
+IF (LDUST) XSVMIN(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=XMNH_TINY
+IF ((LDUST).AND.(LDEPOS_DST(KMI))) &
+XSVMIN(NSV_DSTDEPBEG_A(KMI):NSV_DSTDEPEND_A(KMI))=XMNH_TINY
+IF (LSALT) XSVMIN(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=XMNH_TINY
+IF (LLG) THEN
+ XSVMIN(NSV_LGBEG_A(KMI)) =XLG1MIN
+ XSVMIN(NSV_LGBEG_A(KMI)+1)=XLG2MIN
+ XSVMIN(NSV_LGEND_A(KMI)) =XLG3MIN
+ENDIF
+IF ((LSALT).AND.(LDEPOS_SLT(KMI))) &
+XSVMIN(NSV_SLTDEPBEG_A(KMI):NSV_SLTDEPEND_A(KMI))=XMNH_TINY
+IF ((LORILAM).AND.(LDEPOS_AER(KMI))) &
+XSVMIN(NSV_AERDEPBEG_A(KMI):NSV_AERDEPEND_A(KMI))=XMNH_TINY
+IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0.
+#ifdef MNH_FOREFIRE
+IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0.
+#endif
+! Blaze smoke
+IF (LBLAZE) XSVMIN(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=0.
+!
+IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0.
+IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY
+!
+! NAME OF THE SCALAR VARIABLES IN THE DIFFERENT SV GROUPS
+!
+IF (ALLOCATED(CSV)) DEALLOCATE(CSV)
+ALLOCATE(CSV(NSV))
+CSV(:) = ' '
+IF (LLG) THEN
+ CSV(NSV_LGBEG_A(KMI) ) = 'X0 '
+ CSV(NSV_LGBEG_A(KMI)+1) = 'Y0 '
+ CSV(NSV_LGEND_A(KMI) ) = 'Z0 '
+ENDIF
+
+! Initialize scalar variable names for dust
+IF ( LDUST ) THEN
+ IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' )
+
+ ! Initialization of dust names
+ ! Was allocated for previous KMI
+ ! We assume that if LDUST=T on a model, NSV_DST_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ ELSE IF ( SIZE( CDUSTNAMES ) /= NSV_DST_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_DST not the same for different model (if LDUST=T)' )
+ DEALLOCATE( CDUSTNAMES )
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ END IF
+ ALLOCATE( YDUSTLONGNAMES(NSV_DST_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_DST == 1 ) THEN
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1,NMODE_DST
+ !Find which mode we are dealing with
+ IMODEIDX = JPDUSTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_DST
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_DST + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
+ JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM
+ !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for DUST' )
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme names
+ IF ( LDEPOS_DST(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN
+ ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) )
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
+ CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX)
+ ENDDO
+ END IF
+ END IF
+END IF
+
+! Initialize scalar variable names for salt
+IF ( LSALT ) THEN
+ IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' )
+
+ ! Was allocated for previous KMI
+ ! We assume that if LSALT=T on a model, NSV_SLT_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ ELSE IF ( SIZE( CSALTNAMES ) /= NSV_SLT_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_SLT not the same for different model (if LSALT=T)' )
+ DEALLOCATE( CSALTNAMES )
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ END IF
+ ALLOCATE( YSALTLONGNAMES(NSV_SLT_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_SLT == 1 ) THEN
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1, NMODE_SLT
+ !Find which mode we are dealing with
+ IMODEIDX = JPSALTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_SLT
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_SLT + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM
+ !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for SALT' )
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme
+ IF ( LDEPOS_SLT(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN
+ ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) )
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
+ CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX)
+ ENDDO
+ ENDIF
+ ENDIF
+END IF
+
+! Initialize scalar variable names for snow
+IF ( LBLOWSNOW ) THEN
+ IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN
+ ALLOCATE( CSNOWNAMES(NSV_SNW_A(KMI)) )
+ DO JMOM = 1, NSV_SNW_A(KMI)
+ CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
+ END DO
+ END IF
+END IF
+
+!Fill metadata for model KMI
+DO JSV = 1, NSV_USER_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVUSER' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVUSER' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVUSER' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SV LIMA ' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = '', &
+ CUNITS = 'kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(2) )
+ ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2
+ ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CAERO_MASS(1) )
+ TSVLIST_A(JSV, KMI)%CUNITS = 'kg kg-1'
+ ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(2) )
+ ELSE IF ( JSV == NSV_LIMA_NG_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(3) )
+ ELSE IF ( JSV == NSV_LIMA_NH_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(4) )
+ ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(5) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(6) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1)
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(7) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(8) )
+ ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CUNITS = '1'
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(5) )
+ ELSE
+ CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' )
+ END IF
+
+ TSVLIST_A(JSV, KMI)%CLONGNAME = TRIM( TSVLIST_A(JSV, KMI)%CMNHNAME )
+END DO
+
+DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI)
+ IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
+ YUNITS = 'C kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
+ ELSE
+ YUNITS = 'kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/kg)'
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CUNITS = TRIM( YUNITS ), &
+ CDIR = 'XY', &
+ CCOMMENT = TRIM( YCOMMENT ), &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVPP' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVPP' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFF' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFF' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+#endif
+
+DO JSV = NSV_FIREBEG_A(KMI), NSV_FIREEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FIREBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFIRE' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFIRE' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI)
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVCS' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVCS' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ !Determine moment to add meaning of the ppv unit
+ JAER = JSV - NSV_AERBEG_A(KMI) + 1
+ IF ( ANY( JAER == [JP_CH_M0i, JP_CH_M0j] ) ) THEN
+ !Moment 0
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( ANY( JAER == [ JP_CH_SO4i, JP_CH_SO4j, JP_CH_NO3i, JP_CH_NO3j, JP_CH_H2Oi, JP_CH_H2Oj, JP_CH_NH3i, JP_CH_NH3j, &
+ JP_CH_OCi, JP_CH_OCj, JP_CH_BCi, JP_CH_BCj, JP_CH_DSTi, JP_CH_DSTj ] ) &
+ .OR. ( NSOA == 10 .AND. &
+ ANY( JAER == [ JP_CH_SOA1i, JP_CH_SOA1j, JP_CH_SOA2i, JP_CH_SOA2j, JP_CH_SOA3i, JP_CH_SOA3j, JP_CH_SOA4i, &
+ JP_CH_SOA4j, JP_CH_SOA5i, JP_CH_SOA5j, JP_CH_SOA6i, JP_CH_SOA6j, JP_CH_SOA7i, JP_CH_SOA7j, &
+ JP_CH_SOA8i, JP_CH_SOA8j, JP_CH_SOA9i, JP_CH_SOA9j, JP_CH_SOA10i, JP_CH_SOA10j ] ) ) ) THEN
+ !Moment 3
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( ( LVARSIGI .AND. JSV == JP_CH_M6i ) .OR. ( LVARSIGJ .AND. JSV == JP_CH_M6j ) ) THEN
+ !Moment 6
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for AER' )
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) )
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YAEROLONGNAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YDUSTLONGNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YSALTLONGNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+!Check if there is at most 1 LINOX scalar variable
+!if not, the name must be modified and different for all of them
+IF ( NSV_LNOX_A(KMI) > 1 ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_LNOX_A>1: problem with the names of the corresponding scalar variables' )
+
+DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = 'LINOX'
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'LINOX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LINOX', &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+IF ( ICHIDX /= NSV_CHEM_LIST_A(KMI) ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'ICHIDX /= NSV_CHEM_LIST_A(KMI)' )
+
+END SUBROUTINE INI_NSV
diff --git a/src/mesonh/ext/init_aerosol_concentration.f90 b/src/mesonh/ext/init_aerosol_concentration.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fc4becd44a533d13ca84300d098be7872458d4f6
--- /dev/null
+++ b/src/mesonh/ext/init_aerosol_concentration.f90
@@ -0,0 +1,157 @@
+!MNH_LIC Copyright 2013-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_INIT_AEROSOL_CONCENTRATION
+!######################################
+!
+INTERFACE INIT_AEROSOL_CONCENTRATION
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration [/m**3]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+ END SUBROUTINE INIT_AEROSOL_CONCENTRATION
+END INTERFACE INIT_AEROSOL_CONCENTRATION
+!
+END MODULE MODI_INIT_AEROSOL_CONCENTRATION
+!
+! ##########################################################
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+! ##########################################################
+!!
+!! PURPOSE
+!! -------
+!! Define the aerosol distributions
+!!
+!!
+!! MODD_BLANKn :
+!! CDUMMY2 : CCN ou IFN pour le panache
+!! NDUMMY1 : hauteur base du panache
+!! NDUMMY2 : hauteur sommet du panache
+!! XDUMMY8 : Concentration du panache (N/cm3 pour des CCN, N/L pour des IFN)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!!
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_NSV
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PARAM_LIMA, ONLY : NMOM_C, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, &
+ XCCN_CONC, LCCN_HOM, &
+ NMOM_I, LNUCL, NMOD_IFN, LMEYERS, &
+ XIFN_CONC, LIFN_HOM
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_BLANK_n, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration
+ ![particles/kg of dry air]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+! Local variables
+INTEGER :: JMOD_IFN
+INTEGER :: JSV, JINIT
+INTEGER :: IKB, IKE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!*initialization of N_FREE_CCN/N_ACTIVATED_CCN et N_FREE_IN/N_ACTIVATED_IN
+!
+!
+IF ( NMOM_C.GE.2 .AND. LACTI ) THEN
+ DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+! Initialisation des concentrations en CCN
+!
+!
+ IF (LCCN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_CCN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_CCN_FREE+JSV-1) = &
+ XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_CCN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XCCN_CONC(JSV)/0.01)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = 0.01*1.0E6 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LWARM AND LACTI
+!
+! Initialisation des concentrations en IFN
+!
+IF ( NMOM_I.GE.2 .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN
+ DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+ IF (LIFN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_IFN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_IFN_FREE+JSV-1) = &
+ XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_IFN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XIFN_CONC(JSV)/1.)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = 1*1.0E3 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LCOLD AND LNUCL AND NOT LMEYERS
+!
+!
+! Cas d'un panache de "pollution", concentration homogène dans le panache :
+!
+SELECT CASE (CDUMMY2)
+ CASE ('CCN')
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=XDUMMY8*1.0E6 / PRHODREF(:,:,:)
+ CASE ('IFN')
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=XDUMMY8*1.0E3 / PRHODREF(:,:,:)
+END SELECT
+!
+!
+END SUBROUTINE INIT_AEROSOL_CONCENTRATION
diff --git a/src/mesonh/ext/modeln.f90 b/src/mesonh/ext/modeln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b5ab334898edb2435108ee39274f9f58f0bd6ee0
--- /dev/null
+++ b/src/mesonh/ext/modeln.f90
@@ -0,0 +1,2414 @@
+!MNH_LIC Copyright 1994-2023 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_MODEL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+END SUBROUTINE MODEL_n
+!
+END INTERFACE
+!
+END MODULE MODI_MODEL_n
+
+! ###################################
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+! ###################################
+!
+!!**** *MODEL_n * -monitor of the model version _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to build up a typical model version
+! by sequentially calling the specialized routines.
+!
+!!** METHOD
+!! ------
+!! Some preliminary initializations are performed in the first section.
+!! Then, specialized routines are called to update the guess of the future
+!! instant XRxxS of the variable xx by adding the effects of all the
+!! different sources of evolution.
+!!
+!! (guess of xx at t+dt) * Rhod_ref * Jacobian
+!! XRxxS = -------------------------------------------
+!! 2 dt
+!!
+!! At this level, the informations are transferred with a USE association
+!! from the INIT step, where the modules have been previously filled. The
+!! transfer to the subroutines computing each source term is performed by
+!! argument in order to avoid repeated compilations of these subroutines.
+!! This monitor model_n, must therefore be duplicated for each model,
+!! model1 corresponds in this case to the outermost model, model2 is used
+!! for the first level of gridnesting,....
+!! The effect of all parameterizations is computed in PHYS_PARAM_n, which
+!! is itself a monitor. This is due to a possible large number of
+!! parameterizations, which can be activated and therefore, will require a
+!! very large list of arguments. To circumvent this problem, we transfer by
+!! a USE association, the necessary informations in this monitor, which will
+!! dispatch the pertinent information to every parametrization.
+!! Some elaborated diagnostics, LES tools, budget storages are also called
+!! at this level because they require informations about the fields at every
+!! timestep.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine IO_File_open: to open a file
+!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
+!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
+!! Subroutine SET_MASK : to compute all the masks selected for budget
+!! computations
+!! Subroutine BOUNDARIES : set the fields at the marginal points in every
+!! directions according the selected boundary conditions
+!! Subroutine INITIAL_GUESS: initializes the guess of the future instant
+!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
+!! spectra of some quantities when running in LES mode.
+!! Subroutine ADVECTION: computes the advection terms.
+!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
+!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
+!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields
+!! in the upper levels and outermost vertical planes
+!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms
+!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
+!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
+!! form
+!! Subroutine PRESSURE : computes the pressure gradient term and the
+!! absolute pressure
+!! Subroutine EXCHANGE : updates the halo of each subdomains
+!! Subroutine ENDSTEP : advances in time the fields.
+!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
+!! compute the large scale fields, used to
+!! couple Model_n with outer informations.
+!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
+!! Subroutine IO_File_close: closes a file
+!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
+!! Subroutine FORCING : computes forcing terms
+!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_DYN
+!! MODD_CONF
+!! MODD_NESTING
+!! MODD_BUDGET
+!! MODD_PARAMETERS
+!! MODD_CONF_n
+!! MODD_CURVCOR_n
+!! MODD_DYN_n
+!! MODD_DIM_n
+!! MODD_ADV_n
+!! MODD_FIELD_n
+!! MODD_LSFIELD_n
+!! MODD_GRID_n
+!! MODD_METRICS_n
+!! MODD_LBC_n
+!! MODD_PARAM_n
+!! MODD_REF_n
+!! MODD_LUNIT_n
+!! MODD_OUT_n
+!! MODD_TIME_n
+!! MODD_TURB_n
+!! MODD_CLOUDPAR_n
+!! MODD_TIME
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/09/94
+!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines
+!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call
+!! Modification 16/11/94 (J.Stein) add call to the renormalization
+!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
+!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
+!! ..) + add RELAXATION + LS fiels in the arguments
+!! Modification 19/12/94 (J.Stein) switch for the num diff
+!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call
+!! Modification 05/01/95 (J.Stein) add the parameterization monitor
+!! Modification 09/01/95 (J.Stein) add the 1D switch
+!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation
+!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis
+!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
+!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and
+!! Initial_guess to correct a bug in 2D configuration
+!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
+!! calls
+!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
+!! March,21, 1995 (J. Stein) remove R from the historical var.
+!! March,26, 1995 (J. Stein) add the EPS variable
+!! April 18, 1995 (J. Cuxart) add the LES call
+!! Sept 20,1995 (Lafore) coupling for the dry mass Md
+!! Nov 2,1995 (Stein) displace the temporal counter increase
+!! Jan 2,1996 (Stein) rm the test on the temporal counter
+!! Modification Feb 5,1996 (J. Vila) implementation new advection
+!! schemes for scalars
+!! Modification Feb 20,1996 (J.Stein) doctor norm
+!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
+!! June 17,1996 (Vincent, Lafore, Jabouille)
+!! statistics of computing time
+!! Aug 8, 1996 (K. Suhre) add chemistry
+!! October 12, 1996 (J. Stein) save the PSRC value
+!! Sept 05,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! July 22,1996 (Lafore) improve write of computing time statistics
+!! July 29,1996 (Lafore) nesting introduction
+!! Aug. 1,1996 (Lafore) synchronization between models
+!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
+!! now split in 2 routines
+!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
+!! Sept 5,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! Sept 25,1996 (V.Masson) test for coupling performed here
+!! Oct. 29,1996 (Lafore) one-way nesting implementation
+!! Oct. 12,1996 (J. Stein) save the PSRC value
+!! Dec. 12,1996 (Lafore) change call to RAD_BOUND
+!! Dec. 21,1996 (Lafore) two-way nesting implementation
+!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields
+!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
+!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
+!! Dec 20, 1996 (J.-P. Pinty) update the budgets
+!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
+!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control
+!! Dec 20,1996 (V.Masson) call boundaries before the writing
+!! Fev 25, 1997 (P.Jabouille) modify the LES tools
+!! April 3,1997 (Lafore) merging of the nesting
+!! developments on MASTER3
+!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7)
+!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS
+!! Aug. 19,1997 (Lafore) full Clark's formulation introduction
+!! Sept 26,1997 (Lafore) LS source calculation at restart
+!! (temporarily test to have LS at instant t)
+!! Jan. 28,1998 (Bechtold) add SST forcing
+!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget
+!! Jul. 10,1998 (Stein ) sequentiel loop for nesting
+!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines
+!! oct. 20,1998 (Jabouille) //
+!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
+!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
+!! mar, 4,2002 (V.Ducrocq) call to temporal series
+!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
+!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES
+!! mars 20,2001 (Pinty) add ICE4 and C3R5 options
+!! jan. 2004 (Masson) surface externalization
+!! sept 2004 (M. Tomasini) Cloud mixing length modification
+!! june 2005 (P. Tulet) add aerosols / dusts
+!! Jul. 2005 (N. Asencio) two_way and phys_param calls:
+!! Add the surface parameters : precipitating
+!! hydrometeors, Short and Long Wave , MASKkids array
+!! Fev. 2006 (M. Leriche) add aqueous phase chemistry
+!! april 2006 (T.Maric) Add halo related to 4th order advection scheme
+!! May 2006 Remove KEPS
+!! Oct 2008 (C.Lac) FIT for variables advected with PPM
+!! July 2009 : Displacement of surface diagnostics call to be
+!! coherent with surface diagnostics obtained with DIAG
+!! 10/11/2009 (P. Aumond) Add mean moments
+!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
+!! July 2010 (M. Leriche) add ice phase chemical species
+!! April 2011 (C.Lac) : Remove instant M
+!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
+!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call
+! of write_phys_param
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT
+!!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor
+!! 09/2016 Add filter on negative values on AERDEP SV before relaxation
+!! 10/2016 (C.Lac) _ Correction on the flag for Strang splitting
+!! to insure reproducibility between START and RESTA
+!! _ Add OSPLIT_WENO
+!! _ Add droplet deposition
+!! 10/2016 (M.Mazoyer) New KHKO output fields
+!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 10/2017 (C.Lac) Necessity to have chemistry processes as
+!! the las process modifying XRSVS
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 07/2017 (V. Vionnet) : Add blowing snow scheme
+!! S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep
+!! 01/2018 (C.Lac) Add VISCOSITY
+!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
+! to allow to disable writes (for bench purposes)
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+!! 02/2019 C.Lac add rain fraction as an output field
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
+! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
+! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! A. Costes 12/2021: add Blaze fire model
+! C. Barthe 07/04/2022: deallocation of ZSEA
+! P. Wautelet 08/12/2022: bugfix if no TDADFILE
+! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
+! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_2D_FRC
+USE MODD_ADV_n
+USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_BAKOUT
+USE MODD_BIKHARDT_n
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, &
+ tbudgets, tbuconf, tburhodj, &
+ xtime_bu, xtime_bu_process
+USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
+ LCH_INIT_FIELD
+USE MODD_CLOUD_MF_n
+USE MODD_CLOUDPAR_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST, ONLY: CST
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DIM_n
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DRAG_n
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_DYNZD
+USE MODD_DYNZD_n
+USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
+USE MODD_FIELD_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
+USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
+USE MODD_LBC_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT, ONLY: TOUTDATAFILE
+USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
+USE MODD_MEAN_FIELD
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_NSV
+USE MODD_NUDGING_n
+USE MODD_OUT_n
+USE MODD_PARAM_C1R3, ONLY: NSEDI => LSEDI, NHHONI => LHHONI
+USE MODD_PARAM_C2R2, ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC
+USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, NMOM_C, NMOM_R, &
+ MACTIT => LACTIT, LSCAV, NMOM_I, &
+ MSEDI => LSEDI, MHHONI => LHHONI, NMOM_H, &
+ XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PAST_FIELD_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_REF_n
+USE MODD_SALT, ONLY: LSALT
+USE MODD_SERIES, ONLY: LSERIES
+USE MODD_SERIES_n, ONLY: NFREQSERIES
+USE MODD_STATION_n
+USE MODD_SUB_MODEL_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_TIMEZ
+USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
+USE MODD_TURB_n
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+USE MODD_VISCOSITY
+!
+USE MODE_AIRCRAFT_BALLOON
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_DATETIME
+USE MODE_ELEC_ll
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
+USE MODE_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+USE MODE_ONE_WAY_n
+USE MODE_WRITE_AIRCRAFT_BALLOON
+use mode_write_les_n, only: Write_les_n
+use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
+USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
+USE MODE_WRITE_STATION_n, ONLY: WRITE_STATION_n
+!
+USE MODI_ADDFLUCTUATIONS
+USE MODI_ADVECTION_METSV
+USE MODI_ADVECTION_UVW
+USE MODI_ADVECTION_UVW_CEN
+USE MODI_ADV_FORCING_n
+USE MODI_AER_MONITOR_n
+USE MODI_BLOWSNOW
+USE MODI_BOUNDARIES
+USE MODI_BUDGET_FLAGS
+USE MODI_CART_COMPRESS
+USE MODI_CH_MONITOR_n
+USE MODI_DIAG_SURF_ATM_N
+USE MODI_DYN_SOURCES
+USE MODI_END_DIAG_IN_RUN
+USE MODI_ENDSTEP
+USE MODI_ENDSTEP_BUDGET
+USE MODI_EXCHANGE
+USE MODI_FORCING
+USE MODI_FORC_SQUALL_LINE
+USE MODI_FORC_WIND
+USE MODI_GET_HALO
+USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
+USE MODI_INI_DIAG_IN_RUN
+USE MODI_INI_LG
+USE MODI_INI_MEAN_FIELD
+USE MODI_INITIAL_GUESS
+USE MODI_LES_INI_TIMESTEP_n
+USE MODI_LES_N
+USE MODI_LIMA_PRECIP_SCAVENGING
+USE MODI_LS_COUPLING
+USE MODI_MASK_COMPRESS
+USE MODI_MEAN_FIELD
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_MNHWRITE_ZS_DUMMY_n
+USE MODI_NUDGING
+USE MODI_NUM_DIFF
+USE MODI_PHYS_PARAM_n
+USE MODI_PRESSUREZ
+USE MODI_PROFILER_n
+USE MODI_RAD_BOUND
+USE MODI_RECYCLING
+USE MODI_RELAX2FW_ION
+USE MODI_RELAXATION
+USE MODI_REL_FORCING_n
+USE MODI_RESOLVED_CLOUD
+USE MODI_RESOLVED_ELEC_n
+USE MODI_SERIES_N
+USE MODI_SETLB_LG
+USE MODI_SET_MASK
+USE MODI_SHUMAN
+USE MODI_SPAWN_LS_n
+USE MODI_STATION_n
+USE MODI_TURB_CLOUD_INDEX
+USE MODI_TWO_WAY
+USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_DIAG_SURF_ATM_N
+USE MODI_WRITE_LFIFM_n
+USE MODI_WRITE_SERIES_n
+USE MODI_WRITE_SURF_ATM_N
+!
+USE MODD_FIRE_n
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUOUT ! Logical unit number for the output listing
+INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
+INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
+INTEGER :: INBVAR ! number of HALO2_lls to allocate
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: IVERB ! LFI verbosity level
+LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
+!
+ ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT, ZBLAZETOT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
+CHARACTER :: YMI
+INTEGER :: IPOINTS
+CHARACTER(len=16) :: YTCOUNT,YPOINTS
+CHARACTER(LEN=:), ALLOCATABLE :: YDADNAME
+!
+INTEGER :: ISYNCHRO ! model synchronic index relative to its father
+ ! = 1 for the first time step in phase with DAD
+ ! = 0 for the last time step (out of phase)
+INTEGER :: IMI ! Current model index
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
+! Dummy pointers needed to correct an ifort Bug
+REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
+REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
+!
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
+LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D
+!
+LOGICAL :: KWARM
+LOGICAL :: KRAIN
+LOGICAL :: KSEDC
+LOGICAL :: KACTIT
+LOGICAL :: KSEDI
+LOGICAL :: KHHONI
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t
+ ! (and not t+1) to resolved_cloud
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
+!
+TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
+!
+TYPE(TFILEDATA),POINTER :: TZOUTFILE
+! TYPE(TFILEDATA),SAVE :: TZDIACFILE
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+!-------------------------------------------------------------------------------
+!
+TPBAKFILE=> NULL()
+TZOUTFILE=> NULL()
+!
+TPDTMODELN = TDTCUR
+!
+!* 0. MICROPHYSICAL SCHEME
+! -------------------
+SELECT CASE(CCLOUD)
+CASE('C2R2','KHKO','C3R5')
+ KWARM = .TRUE.
+ KRAIN = NRAIN
+ KSEDC = NSEDC
+ KACTIT = NACTIT
+!
+ KSEDI = NSEDI
+ KHHONI = NHHONI
+CASE('LIMA')
+ KRAIN = NMOM_R.GE.1
+ KWARM = NMOM_C.GE.1
+ KSEDC = MSEDC
+ KACTIT = MACTIT
+!
+ KSEDI = MSEDI
+ KHHONI = MHHONI
+CASE('ICE3','ICE4') !default values
+ KWARM = LWARM
+ KRAIN = .TRUE.
+ KSEDC = .TRUE.
+ KACTIT = .FALSE.
+!
+ KSEDI = .TRUE.
+ KHHONI = .FALSE.
+END SELECT
+!
+!
+!* 1 PRELIMINARY
+! ------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1.0 update NSV_* variables for current model
+! ----------------------------------------
+!
+CALL UPDATE_NSV(IMI)
+!
+!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1.2 SET ARRAY SIZE
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IF (IMI==1) THEN
+ GSTEADY_DMASS=LSTEADYLS
+ELSE
+ GSTEADY_DMASS=.FALSE.
+END IF
+!
+!* 1.3 OPEN THE DIACHRONIC FILE
+!
+IF (KTCOUNT == 1) THEN
+!
+ NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll)
+ NULLIFY(TLSFIELD2D_ll)
+ NULLIFY(THALO2T_ll)
+ NULLIFY(TLSHALO2_ll)
+ NULLIFY(TFIELDSC_ll)
+!
+ ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
+ ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ CALL IO_File_open(TDIAFILE)
+!
+ CALL IO_Header_write(TDIAFILE)
+ CALL WRITE_DESFM_n(IMI,TDIAFILE)
+ CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
+ END IF
+!
+!* 1.4 Initialization of the list of fields for the halo updates
+!
+! a) Sources terms
+!
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS, 'MODEL_n::XRUS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS, 'MODEL_n::XRVS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS, 'MODEL_n::XRWS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS, 'MODEL_n::XRTHS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS (:,:,:,1:NRR), 'MODEL_n::XRRS' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
+ IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
+ ! Fire model parallel setup
+ IF (LBLAZE) THEN
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI, 'MODEL_n::XLSPHI')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP, 'MODEL_n::XBMAP')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA, 'MODEL_n::XFMRFA')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0, 'MODEL_n::XFMWF0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0, 'MODEL_n::XFMR0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00, 'MODEL_n::XFMR00')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU, 'MODEL_n::XFIRETAU')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW, 'MODEL_n::XFIRERW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE, 'MODEL_n::XFMASE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC, 'MODEL_n::XFMAWC')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG, 'MODEL_n::XFMWALKIG')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS, 'MODEL_n::XFMHWS')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU, 'MODEL_n::XFMWINDU')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV, 'MODEL_n::XFMWINDV')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW, 'MODEL_n::XFMWINDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
+ END IF
+ !
+ IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ !
+ ! b) LS fields
+ !
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSUM, 'MODEL_n::XLSUM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSVM, 'MODEL_n::XLSVM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSWM, 'MODEL_n::XLSWM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSTHM, 'MODEL_n::XLSTHM' )
+ CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' )
+ IF (NRR >= 1) THEN
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' )
+ ENDIF
+ !
+ ! c) Fields at t
+ !
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XWT, 'MODEL_n::XWT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' )
+ !
+ !* 1.5 Initialize the list of fields for the halo updates (2nd layer)
+ !
+ INBVAR = 4+NRR+NSV
+ IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
+ CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
+ !
+ !* 1.6 Initialise the 2nd layer of the halo of the LS fields
+ !
+ IF ( LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ END IF
+ !
+!
+ !
+ XT_START = 0.0_MNHTIME
+ !
+ XT_STORE = 0.0_MNHTIME
+ XT_BOUND = 0.0_MNHTIME
+ XT_GUESS = 0.0_MNHTIME
+ XT_FORCING = 0.0_MNHTIME
+ XT_NUDGING = 0.0_MNHTIME
+ XT_ADV = 0.0_MNHTIME
+ XT_ADVUVW = 0.0_MNHTIME
+ XT_GRAV = 0.0_MNHTIME
+ XT_SOURCES = 0.0_MNHTIME
+ !
+ XT_DIFF = 0.0_MNHTIME
+ XT_RELAX = 0.0_MNHTIME
+ XT_PARAM = 0.0_MNHTIME
+ XT_SPECTRA = 0.0_MNHTIME
+ XT_HALO = 0.0_MNHTIME
+ XT_VISC = 0.0_MNHTIME
+ XT_RAD_BOUND = 0.0_MNHTIME
+ XT_PRESS = 0.0_MNHTIME
+ !
+ XT_CLOUD = 0.0_MNHTIME
+ XT_STEP_SWA = 0.0_MNHTIME
+ XT_STEP_MISC = 0.0_MNHTIME
+ XT_COUPL = 0.0_MNHTIME
+ XT_1WAY = 0.0_MNHTIME
+ XT_STEP_BUD = 0.0_MNHTIME
+ !
+ XT_RAD = 0.0_MNHTIME
+ XT_DCONV = 0.0_MNHTIME
+ XT_GROUND = 0.0_MNHTIME
+ XT_TURB = 0.0_MNHTIME
+ XT_MAFL = 0.0_MNHTIME
+ XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
+ XT_TRACER = 0.0_MNHTIME
+ XT_SHADOWS = 0.0_MNHTIME
+ XT_ELEC = 0.0_MNHTIME
+ XT_CHEM = 0.0_MNHTIME
+ XT_2WAY = 0.0_MNHTIME
+ !
+ XT_IBM_FORC = 0.0_MNHTIME
+ ! Blaze fire model
+ XFIREPERF = 0.0_MNHTIME
+ !
+END IF
+!
+!* 1.7 Allocation of arrays for observation diagnostics
+!
+CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
+!
+!
+CALL SECOND_MNH2(ZEND)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
+! ---------------------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
+!
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
+ DPTR_XBMX1=>XBMX1
+ DPTR_XBMX2=>XBMX2
+ DPTR_XBMX3=>XBMX3
+ DPTR_XBMX4=>XBMX4
+ DPTR_XBMY1=>XBMY1
+ DPTR_XBMY2=>XBMY2
+ DPTR_XBMY3=>XBMY3
+ DPTR_XBMY4=>XBMY4
+ DPTR_XBFX1=>XBFX1
+ DPTR_XBFX2=>XBFX2
+ DPTR_XBFX3=>XBFX3
+ DPTR_XBFX4=>XBFX4
+ DPTR_XBFY1=>XBFY1
+ DPTR_XBFY2=>XBFY2
+ DPTR_XBFY3=>XBFY3
+ DPTR_XBFY4=>XBFY4
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ !
+ DPTR_XZZ=>XZZ
+ DPTR_XZHAT=>XZHAT
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_XLSTHM=>XLSTHM
+ DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSUM=>XLSUM
+ DPTR_XLSVM=>XLSVM
+ DPTR_XLSWM=>XLSWM
+ DPTR_XLSZWSM=>XLSZWSM
+ DPTR_XLSTHS=>XLSTHS
+ DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSUS=>XLSUS
+ DPTR_XLSVS=>XLSVS
+ DPTR_XLSWS=>XLSWS
+ DPTR_XLSZWSS=>XLSZWSS
+ !
+ IF ( LSTEADYLS ) THEN
+ NCPL_CUR=0
+ ELSE
+ IF (NCPL_CUR/=1) THEN
+ IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN
+ !
+ ! LS sources are interpolated from the LS field
+ ! values of model DAD(IMI)
+ CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
+ DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, &
+ DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS )
+ END IF
+ END IF
+ !
+ END IF
+ !
+ DPTR_NKLIN_LBXU=>NKLIN_LBXU
+ DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
+ DPTR_NKLIN_LBYU=>NKLIN_LBYU
+ DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
+ DPTR_NKLIN_LBXV=>NKLIN_LBXV
+ DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
+ DPTR_NKLIN_LBYV=>NKLIN_LBYV
+ DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
+ DPTR_NKLIN_LBXW=>NKLIN_LBXW
+ DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
+ DPTR_NKLIN_LBYW=>NKLIN_LBYW
+ DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
+ !
+ DPTR_NKLIN_LBXM=>NKLIN_LBXM
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_NKLIN_LBYM=>NKLIN_LBYM
+ DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
+ !
+ DPTR_XLBXUM=>XLBXUM
+ DPTR_XLBYUM=>XLBYUM
+ DPTR_XLBXVM=>XLBXVM
+ DPTR_XLBYVM=>XLBYVM
+ DPTR_XLBXWM=>XLBXWM
+ DPTR_XLBYWM=>XLBYWM
+ DPTR_XLBXTHM=>XLBXTHM
+ DPTR_XLBYTHM=>XLBYTHM
+ DPTR_XLBXTKEM=>XLBXTKEM
+ DPTR_XLBYTKEM=>XLBYTKEM
+ DPTR_XLBXRM=>XLBXRM
+ DPTR_XLBYRM=>XLBYRM
+ DPTR_XLBXSVM=>XLBXSVM
+ DPTR_XLBYSVM=>XLBYSVM
+ !
+ DPTR_XLBXUS=>XLBXUS
+ DPTR_XLBYUS=>XLBYUS
+ DPTR_XLBXVS=>XLBXVS
+ DPTR_XLBYVS=>XLBYVS
+ DPTR_XLBXWS=>XLBXWS
+ DPTR_XLBYWS=>XLBYWS
+ DPTR_XLBXTHS=>XLBXTHS
+ DPTR_XLBYTHS=>XLBYTHS
+ DPTR_XLBXTKES=>XLBXTKES
+ DPTR_XLBYTKES=>XLBYTKES
+ DPTR_XLBXRS=>XLBXRS
+ DPTR_XLBYRS=>XLBYRS
+ DPTR_XLBXSVS=>XLBXSVS
+ DPTR_XLBYSVS=>XLBYSVS
+ !
+ CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
+ GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, &
+ DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
+ DPTR_XLBXTHM,DPTR_XLBYTHM, &
+ DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
+ DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, &
+ XDRYMASST,XDRYMASSS, &
+ DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, &
+ DPTR_XLBXTHS,DPTR_XLBYTHS, &
+ DPTR_XLBXTKES,DPTR_XLBYTKES, &
+ DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS )
+ !
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
+! ------------------------------------------------------
+!
+ZTIME1=ZTIME2
+!
+!* 3.1 Set the lagragian variables values at the LB
+!
+IF( LLG .AND. IMI==1 ) CALL SETLB_LG
+!
+IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
+CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+CALL BOUNDARIES ( &
+ XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
+ XRHODJ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
+!
+!
+! For START/RESTART MPPDB_CHECK use
+!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!-------------------------------------------------------------------------------
+!* initializes surface number
+IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
+!-------------------------------------------------------------------------------
+!
+!* 4. STORAGE IN A SYNCHRONOUS FILE
+! -----------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( nfile_backup_current < NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
+ nfile_backup_current = nfile_backup_current + 1
+ !
+ TPBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
+ IVERB = TPBAKFILE%NLFIVERB
+ !
+ CALL IO_File_open(TPBAKFILE)
+ !
+ CALL WRITE_DESFM_n(IMI,TPBAKFILE)
+ CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
+ IF ( ASSOCIATED( TBACKUPN(nfile_backup_current)%TFILE%TDADFILE ) ) THEN
+ YDADNAME = TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME
+ ELSE
+ ! Set a dummy name for the dad file. Its non-zero size will allow the writing of some data in the backup file
+ YDADNAME = 'DUMMY'
+ END IF
+ CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TRIM( YDADNAME ) )
+ TOUTDATAFILE => TPBAKFILE
+ CALL MNHWRITE_ZS_DUMMY_n(TPBAKFILE)
+ IF (CSURF=='EXTE') THEN
+ TFILE_SURFEX => TPBAKFILE
+ CALL GOTO_SURFEX(IMI)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
+ IF ( KTCOUNT > 1) THEN
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ END IF
+ NULLIFY(TFILE_SURFEX)
+ END IF
+ !
+ ! Reinitialize Lagragian variables at every model backup
+ IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
+ CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
+ IF (IVERB>=5) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TPBAKFILE%CNAME),' backup'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ END IF
+ END IF
+ ! Reinitialise mean variables
+ IF (LMEAN_FIELD) THEN
+ CALL INI_MEAN_FIELD
+ END IF
+!
+ ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+ END IF
+ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+END IF
+!
+IF ( nfile_output_current < NOUT_NUMB ) THEN
+ IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN
+ nfile_output_current = nfile_output_current + 1
+ !
+ TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE
+ !
+ CALL IO_File_open(TZOUTFILE)
+ !
+ CALL IO_Header_write(TZOUTFILE)
+ CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) )
+ CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) )
+ !
+ CALL IO_File_close(TZOUTFILE)
+ !
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STORE = XT_STORE + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZATION OF THE BUDGET VARIABLES
+! --------------------------------------
+!
+IF (NBUMOD==IMI) THEN
+ LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP'
+ELSE
+ LBU_ENABLE = .FALSE.
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
+ CALL SET_MASK()
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
+END IF
+!
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+XTIME_BU = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. INITIALIZATION OF THE FIELD TENDENCIES
+! --------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZATION OF THE LES FOR CURRENT TIME-STEP
+! -----------------------------------------------
+!
+XTIME_LES_BU = 0.0
+XTIME_LES = 0.0
+IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. TWO-WAY INTERACTIVE GRID-NESTING
+! --------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+GMASKkids(:,:)=.FALSE.
+!
+IF (NMODEL>1) THEN
+ ! correct an ifort bug
+ DPTR_XRHODJ=>XRHODJ
+ DPTR_XUM=>XUT
+ DPTR_XVM=>XVT
+ DPTR_XWM=>XWT
+ DPTR_XTHM=>XTHT
+ DPTR_XRM=>XRT
+ DPTR_XTKEM=>XTKET
+ DPTR_XSVM=>XSVT
+ DPTR_XRUS=>XRUS
+ DPTR_XRVS=>XRVS
+ DPTR_XRWS=>XRWS
+ DPTR_XRTHS=>XRTHS
+ DPTR_XRRS=>XRRS
+ DPTR_XRTKES=>XRTKES
+ DPTR_XRSVS=>XRSVS
+ DPTR_XINPRC=>XINPRC
+ DPTR_XINPRR=>XINPRR
+ DPTR_XINPRS=>XINPRS
+ DPTR_XINPRG=>XINPRG
+ DPTR_XINPRH=>XINPRH
+ DPTR_XPRCONV=>XPRCONV
+ DPTR_XPRSCONV=>XPRSCONV
+ DPTR_XDIRFLASWD=>XDIRFLASWD
+ DPTR_XSCAFLASWD=>XSCAFLASWD
+ DPTR_XDIRSRFSWD=>XDIRSRFSWD
+ DPTR_GMASKkids=>GMASKkids
+ !
+ CALL TWO_WAY( NRR,NSV,KTCOUNT,DPTR_XRHODJ,IMI,XTSTEP, &
+ DPTR_XUM ,DPTR_XVM ,DPTR_XWM , DPTR_XTHM, DPTR_XRM,DPTR_XSVM, &
+ DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS,DPTR_XRRS,DPTR_XRSVS, &
+ DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG,DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV, &
+ DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD,DPTR_GMASKkids )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 10. FORCING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
+ LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
+ XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, ZJ )
+END IF
+!
+IF ( LFORCING ) THEN
+ CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
+ XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
+END IF
+!
+IF ( L2D_ADV_FRC ) THEN
+ CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+IF ( L2D_REL_FRC ) THEN
+ CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_FORCING = XT_FORCING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. NUDGING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUDGING ) THEN
+ CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, &
+ XUT,XVT,XWT,XTHT,XRT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XRUS,XRVS,XRWS,XRTHS,XRRS)
+
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_NUDGING = XT_NUDGING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. DYNAMICAL SOURCES
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) + XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) + XVTRANS
+END IF
+!
+CALL DYN_SOURCES( NRR,NRRL, NRRI, &
+ XUT, XVT, XWT, XTHT, XRT, &
+ XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, &
+ XRHODJ, XZZ, XTHVREF, XEXNREF, &
+ XRUS, XRVS, XRWS, XRTHS )
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) - XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) - XVTRANS
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SOURCES = XT_SOURCES + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. NUMERICAL DIFFUSION
+! -------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
+!
+ CALL UPDATE_HALO_ll(TFIELDT_ll, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TFIELDT_ll, THALO2T_ll, IINFO_ll)
+ IF ( .NOT. LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, &
+ XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, &
+ XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, &
+ LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
+ THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 )
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+
+DO JSV = NSV_CHEMBEG,NSV_CHEMEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CHICBEG,NSV_CHICEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERBEG,NSV_AEREND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_LNOXBEG,NSV_LNOXEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTBEG,NSV_DSTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTBEG,NSV_SLTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_PPBEG,NSV_PPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG,NSV_FFEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#endif
+! Blaze smoke
+DO JSV = NSV_FIREBEG,NSV_FIREEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CSBEG,NSV_CSEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SNWBEG,NSV_SNWEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+IF (CELEC .NE. 'NONE') THEN
+ XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.)
+ XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.)
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_DIFF = XT_DIFF + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. UPPER AND LATERAL RELAXATION
+! ----------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
+ LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
+ LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
+ ANY(LHORELAX_SV)) THEN
+ CALL RELAXATION (LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV,LHORELAX_RC, &
+ LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, &
+ LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, &
+ LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVELEC,LHORELAX_SVLG, &
+ LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
+ LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
+ LHORELAX_SVCS,LHORELAX_SVSNW,LHORELAX_SVFIRE, &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF, &
+#endif
+ KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XLSUM, XLSVM, XLSWM, XLSTHM, &
+ XLBXUM, XLBXVM, XLBXWM, XLBXTHM, &
+ XLBXRM, XLBXSVM, XLBXTKEM, &
+ XLBYUM, XLBYVM, XLBYWM, XLBYTHM, &
+ XLBYRM, XLBYSVM, XLBYTKEM, &
+ NALBOT, XALK, XALKW, &
+ NALBAS, XALKBAS, XALKWBAS, &
+ LMASK_RELAX,XKURELAX, XKVRELAX, XKWRELAX, &
+ NRIMX,NRIMY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES )
+END IF
+
+IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN
+ CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, &
+ XALK, LMASK_RELAX, XKWRELAX, XRSVS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. PARAMETRIZATIONS' MONITOR
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL PHYS_PARAM_n( KTCOUNT, TPBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
+!
+IF (CDCONV/='NONE') THEN
+ XPACCONV = XPACCONV + XPRCONV * XTSTEP
+ IF (LCH_CONV_LINOX) THEN
+ XIC_TOTAL_NUMBER = XIC_TOTAL_NUMBER + XIC_RATE * XTSTEP
+ XCG_TOTAL_NUMBER = XCG_TOTAL_NUMBER + XCG_RATE * XTSTEP
+ END IF
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PARAM = XT_PARAM + ZTIME2 - ZTIME1 - XTIME_LES - ZTIME
+!
+!-------------------------------------------------------------------------------
+!
+!* 16. TEMPORAL SERIES
+! ---------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LSERIES) THEN
+ IF ( MOD (KTCOUNT-1,NFREQSERIES) == 0 ) CALL SERIES_n
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. LARGE SCALE FIELD REFRESH
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (.NOT. LSTEADYLS) THEN
+ IF ( IMI==1 .AND. &
+ NCPL_CUR < NCPL_NBR ) THEN
+ IF (KTCOUNT+1 == NCPL_TIMES(NCPL_CUR,1) ) THEN
+ ! The next current time reachs a
+ NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed
+ !
+ CALL LS_COUPLING(XTSTEP,GSTEADY_DMASS,CCONF, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, &
+ NIMAX_ll,NJMAX_ll, &
+ NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ !
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ END IF
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 8 Bis . Blowing snow scheme
+! ---------
+!
+IF ( LBLOWSNOW ) THEN
+ CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, &
+ XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D )
+ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!* 8 Ter VISCOSITY (no-slip condition inside)
+! ---------
+!
+!
+IF ( LVISC ) THEN
+!
+ZTIME1 = ZTIME2
+!
+ CALL VISCOSITY(CLBCX, CLBCY, NRR, NSV, XMU_V,XPRANDTL, &
+ LVISC_UVW,LVISC_TH,LVISC_SV,LVISC_R, &
+ LDRAG, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS,XDRAG )
+!
+ENDIF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_VISC = XT_VISC + ZTIME2 - ZTIME1
+!!
+!-------------------------------------------------------------------------------
+!
+!* 9. ADVECTION
+! ---------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!
+!
+CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+ CALL ADVECTION_METSV ( TPBAKFILE, CUVW_ADV_SCHEME, &
+ CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
+ LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
+ CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, &
+ XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRTHS, XRRS, XRTKES, XRSVS, &
+ XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
+CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZRWS = XRWS
+!
+CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
+ XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, &
+ XRTHS_CLD, XRRS_CLD )
+!
+! At the initial instant the difference with the ref state creates a
+! vertical velocity production that must not be advected as it is
+! compensated by the pressure gradient
+!
+IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!MPPDB_CHECK_LB=.TRUE.
+CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ NULLIFY(TZFIELDC_ll)
+ NULLIFY(TZHALO2C_ll)
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XWT, 'MODEL_n::XWT' )
+ CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU)
+ CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll)
+ END IF
+ CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, &
+ CLBCX, CLBCY, &
+ XTSTEP, KTCOUNT, &
+ XUM, XVM, XWM, XDUM, XDVM, XDWM, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS,XRVS, XRWS, &
+ TZHALO2C_ll )
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CLEANLIST_ll(TZFIELDC_ll)
+ NULLIFY(TZFIELDC_ll)
+ CALL DEL_HALO2_ll(TZHALO2C_ll)
+ NULLIFY(TZHALO2C_ll)
+ END IF
+ELSE
+
+ CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NWENO_ORDER, LSPLIT_WENO, &
+ CLBCX, CLBCY, XTSTEP, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, &
+ XRUS_PRES, XRVS_PRES, XRWS_PRES )
+END IF
+!
+CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+!MPPDB_CHECK_LB=.FALSE.
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ CALL TURB_CLOUD_INDEX( XTSTEP, TPBAKFILE, &
+ LTURB_DIAG, NRRI, &
+ XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XCEI )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY
+! --------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ZRUS=XRUS
+ZRVS=XRVS
+ZRWS=XRWS
+!
+if ( .not. l1d ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
+end if
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND : other var",PRECISION,XUT,XVT,XRHODJ,XTKET)
+CALL MPPDB_CHECKLB(XLBXUM,"modeln XLBXUM",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY)
+CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY)
+!
+ CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+ XTSTEP, &
+ XDXHAT, XDYHAT, XZHAT, &
+ XUT, XVT, &
+ XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
+ XCPHASE, XCPHASE_PBL, XRHODJ, &
+ XTKET,XRUS, XRVS, XRWS )
+ZRUS=XRUS-ZRUS
+ZRVS=XRVS-ZRVS
+ZRWS=XRWS-ZRWS
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RAD_BOUND = XT_RAD_BOUND + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. PRESSURE COMPUTATION
+! --------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZPABST = XPABST
+!
+IF(.NOT. L1D) THEN
+!
+CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ XRUS_PRES = XRUS
+ XRVS_PRES = XRVS
+ XRWS_PRES = XRWS
+!
+ CALL PRESSUREZ( CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, &
+ XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, &
+ XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
+ NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, &
+ XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
+ XRUS, XRVS, XRWS, XPABST, &
+ XBFB,&
+ XBF_SXP2_YP1_Z) !JUAN Z_SPLITING
+!
+ XRUS_PRES = XRUS - XRUS_PRES + ZRUS
+ XRVS_PRES = XRVS - XRVS_PRES + ZRVS
+ XRWS_PRES = XRWS - XRWS_PRES + ZRWS
+ CALL MPPDB_CHECK3DM("after pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. CHEMISTRY/AEROSOLS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LUSECHEM) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
+END IF
+!
+! For inert aerosol (dust and sea salt) => aer_monitor_n
+IF ((LDUST).OR.(LSALT)) THEN
+!
+! tests to see if any cloud exists
+!
+ GCLD=.TRUE.
+ IF (GCLD .AND. NRR.LE.3 ) THEN
+ IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GCLD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+
+!
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+
+!-------------------------------------------------------------------------------
+!
+!* 20. WATER MICROPHYSICS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
+!
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' &
+ .OR. CCLOUD == "LIMA" ) THEN
+ IF ( LFORCING ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:) + XWTFRC(:,:,:)
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:)
+ END IF
+ IF (CTURB /= 'NONE' ) THEN
+ IF ( ((CCLOUD=='C2R2'.OR.CCLOUD=='KHKO').AND.LACTTKE) .OR. (CCLOUD=='LIMA'.AND.MACTTKE) ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) + (2./3. * XTKET(:,:,:))**0.5
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:)
+ ENDIF
+ ENDIF
+ ELSE
+ XWT_ACT_NUC(:,:,:) = 0.
+ END IF
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
+ XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR, XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ IF (CCLOUD /= 'REVE' ) THEN
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ( (CCLOUD(1:3) == 'ICE' .AND. LSEDIC ) .OR. &
+ ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) .AND. KSEDC ) ) THEN
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (LDEPOSC .OR. LDEPOC) XACDEP = XACDEP + XINDEP * XTSTEP
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ (CCLOUD == 'LIMA' .AND. NMOM_I.GE.1 ) ) THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. NMOM_H.GE.1)) XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+!
+! Lessivage des CCN et IFN nucléables par Slinn
+!
+ IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN
+ CALL LIMA_PRECIP_SCAVENGING( YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ CCLOUD, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), &
+ XRHODREF, XRHODJ, XZZ, XPABST, XTHT, &
+ XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP )
+!
+ XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP
+ END IF
+ END IF
+!
+! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
+! -------------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
+ XWT_ACT_NUC(:,:,:) = 0.
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, XRT, XRRS, &
+ XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, &
+ XRT, XRRS, XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) &
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. L.E.S. COMPUTATIONS
+! -------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL LES_n
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. bis MEAN_UM
+! --------------------
+!
+IF (LMEAN_FIELD) THEN
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT
+! --------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll, &
+ XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_HALO = XT_HALO + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 23. TEMPORAL SWAPPING
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
+ CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ, &
+ XRUS,XRVS,XRWS,XDRYMASSS, &
+ XRTHS,XRRS,XRTKES,XRSVS, &
+ XLSUS,XLSVS,XLSWS, &
+ XLSTHS,XLSRVS,XLSZWSS, &
+ XLBXUS,XLBXVS,XLBXWS, &
+ XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS, &
+ XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
+ XUM,XVM,XWM,XZWS, &
+ XUT,XVT,XWT,XPABST,XDRYMASST, &
+ XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
+ XLSUM,XLSVM,XLSWM, &
+ XLSTHM,XLSRVM,XLSZWSM, &
+ XLBXUM,XLBXVM,XLBXWM, &
+ XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM, &
+ XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.1 BALLOON and AIRCRAFT
+! --------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LFLYER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT, PSEA = ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT )
+ END IF
+END IF
+
+!-------------------------------------------------------------------------------
+!
+!* 24.2 STATION (observation diagnostic)
+! --------------------------------
+!
+IF ( LSTATION ) &
+ CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+!
+!---------------------------------------------------------
+!
+!* 24.3 PROFILER (observation diagnostic)
+! ---------------------------------
+!
+IF (LPROFILER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT, PSEA=ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT )
+ END IF
+END IF
+!
+IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.4 deallocation of observation diagnostics
+! ---------------------------------------
+!
+CALL END_DIAG_IN_RUN
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. STORAGE OF BUDGET FIELDS
+! ------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
+ CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
+!
+!-------------------------------------------------------------------------------
+!
+!* 27. CURRENT TIME REFRESH
+! --------------------
+!
+TDTCUR%xtime=TDTCUR%xtime + XTSTEP
+CALL DATETIME_CORRECTDATE(TDTCUR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 28. CPU ANALYSIS
+! ------------
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_START=XT_START+ZTIME2-ZEND
+!
+!
+IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN
+ OEXIT=.TRUE.
+END IF
+!
+IF (OEXIT) THEN
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
+ CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
+ CALL WRITE_STATION_n(TDIAFILE)
+ CALL WRITE_PROFILER_n(TDIAFILE)
+ call Write_les_n( tdiafile )
+#ifdef MNH_IOLFI
+ CALL MENU_DIACHRO(TDIAFILE,'END')
+#endif
+ CALL IO_File_close(TDIAFILE)
+ ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
+ CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( TDIAFILE )
+ END IF
+ !
+ CALL IO_File_close(TINIFILE)
+ IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
+!
+!* 28.1 print statistics!
+!
+ ! Set File Timing OUTPUT
+ !
+ CALL SET_ILUOUT_TIMING(TLUOUT)
+ !
+ ! Compute global time
+ !
+ CALL TIME_STAT_ll(XT_START,ZTOT)
+ !
+ CALL TIME_HEADER_ll(IMI)
+ !
+ CALL TIME_STAT_ll(XT_1WAY,ZTOT, ' ONE WAY','=')
+ CALL TIME_STAT_ll(XT_BOUND,ZTOT, ' BOUNDARIES','=')
+ CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT, ' W3D_SEND ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT, ' W3D_RECV ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT, ' W3D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT, ' W3D_WAIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT, ' W3D_ALL ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT, ' W2D_GATH ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT, ' W2D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-')
+ CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=')
+ CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=')
+ CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=')
+ CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
+ CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
+ CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
+ CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
+ CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
+ CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
+ CALL TIME_STAT_ll(XT_RELAX,ZTOT, ' RELAXATION','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PARAM,ZTOT, ' PHYS_PARAM','=')
+ CALL TIME_STAT_ll(XT_RAD,ZTOT, ' RAD = '//CRAD ,'-')
+ CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-')
+ CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-')
+ CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-')
+ ! Blaze perf
+ IF (LBLAZE) THEN
+ CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
+ CALL TIME_STAT_ll(XFIREPERF,ZTOT, ' BLAZE' ,'~')
+ CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT, ' GRAD(PHI)' ,' ')
+ CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT, ' ROS & WIND' ,' ')
+ CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT, ' PROPAGATION' ,' ')
+ CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT, ' HEAT FLUXES' ,' ')
+ END IF
+ CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
+ CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
+ CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
+ CALL TIMING_LEGEND()
+ CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
+ CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PRESS,ZTOT, ' PRESSURE ','=','F')
+ !JUAN Z_SPLITTING
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT, ' REMAP B=>FFTXZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, ' REMAP FFTXZ=>FFTYZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT, ' REMAP FTTYZ=>B' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, ' REMAP FFTYZ=>SUBZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT, ' REMAP B=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, ' REMAP SUBZ=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, ' REMAP FFTYZ-1=>FFTXZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT, ' REMAP FFTXZ-1=>B ' ,'-','F')
+ ! JUAN P1/P2
+ CALL TIME_STAT_ll(XT_CLOUD,ZTOT, ' RESOLVED_CLOUD','=')
+ CALL TIME_STAT_ll(XT_ELEC,ZTOT, ' RESOLVED_ELEC','=')
+ CALL TIME_STAT_ll(XT_HALO,ZTOT, ' EXCHANGE_HALO','=')
+ CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT, ' ENDSTEP','=')
+ CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
+ CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
+ CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
+ !
+ ! sum of call subroutine
+ !
+ ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
+ XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
+ XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
+ XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
+ XT_STEP_MISC+ XT_STEP_BUD
+ CALL TIME_STAT_ll(ZALL,ZTOT, ' SUM(CALL)','=')
+ CALL TIMING_SEPARATOR('=')
+ !
+ ! Gobale Stat
+ !
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*)
+ CALL TIMING_LEGEND()
+ !
+ ! MODELN all included
+ !
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ WRITE(YMI,FMT="(I0)") IMI
+ CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ !
+ ! Timing/ Steps
+ !
+ ZTIME_STEP = XT_START / REAL(KTCOUNT)
+ WRITE(YTCOUNT,FMT="(I0)") KTCOUNT
+ CALL TIME_STAT_ll(ZTIME_STEP,ZTOT, ' SECOND/STEP='//YTCOUNT,'=')
+ !
+ ! Timing/Step/Points
+ !
+ IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX
+ WRITE(YPOINTS,FMT="(I0)") IPOINTS
+ ZTIME_STEP_PTS = ZTIME_STEP / REAL(IPOINTS) * 1e6
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT)
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT, ' MICROSEC/STP/PT='//YPOINTS,'-')
+ !
+ CALL TIMING_SEPARATOR('=')
+ !
+END IF
+!
+END SUBROUTINE MODEL_n
diff --git a/src/mesonh/ext/radiations.f90 b/src/mesonh/ext/radiations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ce3ff7dd8565c819745b9051509849eeee27520
--- /dev/null
+++ b/src/mesonh/ext/radiations.f90
@@ -0,0 +1,3504 @@
+!MNH_LIC Copyright 1995-2022 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_RADIATIONS
+! ########################
+!
+CONTAINS
+!
+! ############################################################################
+ SUBROUTINE RADIATIONS (TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
+ KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
+ PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
+ KSWB_MNH,KLWB_MNH, KSTATM,KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL, &
+ PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM, &
+ PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT, &
+ PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ, &
+ PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW )
+! ############################################################################
+!
+!!**** *RADIATIONS * - routine to call the SW and LW radiation calculations
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to prepare the temperature, water vapor
+!! liquid water, cloud fraction, ozone profiles for the ECMWF radiation
+!! calculations. There is a great number of available radiative fluxes in
+!! the output, but only the potential temperature radiative tendency and the
+!! SW and LW surface fluxes are provided in the output of the routine.
+!! Two simplified computations are available (switches OCLEAR_SKY and
+!! OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
+!! for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
+!! the clear sky columns are averaged and the computations are made for
+!! the cloudy columns plus a single ensemble-mean clear sky column.
+!!
+!!** METHOD
+!! ------
+!! First the temperature, water vapor, liquid water, cloud fraction
+!! and profile arrays are built using the current model fields and
+!! the standard atmosphere for the upper layer filling.
+!! The standard atmosphere is used between the levels IKUP and
+!! KFLEV where KFLEV is the number of vertical levels for the radiation
+!! computations.
+!! The aerosols optical thickness and the ozone fields come directly
+!! from ini_radiation step (climatlogies used) and are already defined for KFLEV.
+!! Surface parameter ( albedo, emiss ) are also defined from current surface fields.
+!! In the case of clear-sky or cloud-only approximations, the cloudy
+!! columns are selected by testing the vertically integrated cloud fraction
+!! and the radiation computations are performed for these columns plus the
+!! mean clear-sky one. In addition, columns where cloud have disapeared are determined
+!! by saving cloud trace between radiation step and they are also recalculated
+!! in cloud only step. In all case, the sun position correponds to the centered
+!! time between 2 full radiation steps (determined in physparam).
+!! Then the ECMWF radiation package is called and the radiative
+!! heating/cooling tendancies are reformatted in case of partial
+!! computations. In case of "cloud-only approximation" the only cloudy
+!! column radiative fields are updated.
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : constants
+!! XP00 : reference pressure
+!! XCPD : calorific capacity of dry air at constant pressure
+!! XRD : gas constant for dry air
+!! Module MODD_PARAMETERS : parameters
+!! JPHEXT : Extra columns on the horizontal boundaries
+!! JPVEXT : Extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine RADIATIONS )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/02/95
+!! J.Stein 20/12/95 add the array splitting in order to save memory
+!! J.-P. Pinty 19/11/96 change the split arrays, specific humidity
+!! and add the ice phase
+!! J.Stein 22/06/97 use of the absolute pressure
+!! P.Jabouille 31/07/97 impose a zero humidity for dry simulation
+!! V.Masson 22/09/97 case of clear-sky approx. with no clear-sky column
+!! V.Masson 07/11/97 half level pressure defined from averaged Exner
+!! function
+!! V.Masson 07/11/97 modification of junction between standard atm
+!! and model for half level variables (top model
+!! pressure and temperatures are used preferentially
+!! to atm standard profile for the first point).
+!! P.Jabouille 24/08/98 impose positivity for ZQLAVE
+!! J.-P. Pinty 29/01/98 add storage for diagnostics
+!! J. Stein 18/07/99 add the ORAD_DIAG switch and keep inside the
+!! subroutine the partial tendencies
+!!
+!! F.Solmon 04/03/01 MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
+!! P.Jabouille 05/05/03 bug in humidity conversion
+!! Y.Seity 25/08/03 KSWB=6 for SW direct and scattered surface
+!! downward fluxes used in surface scheme.
+!! P. Tulet 01/20/05 climatologic SSA
+!! A. Grini 05/20/05 dust direct effect (optical properties)
+!! V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
+!! B.Aouizerats 2010 Explicit aerosol optical properties
+!! C.Lac 11/2015 Correction on aerosols
+!! B.Vie /13 LIMA
+!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
+!! J.Escobar 29/06/2017 : Check if Pressure Decreasing with height <-> elsif PB & STOP
+!! Q.LIBOIS 06/2017 : correction on CLOUD_ONLY
+!! Q.Libois 02/2018 : ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
+!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
+!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 06/09/2022: small fix: GSURF_CLOUD was not set outside of physical domain
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY: JPRB
+USE OYOESW , ONLY : RTAUA ,RPIZA ,RCGA
+!
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_CST
+USE MODD_DUST, ONLY: LDUST
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_GRID , ONLY: XLAT0, XLON0
+USE MODD_GRID_n , ONLY: XLAT, XLON
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
+ NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
+ NSV_DSTBEG, NSV_DSTEND, &
+ NSV_AERBEG, NSV_AEREND, &
+ NSV_SLTBEG, NSV_SLTEND, &
+ NSV_LIMA,NSV_LIMA_BEG,NSV_LIMA_END, &
+ NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+USE MODD_PARAM_RAD_n, ONLY: CAOP
+USE MODD_RAIN_ICE_DESCR
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TIME
+!
+USE MODE_DUSTOPT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+use mode_msg
+USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+USE MODE_SALTOPT
+USE MODE_SUM_ll, ONLY: MIN_ll
+USE MODE_SUM2_ll, ONLY: GMINLOC_ll
+USE MODE_THERMO
+!
+USE MODI_AEROOPT_GET
+USE MODI_ECMWF_RADIATION_VERS2
+USE MODI_ECRAD_INTERFACE
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
+ ! computations only
+LOGICAL, INTENT(IN) :: OCLEAR_SKY !
+INTEGER, INTENT(IN) :: KDLON ! number of columns where the
+ ! radiation calculations are
+ ! performed
+INTEGER, INTENT(IN) :: KFLEV ! number of vertical levels
+ ! where the radiation
+ ! calculations are performed
+INTEGER, INTENT(IN) :: KRAD_DIAG ! index for the number of
+ ! fields in the output
+INTEGER, INTENT(IN) :: KFLUX ! number of top and ground
+ ! fluxes for the ZFLUX array
+INTEGER, INTENT(IN) :: KRAD ! number of satellite radiances
+ ! for the ZRAD and ZRADCS arrays
+INTEGER, INTENT(IN) :: KAER ! number of AERosol classes
+
+INTEGER, INTENT(IN) :: KSWB_OLD ! number of SW band ECMWF
+INTEGER, INTENT(IN) :: KSWB_MNH ! number of SW band ECRAD
+INTEGER, INTENT(IN) :: KLWB_MNH ! number of LW band ECRAD
+INTEGER, INTENT(IN) :: KSTATM ! index of the standard
+ ! atmosphere level just above
+ ! the model top
+INTEGER, INTENT(IN) :: KRAD_COLNBR ! factor by which the memory
+ ! is split
+ !
+ !Choice of :
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADL !
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADI !
+CHARACTER (LEN=*), INTENT (IN) :: HOPWSW !cloud water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPISW !ice water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPWLW !cloud water LW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPILW !ice water LW optical properties
+REAL, INTENT(IN) :: PFUDG ! subgrid cloud inhomogenity factor
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
+REAL, INTENT(IN) :: PCORSOL ! SOLar constant CORrection
+REAL, DIMENSION(:,:), INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMIS ! Surface IR EMISsivity
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! CLouD FRaction
+REAL, INTENT(IN) :: PCCO2 ! CO2 content
+REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! RADiative Surface Temperature
+REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM ! selected standard atmosphere
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! THeta at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at t (humidity, cloud water, rain water, ice water)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! scalar variable ( C2R2 and C1R3 particle)
+!
+REAL, DIMENSION(:,:,:), POINTER :: POZON ! OZONE field from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER ! AERosols optical thickness from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PDST_WL ! AERosols Extinction by wavelength .
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER_CLIM ! AERosols optical thickness from clim.
+ ! note : the vertical dimension of
+ ! these fields include the "radiation levels"
+ ! above domain top
+ !
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ![kg/m3] air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ![m] height of layers
+
+INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KCLEARCOL_TM1 ! trace of cloud/clear col
+ ! at the previous radiation step
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWU ! upward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWD ! downward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWU ! upward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWD ! downward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADSW ! dthrad sw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADLW ! dthradsw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRADEFF ! effective radius
+!
+!
+!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!
+LOGICAL :: GNOCL ! .TRUE. when no cloud is present
+ ! with OCLEAR_SKY .TRUE.
+LOGICAL :: GAOP ! .TRUE. when CAOP='EXPL'
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD ! .TRUE. for the cloudy columns
+LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT ! transpose of the GCLOUD array
+LOGICAL, DIMENSION(KDLON) :: GCLEAR_2D ! .TRUE. for the clear-sky columns
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR ! .TRUE. for all the levels of the
+ ! clear-sky columns
+LOGICAL, DIMENSION(KDLON,KSWB_MNH) :: GCLEAR_SWB! .TRUE. for all the bands of the
+ ! clear-sky columns
+INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
+!
+INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
+!
+INTEGER :: IIB ! I index value of the first inner mass point
+INTEGER :: IJB ! J index value of the first inner mass point
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IIE ! I index value of the last inner mass point
+INTEGER :: IJE ! J index value of the last inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IKU ! array size for the third index
+INTEGER :: IIJ ! reformatted array index
+INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
+INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
+ ! are filled in
+!
+INTEGER :: ICLEAR_COL ! number of clear-sky columns
+INTEGER :: ICLOUD_COL ! number of cloudy columns
+INTEGER :: ICLOUD ! number of levels corresponding of the cloudy columns
+INTEGER :: IDIM ! effective number of columns for which the radiation
+ ! code is run
+INTEGER :: INIR ! index corresponding to NIR fisrt band (in SW)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_RAD ! mean-layer temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAVE ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_RAD ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE ! saturation specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE ! Liquid water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE ! Rain water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE ! Ice water Kg/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC ! liquid water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC ! Rain water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC ! ice water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE ! mean-layer cloud fraction
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! layer pressure thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2! Rain water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3! Ice water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA! Cloud water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA! Rain water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA! Ice water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER ! aerosol optical thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP ! spectral surface albedo for direct radiations
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBD ! spectral surface albedo for diffuse radiations
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIS ! surface LW emissivity
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIW ! surface LW WINDOW emissivity
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS ! reformatted surface PTSRAD array
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM ! reformatted land sea mask
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0 ! Reformatted ZMU0 array
+REAL(KIND=JPRB) :: ZRII0 ! corrected solar constant
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW ! LW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW ! SW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW ! TOTAL LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW ! TOTAL SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and
+ ! Ground radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP ! UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW ! LW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
+ ! Ground Clear-Sky radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR !surface SW direct flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF !surface SW diffuse flux
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
+ ! PLANetary ALBedo in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
+ ! PLANetary TRANsmission in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
+ ! PLANetary ABSorption in VISible, Near-InfraRed regions
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
+ ! EFective DOWNward and UPward LW nebulosity (equivalent emissivities)
+ ! undefined if RRTM is used for LW
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP, ZFIWP
+ ! Liquid and Ice Water Path
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP, ZRADIP
+ ! Cloud liquid water and ice effective radius
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
+ ! effective LW nebulosity ( RRTM case)
+ ! and SW CLoud fraction for mixed phase clouds
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
+ ! effective optical thickness, single scattering albedo
+ ! and asymetry factor for mixed phase clouds
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
+ ! Clear-Sky DowNward and UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
+ ! Thicknes of the mesh
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ
+!
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
+REAL, DIMENSION(KDLON) :: ZZTGVIS! SW surface flux in the VIS band
+REAL, DIMENSION(KDLON) :: ZZTGNIR! SW surface flux in the NIR band
+REAL, DIMENSION(KDLON) :: ZZTGIR ! LW surface flux in the IR bands
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
+! ! SW direct surface flux
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
+! ! SW diffuse surface flux
+!
+REAL, DIMENSION(KDLON) :: ZCLOUD ! vertically summed cloud fraction
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZLWD ! surface Downward LW flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZPIZAZ ! Aerosols SSA
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZTAUAZ ! Aerosols Optical Detph
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZCGAZ ! Aerosols Asymetric factor
+REAL :: ZZTGVISC ! downward surface SW flux (VIS band) for clear_sky
+REAL :: ZZTGNIRC ! downward surface SW flux (NIR band) for clear_sky
+REAL :: ZZTGIRC ! downward surface LW flux for clear_sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
+! ! downward surface SW direct flux for clear sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
+! ! downward surface SW diffuse flux for clear sky
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZP_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
+REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
+REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
+REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
+REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
+REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR ! ensemble mean clear-sky aerosols optical thickness
+REAL, DIMENSION(KSWB_MNH) :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
+REAL, DIMENSION(KSWB_MNH) :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
+REAL :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
+REAL :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
+REAL :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
+REAL :: ZTS_CLEAR ! ensemble mean clear-sky surface temperature.
+REAL :: ZLSM_CLEAR ! ensemble mean clear-sky land sea-mask
+REAL :: ZLAT_CLEAR,ZLON_CLEAR
+!
+!work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
+!
+! split arrays used to split the memory required by the ECMWF_radiation
+! subroutine, the fields have the same meaning as their complete counterpart
+!
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWU_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADIP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP !Single scattering albedo of aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR !Real part of the aerosol refractive index(lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP !Assymetry factor aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP !Single scattering albedo of dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP !Assymetry factor dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP !Assymetry factor aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP !Single scattering albedo of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP !Assymetry factor of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP !tau/tau_{550} of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT !tau/tau_{550} sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ !tau/tau_{550} aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ_SPLIT !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ_SPLIT !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ_SPLIT !tau/tau_{550} aerosols (points,lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZPIZA_EQ_CLEAR !Single scattering albedo of aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZCGA_EQ_CLEAR !Assymetry factor aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZTAUREL_EQ_CLEAR !tau/tau_{550} aerosols (lev,wvl)
+INTEGER :: WVL_IDX !Counter for wavelength
+
+!
+INTEGER :: JI_SPLIT ! loop on the split array
+INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
+INTEGER :: IDIM_EFF ! effective number of air-columns to compute
+INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
+INTEGER :: IBEG, IEND ! auxiliary indices
+!
+!
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_LW! LW temperature tendency
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_SW! SW temperature tendency
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM routines
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
+ :: ZSTORE_2D ! 2D work array for storage!
+INTEGER :: JBAND ! Solar band index
+CHARACTER (LEN=4), DIMENSION(KSWB_OLD) :: YBAND_NAME ! Solar band name
+CHARACTER (LEN=2) :: YDIR ! Type of the data field
+!
+INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
+INTEGER :: JSWB ! loop on SW spectral bands
+INTEGER :: JAE ! loop on aerosol class
+TYPE(TFIELDMeTaDATA) :: TZFIELD2D, TZFIELD3D
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
+REAL :: ZMINVAL
+INTEGER, DIMENSION(3) :: IMINLOC
+INTEGER :: IINFO_ll
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: GCLOUD_SURF
+!
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON,ZLAT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON_SPLIT,ZLAT_SPLIT
+!
+INTEGER :: ICLEAR_COL_ll
+INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_ICLEAR_COL
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR_DD ! ensemble mean clear-sky temperature
+REAL :: ZCLEAR_COL_ll , ZDLON_ll
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
+! ----------------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) ! this definition must be coherent with
+ ! the one used in ini_radiations routine
+IKU = SIZE(PTHT,3)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+IKSTAE = SIZE(PSTATM,1)
+IKUP = IKE-JPVEXT+1
+!
+ISWB = SIZE(PSRFSWD_DIR,3)
+!
+!-------------------------------------------------------------------------------
+!* 1.1 CHECK PRESSURE DECREASING
+! -------------------------
+ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
+ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
+!
+ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
+!
+IF ( ZMINVAL <= 0.0 ) THEN
+ ILUOUT = TLUOUT%NLU
+ IMINLOC=GMINLOC_ll( ZDZPABST )
+ WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
+ WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
+ FLUSH(unit=ILUOUT)
+ call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
+
+ENDIF
+!------------------------------------------------------------------------------
+ALLOCATE(ZLAT(KDLON))
+ALLOCATE(ZLON(KDLON))
+IF(LCARTESIAN) THEN
+ ZLAT(:) = XLAT0*(XPI/180.)
+ ZLON(:) = XLON0*(XPI/180.)
+ELSE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLAT(IIJ) = XLAT(JI,JJ)*(XPI/180.)
+ ZLON(IIJ) = XLON(JI,JJ)*(XPI/180.)
+ END DO
+ END DO
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
+! ------------------------------------
+!
+ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Columns where radiation is computed are put on a single line
+ALLOCATE(ZTAVE(KDLON,KFLEV))
+ALLOCATE(ZQVAVE(KDLON,KFLEV))
+ALLOCATE(ZQLAVE(KDLON,KFLEV))
+ALLOCATE(ZQIAVE(KDLON,KFLEV))
+ALLOCATE(ZCFAVE(KDLON,KFLEV))
+ALLOCATE(ZQRAVE(KDLON,KFLEV))
+ALLOCATE(ZQLWC(KDLON,KFLEV))
+ALLOCATE(ZQIWC(KDLON,KFLEV))
+ALLOCATE(ZQRWC(KDLON,KFLEV))
+ALLOCATE(ZDZ(KDLON,KFLEV))
+!
+ZQVAVE(:,:) = 0.0
+ZQLAVE(:,:) = 0.0
+ZQIAVE(:,:) = 0.0
+ZQRAVE(:,:) = 0.0
+ZCFAVE(:,:) = 0.0
+ZQLWC(:,:) = 0.0
+ZQIWC(:,:) = 0.0
+ZQRWC(:,:) = 0.0
+ZDZ(:,:)=0.0
+!
+!COMPUTE THE MESH SIZE
+DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDZ(IIJ,JKRAD) = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK) ! Conversion potential temperature -> actual temperature
+ END DO
+ END DO
+END DO
+!
+! Check if the humidity mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
+ ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
+ ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the rainwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
+ ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudice mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
+! ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
+ ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4),0.0 )
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Standard atmosphere extension
+!
+DO JK=IKUP,KFLEV
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ JK2 = JK1+1
+ ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
+ ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+ &
+ PSTATM(JK2,5)/PSTATM(JK2,4) )
+END DO
+!
+! 2.1 pronostic water concentation fields (C2R2 coupling)
+!
+IF( NSV_C2R2 /= 0 ) THEN
+ ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
+ ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
+ ZCCT_C2R2(:, :) = 0.
+ ZCRT_C2R2 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
+ ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCCT_C2R2(0,0))
+ ALLOCATE (ZCRT_C2R2(0,0))
+END IF
+!
+IF( NSV_C1R3 /= 0 ) THEN
+ ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
+ ZCIT_C1R3 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCIT_C1R3(0,0))
+END IF
+!
+!
+! 2.1*bis pronostic water concentation fields (LIMA coupling)
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCRT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCIT_LIMA(KDLON, KFLEV))
+ ZCCT_LIMA(:, :) = 0.
+ ZCRT_LIMA (:,:) = 0.
+ ZCIT_LIMA (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ IF (NMOM_C.GE.2) ZCCT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NC))
+ IF (NMOM_R.GE.2) ZCRT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NR))
+ IF (NMOM_I.GE.2) ZCIT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NI))
+ END DO
+ END DO
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZES THE HALF-LEVEL VARIABLES
+! ------------------------------------
+!
+ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
+ALLOCATE(ZT_HL(KDLON,KFLEV+1))
+!
+DO JK=IKB,IKE+1
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
+ END DO
+ END DO
+END DO
+
+! Standard atmosphere extension - pressure
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0 ! mb -> Pa
+END DO
+!
+! Surface temperature at the first level
+! and surface radiative temperature
+ALLOCATE(ZTS(KDLON))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
+ ZTS(IIJ) = PTSRAD(JI,JJ)
+ END DO
+END DO
+!
+! Temperature at half levels
+!
+ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,IKE-JPVEXT+1) = 0.5*PTHT(JI,JJ,IKE )*ZEXNT(JI,JJ,IKE ) &
+ + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
+ END DO
+END DO
+!
+! Standard atmosphere extension - temperature
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZT_HL(:,JK) = PSTATM(JK1,3)
+END DO
+!
+!mean layer pressure and layer differential pressure (from half level variables)
+!
+ALLOCATE(ZPAVE(KDLON,KFLEV))
+ALLOCATE(ZDPRES(KDLON,KFLEV))
+DO JKRAD=1,KFLEV
+ ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
+ ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
+END DO
+!-----------------------------------------------------------------------
+!* 4. INITIALIZES THE AEROSOLS and OZONE PROFILES from climatology
+! -------------------------------------------
+!
+! 4.1 AEROSOL optical thickness
+! EXPL -> defined online, otherwise climatology
+IF (CAOP=='EXPL') THEN
+ GAOP = .TRUE.
+ELSE
+ GAOP = .FALSE.
+ENDIF
+!
+IF (CAOP=='EXPL') THEN
+ ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+
+ ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+
+ ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+ ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+
+ ZPIZA_EQ_TMP = 0.
+ ZCGA_EQ_TMP = 0.
+ ZTAUREL_EQ_TMP = 0.
+
+ ZPIZA_DST_TMP = 0.
+ ZCGA_DST_TMP = 0.
+ ZTAUREL_DST_TMP = 0
+
+ ZPIZA_SLT_TMP = 0.
+ ZCGA_SLT_TMP = 0.
+ ZTAUREL_SLT_TMP = 0
+
+ ZPIZA_AER_TMP = 0.
+ ZCGA_AER_TMP = 0.
+ ZTAUREL_AER_TMP = 0
+
+ PAER_DST=0.
+ PAER_SLT=0.
+ PAER_AER=0.
+
+ IF (LORILAM) THEN
+ CALL AEROOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND) & !I [ppv] aerosols concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of aerosols
+ ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for aerosols
+ ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of aerosols at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ ,ZIR(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,ZII(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ )
+ ENDIF
+ IF(LDUST) THEN
+ CALL DUSTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND) & !I [ppv] Dust scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of dust
+ ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for dust
+ ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of dust at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ DO WVL_IDX=1,KSWB_OLD
+ PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)
+ ENDDO
+ ENDIF
+ IF(LSALT) THEN
+ CALL SALTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND) & !I [ppv] sea salt scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,PTHT(IIB:IIE,IJB:IJE,:) & !I [K] potential temperature
+ ,PPABST(IIB:IIE,IJB:IJE,:) & !I [hPa] pressure
+ ,PRT(IIB:IIE,IJB:IJE,:,:) & !I [kg/kg] water mixing ratio
+ ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of sea salt
+ ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for sea salt
+ ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of sea salt at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ ENDIF
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
+
+ PAER(:,:,:,2)=PAER_SLT(:,:,:)
+ PAER(:,:,:,3)=PAER_DST(:,:,:)
+ PAER(:,:,:,4)=PAER_AER(:,:,:)
+
+
+ WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
+ ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
+ ZTAUREL_EQ_TMP(:,:,:,:)
+ END WHERE
+ WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
+ ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
+ (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
+ END WHERE
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
+ ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
+ ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
+ PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
+ ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
+
+
+ENDIF
+!
+! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
+ZTAUAZ(:,:,:,:) = 0.
+ZPIZAZ(:,:,:,:) = 0.
+ZCGAZ(:,:,:,:) = 0.
+DO WVL_IDX=1,KSWB_OLD
+ DO JAE=1,KAER
+ !Special optical properties for dust
+ IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
+ !Ponderation of aerosol optical in case of explicit optical factor
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ ELSE
+
+ !Ponderation of aerosol optical properties
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
+ ENDIF
+ ENDDO
+! assymetry factor:
+
+ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+! SSA:
+ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+ENDDO
+!
+
+!
+ALLOCATE(ZAER(KDLON,KFLEV,KAER))
+! Aerosol classes
+! 1=Continental 2=Maritime 3=Desert 4=Urban 5=Volcanic 6=Stratos.Bckgnd
+! Loaded from climatology
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,:) = PAER_CLIM (JI,JJ,:,:)
+ END DO
+END DO
+IF ((CAOP=='EXPL') .AND. LDUST ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,3) = PAER (JI,JJ,:,3)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LSALT ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,2) = PAER (JI,JJ,:,2)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,4) = PAER (JI,JJ,:,4)
+ END DO
+ END DO
+END IF
+!
+ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB_OLD))
+IF(CAOP=='EXPL')THEN
+ !Transform from vector of type #lon #lat #lev #wvl
+ !to vectors of type #points, #levs, #wavelengths
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
+ ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
+ ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
+ END DO
+ END DO
+ DEALLOCATE(ZPIZA_EQ_TMP)
+ DEALLOCATE(ZCGA_EQ_TMP)
+ DEALLOCATE(ZTAUREL_EQ_TMP)
+ DEALLOCATE(ZPIZA_DST_TMP)
+ DEALLOCATE(ZCGA_DST_TMP)
+ DEALLOCATE(ZTAUREL_DST_TMP)
+ DEALLOCATE(ZPIZA_AER_TMP)
+ DEALLOCATE(ZCGA_AER_TMP)
+ DEALLOCATE(ZTAUREL_AER_TMP)
+ DEALLOCATE(ZPIZA_SLT_TMP)
+ DEALLOCATE(ZCGA_SLT_TMP)
+ DEALLOCATE(ZTAUREL_SLT_TMP)
+ DEALLOCATE(PAER_DST)
+ DEALLOCATE(PAER_AER)
+ DEALLOCATE(PAER_SLT)
+ DEALLOCATE(ZIR)
+ DEALLOCATE(ZII)
+END IF
+
+
+!
+! 4.2 OZONE content
+!
+ALLOCATE(ZO3AVE(KDLON,KFLEV))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
+ END DO
+END DO
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+POZON = POZON
+#endif
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CALLS THE E.C.M.W.F. RADIATION CODE
+! -----------------------------------
+!
+!
+!* 5.1 INITIALIZES 2D AND SURFACE FIELDS
+!
+ALLOCATE(ZRMU0(KDLON))
+ALLOCATE(ZLSM(KDLON))
+!
+ALLOCATE(ZALBP(KDLON,KSWB_MNH))
+ALLOCATE(ZALBD(KDLON,KSWB_MNH))
+!
+ALLOCATE(ZEMIS(KDLON,KLWB_MNH))
+ALLOCATE(ZEMIW(KDLON,KLWB_MNH))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZEMIS(IIJ,:) = PEMIS(JI,JJ,:)
+ ZRMU0(IIJ) = PCOSZEN(JI,JJ)
+ ZLSM(IIJ) = 1.0 - PSEA(JI,JJ)
+ END DO
+END DO
+!
+! spectral albedo
+!
+IF ( SIZE(PDIR_ALB,3)==1 ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,:) = PDIR_ALB(JI,JJ,1)
+ ZALBD(IIJ,:) = PSCA_ALB(JI,JJ,1)
+ !
+ END DO
+ END DO
+ELSE
+ DO JK=1, SIZE(PDIR_ALB,3)
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,JK) = PDIR_ALB(JI,JJ,JK)
+ ZALBD(IIJ,JK) = PSCA_ALB(JI,JJ,JK)
+ ENDDO
+ END DO
+ ENDDO
+END IF
+!
+!
+! LW emissivity
+ZEMIW(:,:)= ZEMIS(:,:)
+!
+!solar constant
+ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
+!
+!
+!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
+!
+! Performs the horizontal average of the fields when no cloud
+!
+ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 ) ! one where no cloud on the vertical
+!
+! MODIF option CLLY
+ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
+ END DO
+END DO
+!
+IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
+ !
+ GCLEAR_2D(:) = .TRUE.
+ WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) ) ! FALSE on cloudy columns
+ GCLEAR_2D(:) = .FALSE.
+ END WHERE
+ !
+ ICLEAR_COL = COUNT( GCLEAR_2D(:) ) ! number of clear sky columns
+ !
+ ALLOCATE(INDEX_ICLEAR_COL(ICLEAR_COL))
+ IIJ = 0
+ DO JI=1,KDLON
+ IF ( GCLEAR_2D(JI) ) THEN
+ IIJ = IIJ + 1
+ INDEX_ICLEAR_COL(IIJ) = JI
+ END IF
+ END DO
+
+ IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
+!!$ GCLEAR_2D(1) = .FALSE. ! column is selected
+!!$ ICLEAR_COL = KDLON-1
+ GNOCL = .TRUE. ! TRUE if no cloud at all
+ ELSE
+ GNOCL = .FALSE.
+ END IF
+
+ GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV ) ! vertical extension of clear columns 2D map
+ ICLOUD_COL = KDLON - ICLEAR_COL ! number of cloudy columns
+!
+ ZCLEAR_COL_ll = REAL(ICLEAR_COL)
+ CALL REDUCESUM_ll(ZCLEAR_COL_ll,IINFO_ll)
+ !ZDLON_ll = KDLON
+ !CALL REDUCESUM_ll(ZDLON_ll,IINFO_ll)
+
+ !IF (IP == 1 )
+ !print*,",RADIATIOn COULD_ONLY=OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDON,ZDLON_ll,GNOCL=", &
+ ! OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDLON,ZDLON_ll,GNOCL
+!
+!!$ IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ IF( ZCLEAR_COL_ll /= 0.0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ ZT_CLEAR(:) = SUM_DD_R2_R1_ll(ZTAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZP_CLEAR(:) = SUM_DD_R2_R1_ll(ZPAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZQV_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZQVAVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZOZ_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZO3AVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZDP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZDPRES(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+
+ DO JK1=1,KAER
+ ZAER_CLEAR(:,JK1) = SUM_DD_R2_R1_ll(REAL(ZAER(INDEX_ICLEAR_COL(:),:,JK1))) / ZCLEAR_COL_ll
+ END DO
+ !Get an average value for the clear column
+ IF(CAOP=='EXPL')THEN
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZPIZA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZCGA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZTAUREL_EQ(INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ENDDO
+ ENDIF
+ !
+ ZHP_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZPRES_HL(INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ ZHT_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZT_HL (INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ !
+ ZALBP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBP(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZALBD_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBD(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ !
+ ZEMIS_CLEAR = SUM_DD_R1_ll(REAL(ZEMIS(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZEMIW_CLEAR = SUM_DD_R1_ll(REAL(ZEMIW(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZRMU0_CLEAR = SUM_DD_R1_ll(REAL(ZRMU0(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZTS_CLEAR = SUM_DD_R1_ll(REAL(ZTS(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLSM_CLEAR = SUM_DD_R1_ll(REAL(ZLSM(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLAT_CLEAR = SUM_DD_R1_ll(REAL(ZLAT(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLON_CLEAR = SUM_DD_R1_ll(REAL(ZLON(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+!
+ ELSE ! no clear columns -> the first column is chosen, without physical meaning: it will not be
+ ! unpacked after the call to the radiation ecmwf routine
+ ZT_CLEAR(:) = ZTAVE(1,:)
+ ZP_CLEAR(:) = ZPAVE(1,:)
+ ZQV_CLEAR(:) = ZQVAVE(1,:)
+ ZOZ_CLEAR(:) = ZO3AVE(1,:)
+ ZDP_CLEAR(:) = ZDPRES(1,:)
+ ZAER_CLEAR(:,:) = ZAER(1,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
+ ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
+ ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
+ ENDIF
+!
+ ZHP_CLEAR(1:KFLEV) = ZPRES_HL(1,1:KFLEV)
+ ZHT_CLEAR(1:KFLEV) = ZT_HL(1,1:KFLEV)
+ ZALBP_CLEAR(:) = ZALBP(1,:)
+ ZALBD_CLEAR(:) = ZALBD(1,:)
+!
+ ZEMIS_CLEAR = ZEMIS(1,1)
+ ZEMIW_CLEAR = ZEMIW(1,1)
+ ZRMU0_CLEAR = ZRMU0(1)
+ ZTS_CLEAR = ZTS(1)
+ ZLSM_CLEAR = ZLSM(1)
+ ZLAT_CLEAR = ZLAT(1)
+ ZLON_CLEAR = ZLON(1)
+ END IF
+ !
+ GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
+ GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
+ ICLOUD = ICLOUD_COL*KFLEV ! total number of voxels in cloudy columns
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ! the ICLOUD cloudy columns
+ ! and of the KFLEV levels of the clear sky one
+ !
+ ! temperature profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZTAVE)
+ ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
+ ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! vapor mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZQVAVE)
+ ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
+ ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! mesh size
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZDZ)
+ ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
+ ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLAVE)
+ ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
+ ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRAVE)
+ ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
+ ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIAVE)
+ ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
+ ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLWC)
+ ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
+ ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRWC)
+ ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
+ ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIWC)
+ ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
+ ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! cloud fraction profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCFAVE)
+ ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
+ ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! C2R2 water particle concentration
+ !
+ IF ( SIZE(ZCCT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_C2R2)
+ ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCRT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_C2R2)
+ ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCIT_C1R3) > 0) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_C1R3)
+ ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
+ ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! LIMA water particle concentration
+ !
+ IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_LIMA)
+ ALLOCATE(ZCCT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCCT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_LIMA)
+ ALLOCATE(ZCRT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCRT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_LIMA)
+ ALLOCATE(ZCIT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCIT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! ozone content profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZO3AVE)
+ ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
+ ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPAVE)
+ ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
+ ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !pressure thickness
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZDPRES)
+ ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
+ ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !aerosols
+ !
+ ALLOCATE(ZWORK1AER(ICLOUD,KAER))
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
+ DO JK=1,KAER
+ ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
+ ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
+ END DO
+ DEALLOCATE(ZAER)
+ ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
+ DO JK=1,KAER
+ ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
+ END DO
+ DEALLOCATE (ZWORK1AER)
+ DEALLOCATE (ZWORK2AER)
+ !
+ IF(CAOP=='EXPL')THEN
+ ALLOCATE(ZWORK1AER(ICLOUD,KSWB_OLD)) !New vector with value for all cld. points
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB_OLD)) !New vector with value for all cld.points + 1 clr column
+ !Single scattering albedo
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDDO
+ !Assymetry factor
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ !Relative wavelength-distributed optical depth
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ DEALLOCATE(ZWORK1AER)
+ DEALLOCATE(ZWORK2AER)
+ ELSE
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ ENDIF !Check on LDUST
+
+ ! half-level variables
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPRES_HL)
+ ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
+ ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZT_HL)
+ ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
+ ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
+ !
+ ! surface fields
+ !
+ ALLOCATE(ZWORK3(ICLOUD_COL))
+ ALLOCATE(ZWORK4(ICLOUD_COL,KSWB_MNH))
+ ALLOCATE(ZWORK(KDLON))
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBP(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBP)
+ ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB_MNH))
+ ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
+ !
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBD(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBD)
+ ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB_MNH))
+ ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)
+ !
+ DEALLOCATE(ZWORK4)
+ !
+ ZWORK3(:) = PACK( ZEMIS(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIS)
+ ALLOCATE(ZEMIS(ICLOUD_COL+1,1))
+ ZEMIS(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIS(ICLOUD_COL+1,1) = ZEMIS_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZEMIW(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIW)
+ ALLOCATE(ZEMIW(ICLOUD_COL+1,1))
+ ZEMIW(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIW(ICLOUD_COL+1,1) = ZEMIW_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZRMU0)
+ ALLOCATE(ZRMU0(ICLOUD_COL+1))
+ ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLSM)
+ ALLOCATE(ZLSM(ICLOUD_COL+1))
+ ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLAT(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLAT)
+ ALLOCATE(ZLAT(ICLOUD_COL+1))
+ ZLAT(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLAT (ICLOUD_COL+1)= ZLAT_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLON(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLON)
+ ALLOCATE(ZLON(ICLOUD_COL+1))
+ ZLON(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLON (ICLOUD_COL+1)= ZLON_CLEAR
+ !
+ ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZTS)
+ ALLOCATE(ZTS(ICLOUD_COL+1))
+ ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZTS(ICLOUD_COL+1) = ZTS_CLEAR
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK3)
+ DEALLOCATE(ZWORK)
+ !
+ IDIM = ICLOUD_COL +1 ! Number of columns where RT is computed
+!
+ELSE
+ !
+ !* 5.3 RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
+ !
+ IDIM = KDLON
+END IF
+!
+! initialisation of cloud trace for the next radiation time step
+! (if unchanged columns are not recomputed)
+WHERE ( ZCLOUD(:) <= 0.0 )
+ ICLEAR_2D_TM1(:) = 1
+ELSEWHERE
+ ICLEAR_2D_TM1(:) = 0
+END WHERE
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ) ! output to be saved for next time step
+ END DO
+END DO
+!
+!
+!* 5.4 VERTICAL grid modification(up-down) for compatibility with ECMWF
+! radiation vertical grid. ALLOCATION of the outputs.
+!
+!
+ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
+!
+!half level pressure
+ZWORK_GRID(:,:)=ZPRES_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
+END DO
+!
+!half level temperature
+ZWORK_GRID(:,:)=ZT_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer variables
+!-------------------------------------
+ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
+!
+!mean layer temperature
+ZWORK_GRID(:,:)=ZTAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure
+ZWORK_GRID(:,:)=ZPAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure thickness
+ZWORK_GRID(:,:)=ZDPRES(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mesh size
+ZWORK_GRID(:,:)=ZDZ(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+!mean layer cloud fraction
+ZWORK_GRID(:,:)=ZCFAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer water vapor mixing ratio
+ZWORK_GRID(:,:)=ZQVAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice
+ZWORK_GRID(:,:)=ZQIAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water
+ZWORK_GRID(:,:)=ZQLAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water
+ZWORK_GRID(:,:)=ZQRAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice water content
+ZWORK_GRID(:,:)=ZQIWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water content
+ZWORK_GRID(:,:)=ZQLWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water content
+ZWORK_GRID(:,:)=ZQRWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!C2R2 water particle concentration
+!
+IF (SIZE(ZCCT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCRT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCIT_C1R3) > 0) THEN
+ ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!LIMA water particle concentration
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK_GRID(:,:)=ZCCT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCRT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCIT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!ozone content
+ZWORK_GRID(:,:)=ZO3AVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!aerosol optical depth
+DO JI=1,KAER
+ ZWORK_GRID(:,:)=ZAER(:,:,JI)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ END DO
+END DO
+IF (CAOP=='EXPL') THEN
+!TURN MORE FIELDS UPSIDE DOWN...
+!Dust single scattering albedo
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+!Dust asymmetry factor
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+
+END IF
+
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer saturation specific humidity
+!
+ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+!
+WHERE (ZTAVE(:,:) > XTT)
+ ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
+ELSEWHERE
+ ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
+END WHERE
+!
+! allocations for the radiation code outputs
+!
+ALLOCATE(ZDTLW(IDIM,KFLEV))
+ALLOCATE(ZDTSW(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
+ALLOCATE(ZSFSWDIR(IDIM,ISWB))
+ALLOCATE(ZSFSWDIF(IDIM,ISWB))
+ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
+ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
+!
+!
+ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
+ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
+ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
+ALLOCATE(ZRADLP(IDIM,KFLEV))
+IF( KRAD_DIAG >= 1) THEN
+ ALLOCATE(ZNFLW(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZNFLW(0,0))
+ ALLOCATE(ZNFSW(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
+ ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
+ ALLOCATE(ZFLUX_SW_UP_CS(0,0))
+ ALLOCATE(ZFLUX_LW_CS(0,0,0))
+ ALLOCATE(ZNFSW_CS(0,0))
+ ALLOCATE(ZNFLW_CS(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE(ZPLAN_ALB_VIS(IDIM))
+ ALLOCATE(ZPLAN_ALB_NIR(IDIM))
+ ALLOCATE(ZPLAN_TRA_VIS(IDIM))
+ ALLOCATE(ZPLAN_TRA_NIR(IDIM))
+ ALLOCATE(ZPLAN_ABS_VIS(IDIM))
+ ALLOCATE(ZPLAN_ABS_NIR(IDIM))
+ELSE
+ ALLOCATE(ZPLAN_ALB_VIS(0))
+ ALLOCATE(ZPLAN_ALB_NIR(0))
+ ALLOCATE(ZPLAN_TRA_VIS(0))
+ ALLOCATE(ZPLAN_TRA_NIR(0))
+ ALLOCATE(ZPLAN_ABS_VIS(0))
+ ALLOCATE(ZPLAN_ABS_NIR(0))
+END IF
+!
+IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
+ ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
+ ALLOCATE(ZTAU_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZCG_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
+ ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
+ ALLOCATE(ZFLWP(IDIM,KFLEV))
+ ALLOCATE(ZFIWP(IDIM,KFLEV))
+ ALLOCATE(ZRADIP(IDIM,KFLEV))
+ELSE
+ ALLOCATE(ZEFCL_RRTM(0,0))
+ ALLOCATE(ZCLSW_TOTAL(0,0))
+ ALLOCATE(ZTAU_TOTAL(0,0,0))
+ ALLOCATE(ZOMEGA_TOTAL(0,0,0))
+ ALLOCATE(ZCG_TOTAL(0,0,0))
+ ALLOCATE(ZEFCL_LWD(0,0))
+ ALLOCATE(ZEFCL_LWU(0,0))
+ ALLOCATE(ZFLWP(0,0))
+ ALLOCATE(ZFIWP(0,0))
+ ALLOCATE(ZRADIP(0,0))
+END IF
+!
+!* 5.6 CALLS THE ECMWF_RADIATION ROUTINES
+!
+! mixing ratio -> specific humidity conversion (for ECMWF routine)
+! mixing ratio = mv/md ; specific humidity = mv/(mv+md)
+
+ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:)) ! Because
+! ZAER = 1e-5*ZAER
+! ZO3AVE = 1e-5*ZO3AVE!
+IF( IDIM <= KRAD_COLNBR ) THEN
+!
+! there is less than KRAD_COLNBR columns to be considered therefore
+! no split of the arrays is performed
+! Note that radiation scheme only takes scalar emissivities so only fist value of the spectral emissivity is taken
+ ALLOCATE(ZTAVE_RAD(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+ ALLOCATE(ZPAVE_RAD(SIZE(ZPAVE,1),SIZE(ZPAVE,2)))
+ ZTAVE_RAD = ZTAVE
+ ZPAVE_RAD = ZPAVE
+ IF (CCLOUD == 'LIMA') THEN
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ,ZLAT,ZLON )
+ ENDIF
+
+ ELSE
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ ,ZLAT,ZLON )
+ END IF
+
+
+ END IF
+ DEALLOCATE(ZTAVE_RAD,ZPAVE_RAD)
+!
+ELSE
+!
+! the splitting of the arrays will be performed
+!
+ INUM_CALL = CEILING( REAL( IDIM ) / REAL( KRAD_COLNBR ) )
+ IDIM_RESIDUE = IDIM
+!
+ DO JI_SPLIT = 1 , INUM_CALL
+ IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
+ !
+ IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN
+ ALLOCATE( ZALBP_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZALBD_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZEMIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZEMIW_SPLIT(IDIM_EFF))
+ ALLOCATE( ZRMU0_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLAT_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLON_SPLIT(IDIM_EFF))
+ ALLOCATE( ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZDZ_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZPAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
+ ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZDPRES_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZLSM_SPLIT(IDIM_EFF))
+ ALLOCATE( ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTS_SPLIT(IDIM_EFF))
+ ! output pronostic
+ ALLOCATE( ZDTLW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
+ ALLOCATE( ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
+!
+ ALLOCATE( ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZRADLP_SPLIT(IDIM_EFF,KFLEV))
+ IF(KRAD_DIAG >=1) THEN
+ ALLOCATE( ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZNFSW_SPLIT(0,0))
+ ALLOCATE( ZNFLW_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(0,0,0))
+ ALLOCATE( ZNFSW_CS_SPLIT(0,0))
+ ALLOCATE( ZNFLW_CS_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
+ ELSE
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(0))
+ END IF
+!
+ IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE( ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFIWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZRADIP_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE( ZEFCL_RRTM_SPLIT(0,0))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(0,0))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZCG_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZEFCL_LWD_SPLIT(0,0))
+ ALLOCATE( ZEFCL_LWU_SPLIT(0,0))
+ ALLOCATE( ZFLWP_SPLIT(0,0))
+ ALLOCATE( ZFIWP_SPLIT(0,0))
+ ALLOCATE( ZRADIP_SPLIT(0,0))
+ END IF
+!
+! C2R2 coupling
+!
+ IF (SIZE (ZCCT_C2R2) > 0) THEN
+ ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCRT_C2R2) > 0) THEN
+ ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCIT_C1R3) > 0) THEN
+ ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
+ END IF
+!
+! LIMA coupling
+!
+ IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCRT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCIT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ END IF
+ END IF
+!
+! fill the split arrays with their values taken from the full arrays
+!
+ IBEG = IDIM-IDIM_RESIDUE+1
+ IEND = IBEG+IDIM_EFF-1
+!
+ ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
+ ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
+ ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND,1 )
+ ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND,1 )
+ ZRMU0_SPLIT(:) = ZRMU0 ( IBEG:IEND )
+ ZLAT_SPLIT(:) = ZLAT ( IBEG:IEND )
+ ZLON_SPLIT(:) = ZLON ( IBEG:IEND )
+ ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
+ ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
+ ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
+ ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
+ ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
+ ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
+ ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
+ ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
+ ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
+ ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
+ ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
+ ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
+ ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
+ ZPAVE_SPLIT(:,:) = ZPAVE ( IBEG:IEND ,:)
+ ZAER_SPLIT (:,:,:) = ZAER ( IBEG:IEND ,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
+ ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
+ ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
+ ENDIF
+ ZDPRES_SPLIT(:,:) = ZDPRES (IBEG:IEND ,:)
+ ZLSM_SPLIT (:) = ZLSM (IBEG:IEND)
+ ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
+ ZTS_SPLIT (:) = ZTS (IBEG:IEND)
+!
+! CALL the ECMWF radiation with the split array
+!
+ IF (CCLOUD == 'LIMA') THEN
+! LIMA concentrations
+ ZCCT_LIMA_SPLIT(:,:) = ZCCT_LIMA (IBEG:IEND ,:)
+ ZCRT_LIMA_SPLIT(:,:) = ZCRT_LIMA (IBEG:IEND ,:)
+ ZCIT_LIMA_SPLIT(:,:) = ZCIT_LIMA (IBEG:IEND ,:)
+
+ IF (CRAD == "ECMW") THEN
+!
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT,ZCRT_LIMA_SPLIT,ZCIT_LIMA_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT, &
+ ZCRT_LIMA_SPLIT, ZCIT_LIMA_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ ELSE
+! C2R2 concentrations
+ IF (SIZE (ZCCT_C2R2) > 0) ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCRT_C2R2) > 0) ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCIT_C1R3) > 0) ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT, &
+ ZCRT_C2R2_SPLIT, ZCIT_C1R3_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ END IF
+!
+! fill the full output arrays with the split arrays
+!
+ ZDTLW( IBEG:IEND ,:) = ZDTLW_SPLIT(:,:)
+ ZDTSW( IBEG:IEND ,:) = ZDTSW_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)= ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:)
+ ZSFSWDIR (IBEG:IEND,:) = ZSFSWDIR_SPLIT(:,:)
+ ZSFSWDIF (IBEG:IEND,:) = ZSFSWDIF_SPLIT(:,:)
+!
+ ZDTLW_CS( IBEG:IEND ,:) = ZDTLW_CS_SPLIT(:,:)
+ ZDTSW_CS( IBEG:IEND ,:) = ZDTSW_CS_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) = &
+ ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
+ ZFLUX_LW( IBEG:IEND ,:,:) = ZFLUX_LW_SPLIT(:,:,:)
+ ZFLUX_SW_DOWN( IBEG:IEND ,:) = ZFLUX_SW_DOWN_SPLIT(:,:)
+ ZFLUX_SW_UP( IBEG:IEND ,:) = ZFLUX_SW_UP_SPLIT(:,:)
+ ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
+ IF ( tpfile%lopened ) THEN
+ IF( KRAD_DIAG >= 1) THEN
+ ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
+ ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
+ IF( KRAD_DIAG >= 2) THEN
+ ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
+ ZFLUX_SW_UP_CS( IBEG:IEND ,:) = ZFLUX_SW_UP_CS_SPLIT(:,:)
+ ZFLUX_LW_CS( IBEG:IEND ,:,:) = ZFLUX_LW_CS_SPLIT(:,:,:)
+ ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
+ ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
+ IF( KRAD_DIAG >= 3) THEN
+ ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
+ ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
+ ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
+ ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
+ ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
+ ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)
+ IF( KRAD_DIAG >= 4) THEN
+ ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
+ ZEFCL_LWU( IBEG:IEND ,:) = ZEFCL_LWU_SPLIT(:,:)
+ ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
+ ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
+ ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
+ ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
+ ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
+ ZTAU_TOTAL( IBEG:IEND ,:,:) = ZTAU_TOTAL_SPLIT(:,:,:)
+ ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
+ ZCG_TOTAL( IBEG:IEND ,:,:) = ZCG_TOTAL_SPLIT(:,:,:)
+ END IF
+ END IF
+ END IF
+ END IF
+ END IF
+!
+ IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
+!
+! desallocation of the split arrays
+!
+ IF( JI_SPLIT >= INUM_CALL-1 ) THEN
+ DEALLOCATE( ZALBP_SPLIT )
+ DEALLOCATE( ZALBD_SPLIT )
+ DEALLOCATE( ZEMIS_SPLIT )
+ DEALLOCATE( ZEMIW_SPLIT )
+ DEALLOCATE( ZLAT_SPLIT )
+ DEALLOCATE( ZLON_SPLIT )
+ DEALLOCATE( ZRMU0_SPLIT )
+ DEALLOCATE( ZCFAVE_SPLIT )
+ DEALLOCATE( ZO3AVE_SPLIT )
+ DEALLOCATE( ZT_HL_SPLIT )
+ DEALLOCATE( ZPRES_HL_SPLIT )
+ DEALLOCATE( ZDZ_SPLIT )
+ DEALLOCATE( ZQLAVE_SPLIT )
+ DEALLOCATE( ZQIAVE_SPLIT )
+ DEALLOCATE( ZQVAVE_SPLIT )
+ DEALLOCATE( ZTAVE_SPLIT )
+ DEALLOCATE( ZPAVE_SPLIT )
+ DEALLOCATE( ZAER_SPLIT )
+ DEALLOCATE( ZDPRES_SPLIT )
+ DEALLOCATE( ZLSM_SPLIT )
+ DEALLOCATE( ZQSAVE_SPLIT )
+ DEALLOCATE( ZQRAVE_SPLIT )
+ DEALLOCATE( ZQLWC_SPLIT )
+ DEALLOCATE( ZQRWC_SPLIT )
+ DEALLOCATE( ZQIWC_SPLIT )
+ IF ( ALLOCATED( ZCCT_C2R2_SPLIT ) ) DEALLOCATE( ZCCT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCRT_C2R2_SPLIT ) ) DEALLOCATE( ZCRT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCIT_C1R3_SPLIT ) ) DEALLOCATE( ZCIT_C1R3_SPLIT )
+ IF ( ALLOCATED( ZCCT_LIMA_SPLIT ) ) DEALLOCATE( ZCCT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCRT_LIMA_SPLIT ) ) DEALLOCATE( ZCRT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCIT_LIMA_SPLIT ) ) DEALLOCATE( ZCIT_LIMA_SPLIT )
+ DEALLOCATE( ZTS_SPLIT )
+ DEALLOCATE( ZNFLW_CS_SPLIT)
+ DEALLOCATE( ZNFLW_SPLIT)
+ DEALLOCATE( ZNFSW_CS_SPLIT)
+ DEALLOCATE( ZNFSW_SPLIT)
+ DEALLOCATE(ZDTLW_SPLIT)
+ DEALLOCATE(ZDTSW_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
+ DEALLOCATE(ZSFSWDIR_SPLIT)
+ DEALLOCATE(ZSFSWDIF_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_SPLIT)
+ DEALLOCATE(ZFLUX_LW_SPLIT)
+ DEALLOCATE(ZDTLW_CS_SPLIT)
+ DEALLOCATE(ZDTSW_CS_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
+ DEALLOCATE(ZEFCL_LWD_SPLIT)
+ DEALLOCATE(ZEFCL_LWU_SPLIT)
+ DEALLOCATE(ZFLWP_SPLIT)
+ DEALLOCATE(ZRADLP_SPLIT)
+ DEALLOCATE(ZRADIP_SPLIT)
+ DEALLOCATE(ZFIWP_SPLIT)
+ DEALLOCATE(ZEFCL_RRTM_SPLIT)
+ DEALLOCATE(ZCLSW_TOTAL_SPLIT)
+ DEALLOCATE(ZTAU_TOTAL_SPLIT)
+ DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
+ DEALLOCATE(ZCG_TOTAL_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
+ DEALLOCATE(ZFLUX_LW_CS_SPLIT)
+ DEALLOCATE(ZPIZA_EQ_SPLIT)
+ DEALLOCATE(ZCGA_EQ_SPLIT)
+ DEALLOCATE(ZTAUREL_EQ_SPLIT)
+ END IF
+ END DO
+END IF
+
+!
+DEALLOCATE(ZTAVE)
+DEALLOCATE(ZPAVE)
+DEALLOCATE(ZQVAVE)
+DEALLOCATE(ZQLAVE)
+DEALLOCATE(ZDZ)
+DEALLOCATE(ZQIAVE)
+DEALLOCATE(ZCFAVE)
+DEALLOCATE(ZPRES_HL)
+DEALLOCATE(ZT_HL)
+DEALLOCATE(ZRMU0)
+DEALLOCATE(ZLSM)
+DEALLOCATE(ZQSAVE)
+DEALLOCATE(ZAER)
+DEALLOCATE(ZPIZA_EQ)
+DEALLOCATE(ZCGA_EQ)
+DEALLOCATE(ZTAUREL_EQ)
+DEALLOCATE(ZDPRES)
+DEALLOCATE(ZCCT_C2R2)
+DEALLOCATE(ZCRT_C2R2)
+DEALLOCATE(ZCIT_C1R3)
+DEALLOCATE(ZLAT)
+DEALLOCATE(ZLON)
+IF (CCLOUD == 'LIMA') THEN
+ DEALLOCATE(ZCCT_LIMA)
+ DEALLOCATE(ZCRT_LIMA)
+ DEALLOCATE(ZCIT_LIMA)
+END IF
+!
+DEALLOCATE(ZTS)
+DEALLOCATE(ZALBP)
+DEALLOCATE(ZALBD)
+DEALLOCATE(ZEMIS)
+DEALLOCATE(ZEMIW)
+DEALLOCATE(ZQRAVE)
+DEALLOCATE(ZQLWC)
+DEALLOCATE(ZQIWC)
+DEALLOCATE(ZQRWC)
+DEALLOCATE(ICLEAR_2D_TM1)
+!
+!* 5.6 UNCOMPRESSES THE OUTPUT FIELD IN CASE OF
+! CLEAR-SKY APPROXIMATION
+!
+IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ALLOCATE(ZWORK4(KFLEV,KDLON))
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
+!
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK4)
+ !
+ ZZTGVISC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
+ !
+ ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGVISC )
+ ZZTGNIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
+ !
+ ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGNIRC )
+ ZZTGIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
+ !
+ ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGIRC )
+ !
+ DO JSWB=1,ISWB
+ ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIR(:,JSWB) = UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIRC(JSWB) )
+ !
+ ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIF(:,JSWB) = UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIFC(JSWB) )
+ END DO
+!
+! No cloud case
+!
+ IF( GNOCL ) THEN
+ IF (SIZE(ZZDTLW,1)>1) THEN
+ ZZDTLW(1,:)= ZZDTLW(2,:)
+ ENDIF
+ IF (SIZE(ZZDTSW,1)>1) THEN
+ ZZDTSW(1,:)= ZZDTSW(2,:)
+ ENDIF
+ ZZTGVIS(1) = ZZTGVISC
+ ZZTGNIR(1) = ZZTGNIRC
+ ZZTGIR(1) = ZZTGIRC
+ ZZSFSWDIR(1,:) = ZZSFSWDIRC(:)
+ ZZSFSWDIF(1,:) = ZZSFSWDIFC(:)
+ END IF
+ELSE
+ ZZDTLW(:,:) = ZDTLW(:,:)
+ ZZDTSW(:,:) = ZDTSW(:,:)
+ ZZTGVIS(:) = ZFLUX_TOP_GND_IRVISNIR(:,5)
+ ZZTGNIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,6)
+ ZZTGIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,4)
+ ZZSFSWDIR(:,:) = ZSFSWDIR(:,:)
+ ZZSFSWDIF(:,:) = ZSFSWDIF(:,:)
+END IF
+!
+DEALLOCATE(ZDTLW)
+DEALLOCATE(ZDTSW)
+DEALLOCATE(ZSFSWDIR)
+DEALLOCATE(ZSFSWDIF)
+!
+!--------------------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES in 2D horizontal
+! ------------------------------------------------------------------------------
+!
+! Computes the SW and LW radiative tendencies
+! note : tendencies in K/s for MNH (from K/day)
+!
+ZDTRAD_LW(:,:,:)=0.0
+ZDTRAD_SW(:,:,:)=0.0
+DO JK=IKB,IKE
+ JKRAD= JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY ! XDAY from modd_cst (day duration in s)
+ ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY
+ END DO
+ END DO
+END DO
+!
+! Computes the downward SW and LW surface fluxes + diffuse and direct contribution
+!
+ZLWD(:,:)=0.
+ZSWDDIR(:,:,:)=0.
+ZSWDDIF(:,:,:)=0.
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLWD(JI,JJ) = ZZTGIR(IIJ)
+ ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
+ ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
+ END DO
+END DO
+!
+!final THETA_radiative tendency and surface fluxes
+!
+IF(OCLOUD_ONLY) THEN
+
+ GCLOUD_SURF(:,:) = .FALSE.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ GCLOUD_SURF(JI,JJ) = GCLOUD(IIJ,1)
+ END DO
+ END DO
+
+ ZWORKL(:,:) = GCLOUD_SURF(:,:)
+
+ DO JK = IKB,IKE
+ WHERE( ZWORKL(:,:) )
+ PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
+ ENDWHERE
+ END DO
+ !
+ WHERE( ZWORKL(:,:) )
+ PSRFLWD(:,:) = ZLWD(:,:)
+ ENDWHERE
+ DO JSWB=1,ISWB
+ WHERE( ZWORKL(:,:) )
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END WHERE
+ END DO
+ELSE
+ PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:) ! tendency in potential temperature
+ PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
+ PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
+ PSRFLWD(:,:) = ZLWD(:,:)
+ DO JSWB=1,ISWB
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END DO
+!
+!sw and lw fluxes
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD) ! in ECMWF all fluxes are upward
+ END DO
+ END DO
+ END DO
+!!!effective radius
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. STORE SOME ADDITIONNAL RADIATIVE FIELDS
+! ---------------------------------------
+!
+IF( tpfile%lopened .AND. (KRAD_DIAG >= 1) ) THEN
+ ZSTORE_3D(:,:,:) = 0.0
+ ZSTORE_3D2(:,:,:) = 0.0
+ ZSTORE_2D(:,:) = 0.0
+ !
+ TZFIELD2D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 2D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+
+ TZFIELD3D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 3D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF( KRAD_DIAG >= 1) THEN
+ !
+ ILUOUT = TLUOUT%NLU
+ WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
+ & " KRAD_DIAG=",I1,/)') KRAD_DIAG
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP'
+ TZFIELD3D%CLONGNAME = 'SWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP'
+ TZFIELD3D%CLONGNAME = 'LWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET'
+ TZFIELD3D%CLONGNAME = 'LWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET'
+ TZFIELD3D%CLONGNAME = 'SWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD'
+ TZFIELD2D%CLONGNAME = 'RADLWD'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 2) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD_CS'
+ TZFIELD2D%CLONGNAME = 'RADLWD_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 3) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ !
+ END IF
+!
+!
+ IF( KRAD_DIAG >= 4) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CLONGNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_UP'
+ TZFIELD3D%CLONGNAME = 'EFNEB_UP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FLWP'
+ TZFIELD3D%CLONGNAME = 'FLWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FLWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FIWP'
+ TZFIELD3D%CLONGNAME = 'FIWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FIWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADL'
+ TZFIELD3D%CLONGNAME = 'EFRADL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADI'
+ TZFIELD3D%CLONGNAME = 'EFRADI'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SW_NEB'
+ TZFIELD3D%CLONGNAME = 'SW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CLONGNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ ! spectral bands
+ IF (KSWB_OLD==6) THEN
+ INIR = 4
+ ELSE
+ INIR = 2
+ END IF
+
+ DO JBAND=1,INIR-1
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
+ END DO
+ DO JBAND= INIR, KSWB_OLD
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
+ END DO
+!
+ DO JBAND=1,KSWB_OLD
+ TZFIELD3D%CMNHNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZTAUAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZPIZAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZCGAZ(:,:,:,JBAND))
+ ENDDO
+
+ DO JBAND=1,KSWB_OLD
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ END DO
+ END IF
+ !
+ !
+ IF (KRAD_DIAG >= 5) THEN
+!
+! OZONE and AER optical thickness climato entering the ecmwf_radiation_vers2
+! note the vertical grid is re-inversed for graphic !
+ DO JK=IKB,IKE
+ JKRAD = KFLEV+1 - JK + JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'O3CLIM'
+ TZFIELD3D%CLONGNAME = 'O3CLIM'
+ TZFIELD3D%CUNITS = 'Pa Pa-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_O3'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+!cumulated optical thickness of aerosols
+!cumul begin from the top of the domain, not from the TOA !
+!
+!land
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
+ END DO
+ END DO
+ END DO
+!
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+ TZFIELD3D%CMNHNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! sea
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! desert
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_DES'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_DES'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! urban
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_URB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_URB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! Volcanoes
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! stratospheric background
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+ ENDIF
+END IF
+!
+DEALLOCATE(ZNFLW_CS)
+DEALLOCATE(ZNFLW)
+DEALLOCATE(ZNFSW_CS)
+DEALLOCATE(ZNFSW)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
+DEALLOCATE(ZFLUX_SW_DOWN)
+DEALLOCATE(ZFLUX_SW_UP)
+DEALLOCATE(ZFLUX_LW)
+DEALLOCATE(ZDTLW_CS)
+DEALLOCATE(ZDTSW_CS)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
+DEALLOCATE(ZPLAN_ALB_VIS)
+DEALLOCATE(ZPLAN_ALB_NIR)
+DEALLOCATE(ZPLAN_TRA_VIS)
+DEALLOCATE(ZPLAN_TRA_NIR)
+DEALLOCATE(ZPLAN_ABS_VIS)
+DEALLOCATE(ZPLAN_ABS_NIR)
+DEALLOCATE(ZEFCL_LWD)
+DEALLOCATE(ZEFCL_LWU)
+DEALLOCATE(ZFLWP)
+DEALLOCATE(ZFIWP)
+DEALLOCATE(ZRADLP)
+DEALLOCATE(ZRADIP)
+DEALLOCATE(ZEFCL_RRTM)
+DEALLOCATE(ZCLSW_TOTAL)
+DEALLOCATE(ZTAU_TOTAL)
+DEALLOCATE(ZOMEGA_TOTAL)
+DEALLOCATE(ZCG_TOTAL)
+DEALLOCATE(ZFLUX_SW_DOWN_CS)
+DEALLOCATE(ZFLUX_SW_UP_CS)
+DEALLOCATE(ZFLUX_LW_CS)
+DEALLOCATE(ZO3AVE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RADIATIONS
+!
+END MODULE MODI_RADIATIONS
diff --git a/src/mesonh/ext/read_exsegn.f90 b/src/mesonh/ext/read_exsegn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..59d9b68d0284d1d6e9848b68ad7537b24c1f21ef
--- /dev/null
+++ b/src/mesonh/ext/read_exsegn.f90
@@ -0,0 +1,3064 @@
+!MNH_LIC Copyright 1994-2023 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_READ_EXSEG_n
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP,OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+END SUBROUTINE READ_EXSEG_n
+!
+END INTERFACE
+!
+END MODULE MODI_READ_EXSEG_n
+!
+!
+! #########################################################################
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP, OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+! #########################################################################
+!
+!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the descriptor file called
+! EXSEG and to control the coherence with FMfile data .
+!
+!!
+!!** METHOD
+!! ------
+!! The descriptor file is read. Namelists (NAMXXXn) which contain
+!! variables linked to one nested model are at the beginning of the file.
+!! Namelists (NAMXXX) which contain variables common to all models
+!! are at the end of the file. When the model index is different from 1,
+!! the end of the file (namelists NAMXXX) is not read.
+!!
+!! Coherence between the initial file (description read in DESFM file)
+!! and the segment to perform (description read in EXSEG file)
+!! is checked for segment achievement configurations
+!! or postprocessing configuration. The get indicators are set according
+!! to the following check :
+!!
+!! - segment achievement and preinit configurations :
+!!
+!! * if there is no turbulence kinetic energy in initial
+!! file (HTURB='NONE'), and the segment to perform requires a turbulence
+!! parameterization (CTURB /= 'NONE'), the get indicators for turbulence
+!! kinetic energy variables are set to 'INIT'; i.e. these variables will be
+!! set equal to zero by READ_FIELD according to the get indicators.
+!! * The same procedure is applied to the dissipation of TKE.
+!! * if there is no moist variables RRn in initial file (OUSERn=.FALSE.)
+!! and the segment to perform requires moist variables RRn
+!! (LUSERn=.TRUE.), the get indicators for moist variables RRn are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators.
+!! * if there are KSV_USER additional scalar variables in initial file and the
+!! segment to perform needs more than KSV_USER additional variables, the get
+!! indicators for these (NSV_USER-KSV_USER) additional scalar variables are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators. If the segment to perform
+!! needs less additional scalar variables than there are in initial file,
+!! the get indicators for these (KSV_USER - NSV_USER) additional scalar variables are
+!! set equal to 'SKIP'.
+!! * warning messages are printed if the fields in initial file are the
+!! same at time t and t-dt (HCONF='START') and a leap-frog advance
+!! at first time step will be used for the segment to perform
+!! (CCONF='RESTA'); It is likewise when HCONF='RESTA' and CCONF='START'.
+!! * A warning message is printed if the orography in initial file is zero
+!! (OFLAT=.TRUE.) and the segment to perform considers no-zero orography
+!! (LFLAT=.FALSE.). It is likewise for LFLAT=.TRUE. and OFLAT=.FALSE..
+!! If the segment to perform requires zero orography (LFLAT=.TRUE.), the
+!! orography (XZS) will not read in initial file but set equal to zero
+!! by SET_GRID.
+!! * check of the depths of the Lateral Damping Layer in x and y
+!! direction is performed
+!! * If some coupling files are specified, LSTEADYLS is set to T
+!! * If no coupling files are specified, LSTEADYLS is set to F
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODN_CONF : CCONF,LTHINSHELL,LFLAT,NMODEL,NVERB
+!!
+!! Module MODN_DYN : LCORIO, LZDIFFU
+!!
+!! Module MODN_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODN_BUDGET : CBUTYPE,XBULEN
+!!
+!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH,CSEG
+!!
+!! Module MODN_DYN1 : XTSTEP,CPRESOPT,NITR,XRELAX
+!!
+!! Module MODD_ADV1 : CMET_ADV_SCHEME,CSV_ADV_SCHEME,CUVW_ADV_SCHEME,NLITER
+!!
+!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODN_LUNIT1 :
+!! Module MODN_LBC1 : CLBCX,CLBCY,NLBLX,NLBLY,XCPHASE,XPOND
+!!
+!! Module MODN_TURB_n : CTURBLEN,CTURBDIM
+!!
+!! Module MODD_GET1:
+!! CGETTKEM,CGETTKET,
+!! CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM,CGETRGM,CGETRHM
+!! CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETRST,CGETRGT,CGETRHT,CGETSVM
+!! CGETSVT,CGETSIGS,CGETSRCM,CGETSRCT
+!! NCPL_NBR,NCPL_TIMES,NCPL_CUR
+!! Module MODN_LES : contains declaration of the control parameters
+!! for Large Eddy Simulations' storages
+!! for the forcing
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_EXSEG_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Modification 26/10/94 (Stein) remove NAM_GET from the Namelists
+!! present in DESFM + change the namelist names
+!! Modification 22/11/94 (Stein) add GET indicator for phi
+!! Modification 21/12/94 (Stein) add GET indicator for LS fields
+!! Modification 06/01/95 (Stein) bug in the test for Scalar Var.
+!! Modifications 09/01/95 (Stein) add the turbulence scheme
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add coherence in coupling case
+!! Modifications 16/03/95 (Stein) remove R from the historical variables
+!! Modifications 01/03/95 (Hereil) add the budget namelists
+!! Modifications 16/06/95 (Stein) coherence control for the
+!! microphysical scheme + remove the wrong messge for RESTA conf
+!! Modifications 30/06/95 (Stein) conditionnal reading of the fields
+!! used by the moist turbulence scheme
+!! Modifications 12/09/95 (Pinty) add the radiation scheme
+!! Modification 06/02/96 (J.Vila) implement scalar advection schemes
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 02/05/96 (Stein Jabouille) change the Z0SEA activation
+!! Modifications 24/05/96 (Stein) change the SRC SIGS control
+!! Modifications 08/09/96 (Masson) the coupling file names are reset to
+!! default value " " before reading in EXSEG1.nam
+!! to avoid extra non-existant coupling files
+!!
+!! Modifications 25/04/95 (K.Suhre)add namelist NAM_BLANK
+!! add read for LFORCING
+!! 25/04/95 (K.Suhre)add namelist NAM_FRC
+!! and switch checking
+!! 06/08/96 (K.Suhre)add namelist NAM_CH_MNHCn
+!! and NAM_CH_SOLVER
+!! Modifications 10/10/96 (Stein) change SRC into SRCM and SRCT
+!! Modifications 11/04/96 (Pinty) add the rain-ice microphysical scheme
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 22/05/97 (Lafore) gridnesting implementation
+!! Modifications 22/06/97 (Stein) add the absolute pressure + cleaning
+!! Modifications 25/08/97 (Masson) add tests on surface schemes
+!! 22/10/97 (Stein) remove the RIMX /= 0 control
+!! + new namelist + cleaning
+!! Modifications 17/04/98 (Masson) add tests on character variables
+!! Modification 15/03/99 (Masson) add tests on PROGRAM
+!! Modification 04/01/00 (Masson) removes TSZ0 case
+!! Modification 04/06/00 (Pinty) add C2R2 scheme
+!! 11/12/00 (Tomasini) add CSEA_FLUX to MODD_PARAMn
+!! delete the test on SST_FRC only in 1D
+!! Modification 22/01/01 (Gazen) change NSV,KSV to NSV_USER,KSV_USER and add
+!! NSV_* variables initialization
+!! Modification 15/10/01 (Mallet) allow namelists in different orders
+!! Modification 18/03/02 (Solmon) new radiation scheme test
+!! Modification 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
+!! Modification 06/11/02 (Masson) new LES BL height diagnostic
+!! Modification 06/11/02 (Jabouille) remove LTHINSHELL LFORCING test
+!! Modification 01/12/03 (Gazen) change Chemical scheme interface
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! Modification 01/2005 (Masson) removes 1D and 2D switches
+!! Modification 04/2005 (Tulet) add dust, orilam
+!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
+!! Modification 04/2006 (Maric) include 4th order advection scheme
+!! Modification 05/2006 (Masson) add nudging
+!! Modification 05/2006 Remove KEPS
+!! Modification 04/2006 (Maric) include PPM advection scheme
+!! Modification 04/2006 (J.Escobar) Bug dollarn add CALL UPDATE_NAM_CONFN
+!! Modifications 01/2007 (Malardel,Pergaud) add the MF shallow
+!! convection scheme MODN_PARAM_MFSHALL_n
+!! Modification 09/2009 (J.Escobar) add more info on relaxation problems
+!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose
+!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme
+!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016)
+!! Modification 02/2012 (Pialat/Tulet) add ForeFire
+!! Modification 02/2012 (T.Lunet) add of new Runge-Kutta methods
+!! Modification 01/2015 (C. Barthe) add explicit LNOx
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 18/12/2015 : bug chimie glace dans prep_real_case
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 02/2016 (M.Leriche) treat gas and aq. chemicals separately
+!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
+!! Modification 10/2016 (C.LAC) Add OSPLIT_WENO + Add droplet
+!! deposition + Add max values
+!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
+!! Modification 03/2017 (JP Chaboureau) Fix the initialization of
+!! LUSERx-type variables for LIMA
+!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for
+!! aerosol and no cloud scheme defined
+!! Q.Libois 02/2018 ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification 07/2017 (V. Vionnet) add blowing snow scheme
+!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length
+!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
+!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! R. Honnert 23/04/2021: add HM21 mixing length and delete HRIO and BOUT from CMF_UPDRAFT
+! S. Riette 11/05/2021 HighLow cloud
+! A. Costes 12/2021: add Blaze fire model
+! P. Wautelet 27/04/2022: add namelist for profilers
+! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
+! P. Wautelet 13/07/2022: add namelist for flyers and balloons
+! P. Wautelet 19/08/2022: add namelist for aircrafts
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS
+USE MODD_BLOWSNOW
+USE MODD_BUDGET
+USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY : NEQ
+USE MODD_CONDSAMP
+USE MODD_CONF
+USE MODD_CONFZ
+! USE MODD_DRAG_n
+USE MODD_DUST
+USE MODD_DYN
+USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA, LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_GET_n
+USE MODD_GR_FIELD_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV,NSV_USER_n=>NSV_USER
+USE MODD_PARAMETERS
+USE MODD_PASPOL
+USE MODD_SALT
+USE MODD_VAR_ll, ONLY: NPROC
+USE MODD_VISCOSITY
+
+USE MODE_MSG
+USE MODE_POS
+
+USE MODI_INI_NSV
+USE MODI_TEST_NAM_VAR
+
+USE MODN_2D_FRC
+USE MODN_ADV_n ! The final filling of these modules for the model n is
+USE MODN_AIRCRAFTS, ONLY: AIRCRAFTS_NML_ALLOCATE, NAM_AIRCRAFTS
+USE MODN_BACKUP
+USE MODN_BALLOONS, ONLY: BALLOONS_NML_ALLOCATE, NAM_BALLOONS
+USE MODN_BLANK_n
+USE MODN_BLOWSNOW
+USE MODN_BLOWSNOW_n
+USE MODN_BUDGET
+USE MODN_CH_MNHC_n
+USE MODN_CH_ORILAM
+USE MODN_CH_SOLVER_n
+USE MODN_CONDSAMP
+USE MODN_CONF
+USE MODN_CONF_n
+USE MODN_CONFZ
+USE MODN_DRAGBLDG_n
+USE MODN_DRAG_n
+USE MODN_DRAGTREE_n
+USE MODN_DUST
+USE MODN_DYN
+USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
+USE MODN_ELEC
+USE MODN_EOL
+USE MODN_EOL_ADNR
+USE MODN_EOL_ALM
+USE MODN_FIRE_n
+USE MODN_FLYERS
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_FRC
+USE MODN_IBM_PARAM_n
+USE MODN_LATZ_EDFLX
+USE MODN_LBC_n ! routine is used for each nested model. This has been done
+USE MODN_LES
+USE MODN_LUNIT_n
+USE MODN_MEAN
+USE MODN_NESTING
+USE MODN_NUDGING_n
+USE MODN_OUTPUT
+USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
+ CHEVRIMED_ICE_C1R3
+USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
+ WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
+USE MODN_PARAM_ECRAD_n
+USE MODN_PARAM_ICE
+USE MODN_PARAM_KAFR_n
+USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,NMOD_CCN,LSCAV, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, NMOD_IMM, &
+ LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, &
+ LPTSPLIT, LSPRO, LADJ, LKHKO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODN_PARAM_MFSHALL_n
+USE MODN_PARAM_n ! realized in subroutine ini_model n
+USE MODN_PARAM_RAD_n
+USE MODN_PASPOL
+USE MODN_PROFILER_n
+USE MODN_RECYCL_PARAM_n
+USE MODN_SALT
+USE MODN_SERIES
+USE MODN_SERIES_n
+USE MODN_STATION_n
+USE MODN_TURB
+USE MODN_TURB_CLOUD
+USE MODN_TURB_n
+USE MODN_VISCOSITY
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust Deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUSEG,ILUOUT ! logical unit numbers of EXSEG file and outputlisting
+INTEGER :: JS,JCI,JI,JSV ! Loop indexes
+LOGICAL :: GRELAX
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. READ EXSEG FILE
+! ---------------
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_EXSEG_n','called for '//TRIM(TPEXSEGFILE%CNAME))
+!
+ILUSEG = TPEXSEGFILE%NLU
+ILUOUT = TLUOUT%NLU
+!
+CALL INIT_NAM_LUNITN
+CCPLFILE(:)=" "
+CALL INIT_NAM_CONFN
+CALL INIT_NAM_DYNN
+CALL INIT_NAM_ADVN
+CALL INIT_NAM_DRAGTREEN
+CALL INIT_NAM_DRAGBLDGN
+CALL INIT_NAM_PARAMN
+CALL INIT_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL INIT_NAM_PARAM_ECRADN
+#endif
+CALL INIT_NAM_PARAM_KAFRN
+CALL INIT_NAM_PARAM_MFSHALLN
+CALL INIT_NAM_LBCN
+CALL INIT_NAM_NUDGINGN
+CALL INIT_NAM_TURBN
+CALL INIT_NAM_BLANKN
+CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
+CALL INIT_NAM_CH_MNHCN
+CALL INIT_NAM_CH_SOLVERN
+CALL INIT_NAM_SERIESN
+CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_PROFILERn
+CALL INIT_NAM_STATIONn
+CALL INIT_NAM_FIREn
+!
+WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
+CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
+CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
+CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
+CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
+CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
+#ifdef MNH_ECRAD
+CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
+#endif
+CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
+CALL POSNAM(ILUSEG,'NAM_PARAM_MFSHALLN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_MFSHALLn)
+CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
+CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
+CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
+CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
+CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
+CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
+CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
+CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
+CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
+CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
+CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
+CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM(ILUSEG,'NAM_PROFILERN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
+CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
+CALL POSNAM(ILUSEG,'NAM_FIREN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIREn)
+!
+IF (KMI == 1) THEN
+ WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
+ CALL POSNAM(ILUSEG,'NAM_CONF',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
+ CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
+ CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
+ CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
+ CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX))
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_BACKUP)
+ ELSE
+ CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND)
+ IF (GFOUND) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
+ ELSE
+ IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found')
+ END IF
+ END IF
+ CALL POSNAM(ILUSEG,'NAM_OUTPUT',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX))
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX))
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
+ END IF
+ CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RU ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
+ DEALLOCATE( CBULIST_RU )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) )
+ CBULIST_RU(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RU)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
+ DEALLOCATE( CBULIST_RV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) )
+ CBULIST_RV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RW ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
+ DEALLOCATE( CBULIST_RW )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) )
+ CBULIST_RW(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RW)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
+ DEALLOCATE( CBULIST_RTH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) )
+ CBULIST_RTH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
+ DEALLOCATE( CBULIST_RTKE )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) )
+ CBULIST_RTKE(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
+ DEALLOCATE( CBULIST_RRV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) )
+ CBULIST_RRV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRC ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
+ DEALLOCATE( CBULIST_RRC )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) )
+ CBULIST_RRC(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRR ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
+ DEALLOCATE( CBULIST_RRR )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) )
+ CBULIST_RRR(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRI ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
+ DEALLOCATE( CBULIST_RRI )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) )
+ CBULIST_RRI(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRS ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
+ DEALLOCATE( CBULIST_RRS )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) )
+ CBULIST_RRS(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRG ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
+ DEALLOCATE( CBULIST_RRG )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) )
+ CBULIST_RRG(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
+ DEALLOCATE( CBULIST_RRH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) )
+ CBULIST_RRH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RSV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
+ DEALLOCATE( CBULIST_RSV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) )
+ CBULIST_RSV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
+ END IF
+
+ CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
+ CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
+ CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
+ CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_ICE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ICE)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
+ CALL POSNAM(ILUSEG,'NAM_PARAM_LIMA',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_LIMA)
+ CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
+ CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
+ CALL POSNAM(ILUSEG,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB_CLOUD)
+ CALL POSNAM(ILUSEG,'NAM_TURB',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB)
+ CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
+ CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
+ CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
+ CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
+#ifdef MNH_FOREFIRE
+ CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
+#endif
+ CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
+ CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
+ CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
+ CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
+ CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
+
+ CALL POSNAM(ILUSEG,'NAM_FLYERS',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
+
+ IF ( NAIRCRAFTS > 0 ) THEN
+ CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
+ CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
+ END IF
+
+ IF ( NBALLOONS > 0 ) THEN
+ CALL BALLOONS_NML_ALLOCATE( NBALLOONS )
+ CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, &
+ 'CEN4TH','CEN2ND','WENO_K' )
+CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, &
+ &'RK11','RK21','RK33','RKC4','RK53','RK4B','RK62','RK65','NP32','SP32','LEFR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL')
+CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW',&
+#ifdef MNH_ECRAD
+ 'ECRA',&
+#endif
+ 'TOPA')
+CALL TEST_NAM_VAR(ILUOUT,'CCLOUD',CCLOUD,'NONE','REVE','KESS', &
+ & 'ICE3','ICE4','C2R2','C3R5','KHKO','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CDCONV',CDCONV,'NONE','KAFR')
+CALL TEST_NAM_VAR(ILUOUT,'CSCONV',CSCONV,'NONE','KAFR','EDKF')
+CALL TEST_NAM_VAR(ILUOUT,'CELEC',CELEC,'NONE','ELE3','ELE4')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CAER',CAER,'TANR','TEGE','SURF','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CAOP',CAOP,'CLIM','EXPL')
+CALL TEST_NAM_VAR(ILUOUT,'CLW',CLW,'RRTM','MORC')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADL',CEFRADL,'PRES','OCLN','MART','C2R2','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADI',CEFRADI,'FX40','LIOU','SURI','C3R5','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'COPWLW',COPWLW,'SAVI','SMSH','LILI','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPILW',COPILW,'FULI','EBCU','SMSH','FU98')
+CALL TEST_NAM_VAR(ILUOUT,'COPWSW',COPWSW,'SLIN','FOUQ','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPISW',COPISW,'FULI','EBCU','FU96')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLBCX(1)',CLBCX(1),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','HM21')
+CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
+CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
+ 'SPLIT ','CENTER ','LAGGED ')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCONF',CCONF,'START','RESTA')
+CALL TEST_NAM_VAR(ILUOUT,'CEQNSYS',CEQNSYS,'LHE','DUR','MAE')
+CALL TEST_NAM_VAR(ILUOUT,'CSPLIT',CSPLIT,'BSPLITTING','XSPLITTING','YSPLITTING')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CBUTYPE',CBUTYPE,'NONE','CART','MASK')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CRELAX_HEIGHT_TYPE',CRELAX_HEIGHT_TYPE,'FIXE','THGR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLES_NORM_TYPE',CLES_NORM_TYPE,'NONE','CONV','EKMA','MOBU')
+CALL TEST_NAM_VAR(ILUOUT,'CBL_HEIGHT_DEF',CBL_HEIGHT_DEF,'TKE','KE','WTV','FRI','DTH')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','BL89')
+!
+! The test on the mass flux scheme for shallow convection
+!
+CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ')
+CALL TEST_NAM_VAR(ILUOUT,'CMF_CLOUD',CMF_CLOUD,'NONE','STAT','DIRE')
+!
+! The test on the CSOLVER name is made elsewhere
+!
+CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE',CPRISTINE_ICE,'PLAT','COLU','BURO')
+CALL TEST_NAM_VAR(ILUOUT,'CSEDIM',CSEDIM,'SPLI','STAT','NONE')
+IF( CCLOUD == 'C3R5' ) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
+ 'PLAT','COLU','BURO')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_C1R3',CHEVRIMED_ICE_C1R3, &
+ 'GRAU','HAIL')
+END IF
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_LIMA',CPRISTINE_ICE_LIMA, &
+ 'PLAT','COLU','BURO')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_LIMA',CHEVRIMED_ICE_LIMA, &
+ 'GRAU','HAIL')
+END IF
+! Blaze
+CALL UPDATE_NAM_FIREn
+IF (LBLAZE) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPROPAG_MODEL',CPROPAG_MODEL,'SANTONI2011')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEAT_FLUX_MODEL',CHEAT_FLUX_MODEL,'CST','EXP','EXS')
+ CALL TEST_NAM_VAR(ILUOUT,'CLATENT_FLUX_MODEL',CLATENT_FLUX_MODEL,'CST','EXP')
+ CALL TEST_NAM_VAR(ILUOUT,'CFIRE_CPL_MODE',CFIRE_CPL_MODE,'2WAYCPL','FIR2ATM','ATM2FIR')
+ CALL TEST_NAM_VAR(ILUOUT,'CWINDFILTER',CWINDFILTER,'EWAM','WLIM')
+END IF
+!
+IF(LBLOWSNOW) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC')
+ IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN
+ WRITE(ILUOUT,*) '*****************************************'
+ WRITE(ILUOUT,*) '* XALPHA_SNW must be set to 3 when '
+ WRITE(ILUOUT,*) '* CSNOWSEDIM = TABC '
+ WRITE(ILUOUT,*) '* Update the look-up table in BLOWSNOW_SEDIM_LKT1D '
+ WRITE(ILUOUT,*) '* to use TABC with a different value of XEMIALPHA_SNW'
+ WRITE(ILUOUT,*) '*****************************************'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+END IF
+!
+!-------------------------------------------------------------------------------!
+!* 2. FIRST INITIALIZATIONS
+! ---------------------
+!
+!* 2.1 Time step in gridnesting case
+!
+IF (KMI /= 1 .AND. NDAD(KMI) /= KMI) THEN
+ XTSTEP = PTSTEP_ALL(NDAD(KMI)) / NDTRATIO(KMI)
+END IF
+PTSTEP_ALL(KMI) = XTSTEP
+!
+!* 2.2 Fill the global configuration module
+!
+! Check coherence between the microphysical scheme and water species and
+!initialize the logicals LUSERn
+!
+SELECT CASE ( CCLOUD )
+ CASE ( 'NONE' )
+ IF (.NOT. ( (.NOT. LUSERC) .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) .AND. CPROGRAM=='MESONH' ) THEN
+!
+ LUSERC=.FALSE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+!
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
+!
+ CSUBG_AUCV = 'NONE'
+!
+ END IF
+!
+ CASE ( 'REVE' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) &
+ .AND. (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A REVERSIBLE MICROPHYSICAL " ,&
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR AND CLOUD WATER ",/, &
+ &" LUSERV AND LUSERC ARE TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A REVERSIBLE MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT YOU DO NOT HAVE RAIN in the "REVE" SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
+!
+ CSUBG_AUCV = 'NONE'
+!
+ END IF
+!
+ CASE ( 'KESS' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A KESSLER MICROPHYSICAL " , &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &" LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A KESSLER MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME USING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SIGMA_RC.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET CSUBG_AUCV TO "CLFR" or "NONE" OR CCLOUD TO "ICE3"'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ CASE ( 'ICE3' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. (.NOT. LUSERH)) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice3 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES AND GRAUPELN.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG ARE SET TO TRUE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH TO FALSE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV == 'SIGM' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ IF (CSUBG_AUCV == 'CLFR' .AND. CSCONV /= 'EDKF') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH THE CONVECTIVE CLOUD FRACTION WITHOUT EDKF'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ CASE ( 'ICE4' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. LUSERH) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice4 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES, GRAUPELN AND HAILSTONES.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH ARE SET TO TRUE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE.
+ END IF
+!
+ IF (CSUBG_AUCV /= 'NONE' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
+ CSUBG_AUCV='NONE'
+ END IF
+!
+ CASE ( 'C2R2','C3R5', 'KHKO' )
+ IF (( EPARAM_CCN == 'XXX') .OR. (EINI_CCN == 'XXX')) THEN
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_C2R2", &
+ &" YOU HAVE TO FILL HPARAM_CCN and HINI_CCN ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ IF (CCLOUD == 'C3R5') THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE WARM MICROPHYSICAL ", &
+ &" SCHEME BUT YOU WERE USING THE ICE3 SCHEME PREVIOUSLY.",/, &
+ &" AS THIS IS A LITTLE BIT STUPID IT IS NOT AUTHORIZED !!!")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF ((CCLOUD == 'C2R2' ).OR. (CCLOUD == 'KHKO' )) THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C2R2 MICROPHYSICAL ", &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &"LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'C3R5') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C3R5 MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'LIMA') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LIMA MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ END IF
+!
+ IF (LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LSUBG_COND TO FALSE OR CCLOUD TO "REVE", "KESS"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( CCLOUD == 'C3R5' .AND. CEFRADI /= 'C3R5') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADI=C3R5 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADI=C3R5 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( WALPHAC /= 3.0 .OR. WNUC /= 2.0) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS WITH KHKO SCHEME. '
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ CASE ( 'LIMA')
+ IF ((LACTI .AND. FINI_CCN == 'XXX')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", &
+ &" YOU HAVE TO FILL FINI_CCN ")')
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
+ END IF
+!
+ IF(LACTI .AND. NMOD_CCN == 0) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", &
+ &"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", &
+ &"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")')
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
+ END IF
+!
+ IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("NUCLEATION BY DEPOSITION AND CONTACT IS NOT ", &
+ &"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER", &
+ &"VALUE OF NMOD_IFN IN ORDER TO USE LIMA COLD NUCLEATION SCHEME.")')
+ END IF
+!
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF (NMOM_C.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE. ; LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (NMOM_I.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH= NMOM_H.GE.1
+ END IF
+ !
+ IF (LSPRO) LADJ=.FALSE.
+ IF (.NOT.LPTSPLIT) THEN
+ IF (NMOM_C==1) NMOM_C=2
+ IF (NMOM_R==1) NMOM_R=2
+ IF (NMOM_I==1) NMOM_I=2
+ IF (NMOM_S==2 .OR. NMOM_G==2 .OR. NMOM_H==2) THEN
+ NMOM_S=2
+ NMOM_G=2
+ IF (NMOM_H.GE.1) NMOM_H=2
+ END IF
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LADJ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LADJ=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LADJ=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF ( LKHKO .AND. (XALPHAC /= 3.0 .OR. XNUC /= 2.0) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS. '
+ END IF
+!
+ IF ( CEFRADL /= 'LIMA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=LIMA FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=LIMA '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"'
+ END IF
+!
+END SELECT
+!
+LUSERV_G(KMI) = LUSERV
+LUSERC_G(KMI) = LUSERC
+LUSERR_G(KMI) = LUSERR
+LUSERI_G(KMI) = LUSERI
+LUSERS_G(KMI) = LUSERS
+LUSERG_G(KMI) = LUSERG
+LUSERH_G(KMI) = LUSERH
+LUSETKE(KMI) = (CTURB /= 'NONE')
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.3 Chemical and NSV_* variables initializations
+!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_CONFN
+!
+IF (LORILAM .AND. .NOT. LUSECHEM) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT USE ORILAM AEROSOL SCHEME WITHOUT '
+ WRITE(ILUOUT,FMT=*) 'CHEMICAL GASEOUS CHEMISTRY '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LUSECHEM IS SET TO TRUE '
+ LUSECHEM=.TRUE.
+END IF
+!
+IF (LUSECHAQ.AND.(.NOT.LUSECHEM)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHEM TO TRUE IF YOU WANT REALLY USE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHAQ TO FALSE IF YOU DO NOT WANT USE IT'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF (LUSECHAQ.AND.(.NOT.LUSERC).AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHAQ IS SET TO FALSE'
+ LUSECHAQ = .FALSE.
+END IF
+IF (LUSECHAQ.AND.CCLOUD(1:3) == 'ICE'.AND. .NOT. LUSECHIC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH MIXED PHASE CLOUD MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHIC TO TRUE IF YOU WANT TO ACTIVATE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ICE PHASE CHEMICAL SPECIES'
+ IF (LCH_RET_ICE) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE TRUE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES ARE RETAINED IN ICE PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WHEN SUPERCOOLED WATER FREEZES'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE FALSE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES GO BACK TO THE GAS PHASE WHEN'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SUPERCOOLED WATER FREEZES'
+ ENDIF
+ENDIF
+IF (LUSECHIC.AND. .NOT. CCLOUD(1:3) == 'ICE'.AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT MIXED PHASE CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHIC IS SET TO FALSE'
+ LUSECHIC= .FALSE.
+ENDIF
+IF (LCH_PH.AND. (.NOT. LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'DIAGNOSTIC PH COMPUTATION IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT TO ACTIVATE IT'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_PH IS SET TO FALSE'
+ LCH_PH= .FALSE.
+ENDIF
+IF (LUSECHIC.AND.(.NOT.LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT REALLY USE CLOUD CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHIC TO FALSE IF YOU DO NOT WANT USE IT'
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE RETENTION OF SOLUBLE GASES IN ICE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE ICE PHASE CHEMISTRY IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FLAG LCH_RET_ICE IS ONLY USES WHEN LUSECHIC IS SET'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE'
+ENDIF
+!
+CALL UPDATE_NAM_CH_MNHCN
+CALL INI_NSV(KMI)
+!
+! From this point, all NSV* variables contain valid values for model KMI
+!
+DO JSV = 1,NSV
+ LUSESV(JSV,KMI) = .TRUE.
+END DO
+!
+IF ( CAOP=='EXPL' .AND. .NOT.LDUST .AND. .NOT.LORILAM &
+ .AND. .NOT.LSALT .AND. .NOT.(CCLOUD=='LIMA') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU WANT TO USE EXPLICIT AEROSOL OPTICAL '
+ WRITE(UNIT=ILUOUT,FMT=*) 'PROPERTIES BUT YOU DONT HAVE DUST OR '
+ WRITE(UNIT=ILUOUT,FMT=*) 'AEROSOL OR SALT THEREFORE CAOP=CLIM'
+ CAOP='CLIM'
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 3. CHECK COHERENCE BETWEEN EXSEG VARIABLES AND FMFILE ATTRIBUTES
+! -------------------------------------------------------------
+!
+!
+!* 3.1 Turbulence variable
+!
+IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
+ CGETTKET ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTURB /= 'NONE') THEN
+ CGETTKET ='READ'
+ IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT'
+ ELSE
+ CGETTKET ='SKIP'
+ END IF
+END IF
+!
+!
+IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN
+ CGETBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE BL DEPTH FOR THIRD ORDER MOMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTOM == 'TM06') THEN
+ CGETBL_DEPTH ='READ'
+ ELSE
+ CGETBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+IF (LRMC01 .AND. .NOT. ORMC01) THEN
+ CGETSBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE SBL DEPTH FOR RMC01'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (LRMC01) THEN
+ CGETSBL_DEPTH ='READ'
+ ELSE
+ CGETSBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+!
+!* 3.2 Moist variables
+!
+IF (LUSERV.AND. (.NOT.OUSERV)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & "Rv WILL BE INITIALIZED TO ZERO")')
+ CGETRVT='INIT'
+ELSE
+ IF (LUSERV) THEN
+ CGETRVT='READ'
+ ELSE
+ CGETRVT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", &
+ & " IS NOT IN INITIAL FMFILE",/, &
+ & "Rc WILL BE INITIALIZED TO ZERO")')
+ CGETRCT='INIT'
+ELSE
+ IF (LUSERC) THEN
+ CGETRCT='READ'
+! IF(CCONF=='START') CGETRCT='INIT'
+ ELSE
+ CGETRCT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERR.AND. (.NOT.OUSERR)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE RAIN VARIABLE Rr WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rr WILL BE INITIALIZED TO ZERO")')
+
+ CGETRRT='INIT'
+ELSE
+ IF (LUSERR) THEN
+ CGETRRT='READ'
+! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT'
+ ELSE
+ CGETRRT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ri WILL BE INITIALIZED TO ZERO")')
+ CGETRIT='INIT'
+ELSE
+ IF (LUSERI) THEN
+ CGETRIT='READ'
+! IF(CCONF=='START') CGETRIT='INIT'
+ ELSE
+ CGETRIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSECI.AND. (.NOT.OUSECI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE CONC. VARIABLE Ci WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ci WILL BE INITIALIZED TO ZERO")')
+ CGETCIT='INIT'
+ELSE
+ IF (LUSECI) THEN
+ CGETCIT='READ'
+ ELSE
+ CGETCIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERS.AND. (.NOT.OUSERS)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rs WILL BE INITIALIZED TO ZERO")')
+ CGETRST='INIT'
+ELSE
+ IF (LUSERS) THEN
+ CGETRST='READ'
+! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT'
+ ELSE
+ CGETRST='SKIP'
+ END IF
+END IF
+!
+IF (LUSERG.AND. (.NOT.OUSERG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",&
+ & " IT IS NOTIN INITIAL FMFILE",/, &
+ & "Rg WILL BE INITIALIZED TO ZERO")')
+ CGETRGT='INIT'
+ELSE
+ IF (LUSERG) THEN
+ CGETRGT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT'
+ ELSE
+ CGETRGT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERH.AND. (.NOT.OUSERH)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",&
+ & "IT IS NOT IN INITIAL FMFILE",/, &
+ & " Rh WILL BE INITIALIZED TO ZERO")')
+ CGETRHT='INIT'
+ELSE
+ IF (LUSERH) THEN
+ CGETRHT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT'
+ ELSE
+ CGETRHT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETCLDFR = 'INIT'
+ELSE
+ IF ( LUSERC ) THEN
+ CGETCLDFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT'
+ ELSE
+ CGETCLDFR = 'SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE ICE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETICEFR = 'INIT'
+ELSE
+ IF ( LUSERI ) THEN
+ CGETICEFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETICEFR='INIT'
+ ELSE
+ CGETICEFR = 'SKIP'
+ END IF
+END IF
+!
+IF(CTURBLEN=='RM17' .OR. CTURBLEN=='HM21') THEN
+ XCEDIS=0.34
+ELSE
+ XCEDIS=0.84
+END IF
+!
+!* 3.3 Moist turbulence
+!
+IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
+ IF ( .NOT. (OUSERC .AND. HTURB /= 'NONE') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, &
+ & " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, &
+ & "SRC AND SIGS ARE INITIALIZED TO 0")')
+ CGETSRCT ='INIT'
+ CGETSIGS ='INIT'
+ ELSE
+ CGETSRCT ='READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT'
+ CGETSIGS ='READ'
+ END IF
+ELSE
+ CGETSRCT ='SKIP'
+ CGETSIGS ='SKIP'
+END IF
+!
+IF(NMODEL_CLOUD==KMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ IF (CTURB=='NONE' .OR. .NOT.LUSERC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO COMPUTE A MIXING LENGTH FOR CLOUD=", &
+ & A4,/, &
+ & ", WHEREAS YOU DO NOT SPECIFY A TURBULENCE SCHEME OR ", &
+ & "USE OF RC,",/," CTURBLEN_CLOUD IS SET TO NONE")') &
+ CTURBLEN_CLOUD
+ CTURBLEN_CLOUD='NONE'
+ END IF
+ IF( XCEI_MIN > XCEI_MAX ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("PROBLEM OF CEI LIMITS FOR CLOUD MIXING ",/, &
+ & "LENGTH COMPUTATION: XCEI_MIN=",E9.3,", XCEI_MAX=",E9.3)')&
+ XCEI_MIN,XCEI_MAX
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( LSIGMAS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SIGMA_S FROM TURBULENCE SCHEME",/, &
+ & " IN ICE SUBGRID CONDENSATION, SO YOUR SIGMA_S"/, &
+ & " MIGHT BE SMALL ABOVE PBL DEPENDING ON LENGTH SCALE")')
+END IF
+!
+IF (LSUBG_COND .AND. CTURB=='NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT TURBULENCE '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: LSUBG_COND is SET to FALSE'
+ LSUBG_COND=.FALSE.
+END IF
+!
+IF (L1D .AND. CTURB/='NONE' .AND. CTURBDIM == '3DIM') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE 3D TURBULENCE IN 1D CONFIGURATION '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE: CTURBDIM IS SET TO 1DIM'
+ CTURBDIM = '1DIM'
+END IF
+!
+!* 3.4 Additional scalar variables
+!
+IF (NSV_USER == KSV_USER) THEN
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ELSEIF (NSV_USER > KSV_USER) THEN
+ IF (KSV_USER == 0) THEN
+ CGETSVT(1:NSV_USER)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, &
+ & "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary
+ CGETSVT(JS)='INIT' ! initial file)
+ END DO
+ END IF
+ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE")')
+ DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize with these values
+! IF(CCONF=='START') CGETSVT(JS)='INIT'
+ END DO
+ DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables
+ CGETSVT(JS)='SKIP'
+ END DO
+END IF
+!
+! C2R2 and KHKO SV case
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
+ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 &
+ & (or KHKO) SCHEME IN INITIAL FMFILE",/,&
+ & "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ END IF
+END IF
+!
+! C3R5 SV case
+!
+IF (CCLOUD == 'C3R5') THEN
+ IF (HCLOUD == 'C3R5') THEN
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ END IF
+END IF
+!
+! LIMA SV case
+!
+IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE LIMA VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT'
+ END IF
+END IF
+!
+! Electrical SV case
+!
+IF (CELEC /= 'NONE') THEN
+ IF (HELEC /= 'NONE') THEN
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ END IF
+END IF
+!
+! (explicit) LINOx SV case
+!
+IF (CELEC /= 'NONE' .AND. LLNOX_EXPLICIT) THEN
+ IF (HELEC /= 'NONE' .AND. OLNOX_EXPLICIT) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ & IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Chemical SV case (excluding aqueous chemical species)
+!
+IF (LUSECHEM) THEN
+ IF (OUSECHEM) THEN
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='READ'
+ IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ END IF
+END IF
+! add aqueous chemical species
+IF (LUSECHAQ) THEN
+ IF (OUSECHAQ) THEN
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN AQUEOUS PHASE IN INITIAL FMFILE",/,&
+ & "THE AQUEOUS PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ END IF
+END IF
+! add ice phase chemical species
+IF (LUSECHIC) THEN
+ IF (OUSECHIC) THEN
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SPECIES IN ICE PHASE IN INITIAL FMFILE",/,&
+ & "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ END IF
+END IF
+! pH values = diagnostics
+IF (LCH_PH .AND. .NOT. OCH_PH) THEN
+ CGETPHC ='INIT' !will be initialized to XCH_PHINIT
+ IF (LUSERR) THEN
+ CGETPHR = 'INIT' !idem
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ELSE
+ IF (LCH_PH) THEN
+ CGETPHC ='READ'
+ IF (LUSERR) THEN
+ CGETPHR = 'READ'
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ ELSE
+ CGETPHC ='SKIP'
+ CGETPHR ='SKIP'
+ END IF
+END IF
+!
+! Dust case
+!
+IF (LDUST) THEN
+ IF (ODUST) THEN
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ END IF
+ IF (LDEPOS_DST(KMI)) THEN
+
+ !UPG *PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG *PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_DST(KMI) ) THEN
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ END IF
+ END IF
+
+ IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Sea Salt case
+!
+IF (LSALT) THEN
+ IF (OSALT) THEN
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
+ CGETZWS='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ CGETZWS='INIT'
+ END IF
+ IF (LDEPOS_SLT(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_SLT(KMI) ) THEN
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ END IF
+ END IF
+ IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Orilam SV case
+!
+IF (LORILAM) THEN
+ IF (OORILAM) THEN
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ END IF
+ IF (LDEPOS_AER(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_AER(KMI) ) THEN
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD &
+ & AEROSOL SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ END IF
+ END IF
+END IF
+!
+! Lagrangian variables
+!
+IF (LINIT_LG .AND. .NOT.(LLG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("IT IS INCOHERENT TO HAVE LINIT_LG=.T. AND LLG=.F.",/,&
+ & "IF YOU WANT LAGRANGIAN TRACERS CHANGE LLG TO .T. ")')
+ENDIF
+IF (LLG) THEN
+ IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ ELSE
+ IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO LAGRANGIAN VARIABLES IN INITIAL FMFILE",/,&
+ & "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")')
+ LINIT_LG=.TRUE.
+ ENDIF
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ END IF
+END IF
+!
+!
+! LINOx SV case
+!
+IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN
+ IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ &IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Passive pollutant case
+!
+IF (LPASPOL) THEN
+ IF (OPASPOL) THEN
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ END IF
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire
+!
+IF (LFOREFIRE) THEN
+ IF (OFOREFIRE) THEN
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT'
+ END IF
+END IF
+#endif
+! Blaze smoke
+!
+IF (LBLAZE) THEN
+ IF (OFIRE) THEN
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO BLAZE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
+ END IF
+END IF
+!
+! Conditional sampling case
+!
+IF (LCONDSAMP) THEN
+ IF (OCONDSAMP) THEN
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ END IF
+END IF
+!
+! Blowing snow scheme
+!
+IF (LBLOWSNOW) THEN
+ IF (OBLOWSNOW) THEN
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR BLOWING SNOW &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT'
+ END IF
+END IF
+!
+!
+!
+!* 3.5 Check coherence between the radiation control parameters
+!
+IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN
+ IF(CLW == 'RRTM' .AND. COPILW == 'SMSH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the SMSH parametrisation of LW optical properties for cloud ice'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPILW) can not be used with RRTM radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF(CLW == 'MORC' .AND. COPWLW == 'LILI') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the LILI parametrisation of LW optical properties for cloud water'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPWLW) can not be used with MORC radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF( .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE IF (CLW == 'MORC') THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE MORCRETTE LW SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=6 IN ini_radconf.f90'
+ ENDIF
+!
+ IF( LCLEAR_SKY .AND. XDTRAD_CLONLY /= XDTRAD) THEN
+ ! Check the validity of the LCLEAR_SKY approximation
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE CLEAR-SKY APPROXIMATION'
+ WRITE(UNIT=ILUOUT,FMT=*) '(i.e. AVERAGE THE WHOLE CLOUDFREE VERTICALS BUT KEEP'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ALL THE CLOUDY VERTICALS) AND'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD-ONLY APPROXIMATION (i.e. YOU CALL MORE OFTEN THE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RADIATIONS FOR THE CLOUDY VERTICALS THAN FOR CLOUDFREE ONES).'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE, SO CHOOSE BETWEEN :'
+ WRITE(UNIT=ILUOUT,FMT=*) 'XDTRAD_CLONLY = XDTRAD and LCLEAR_SKY = FALSE'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF( XDTRAD_CLONLY > XDTRAD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BAD USE OF THE CLOUD-ONLY APPROXIMATION " ,&
+ &" XDTRAD SHOULD BE LARGER THAN XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF(( XDTRAD < XTSTEP ).OR. ( XDTRAD_CLONLY < XTSTEP )) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THE RADIATION CALL XDTRAD OR XDTRAD_CLONLY " ,&
+ &" IS MORE FREQUENT THAN THE TIME STEP SO ADJUST XDTRAD OR XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
+ CGETRAD='READ'
+ IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU ARE PERFORMING A RESTART. FOR THIS SEGMENT, YOU ARE USING A RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SCHEME AND NO RADIATION SCHEME WAS USED FOR THE PREVIOUS SEGMENT.'
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='RESTA' .AND. (.NOT. LAERO_FT) .AND. (.NOT. LORILAM) &
+ .AND. (.NOT. LSALT) .AND. (.NOT. LDUST)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) '!!! WARNING !!! FOR REPRODUCTIBILITY BETWEEN START and START+RESTART,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LAERO_FT=T WITH CAER=TEGE IF CCONF=RESTA IN ALL SEGMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO UPDATE THE OZONE AND AEROSOLS CLIMATOLOGY USED BY THE RADIATION CODE;'
+ END IF
+END IF
+!
+! 3.6 check the initialization of the deep convection scheme
+!
+IF ( (CDCONV /= 'KAFR') .AND. &
+ (CSCONV /= 'KAFR') .AND. LCHTRANS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT IT CAN ONLY",&
+ &"BE USED FOR THE KAIN FRITSCH SCHEME ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+SELECT CASE ( CDCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH DEEP CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+END SELECT
+!
+IF ( CDCONV == 'KAFR' .AND. LCHTRANS .AND. NSV > 0 ) THEN
+ IF( OCHTRANS ) THEN
+ CGETSVCONV='READ'
+ ELSE
+ CGETSVCONV='INIT'
+ END IF
+END IF
+!
+SELECT CASE ( CSCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH SHALLOW CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+ CASE( 'EDKF' )
+ IF (CTURB == 'NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE EDKF ", &
+ &"SHALLOW CONVECTION WITHOUT TURBULENCE SCHEME : ", &
+ &"IT IS NOT POSSIBLE")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END SELECT
+!
+!
+CGETCONV = 'SKIP'
+!
+IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
+ CGETCONV = 'READ'
+ IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" YOU ARE PERFORMING A RESTART. FOR THIS ",&
+ &" SEGMENT, YOU ARE USING A DEEP CONVECTION SCHEME AND NO DEEP ",&
+ &" CONVECTION SCHEME WAS USED FOR THE PREVIOUS SEGMENT. ")')
+!
+ CGETCONV = 'INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETCONV = 'INIT'
+ END IF
+END IF
+!
+!* 3.7 configuration and model version
+!
+IF (KMI == 1) THEN
+!
+ IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' &
+ .AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 1D MODEL VERSION WITH NON-CYCL",&
+ & "CLBCX OR CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (L2D.AND.(CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2D MODEL VERSION WITH NON-CYCL",&
+ & " CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ !
+ IF ( (.NOT. LCARTESIAN) .AND. ( LCORIO) .AND. (.NOT. LGEOST_UV_FRC) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BE CAREFUL YOU COULD HAVE SPURIOUS MOTIONS " ,&
+ & " NEAR THE LBC AS LCORIO=T and LGEOST_UV_FRC=F")')
+ END IF
+ !
+ IF ((.NOT.LFLAT).AND.OFLAT) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'ZERO OROGRAPHY IN INITIAL FILE'
+ WRITE(UNIT=ILUOUT,FMT=*) '***** ALL TERMS HAVE BEEN NEVERTHELESS COMPUTED WITHOUT SIMPLIFICATION*****'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS SHOULD LEAD TO ERRORS IN THE PRESSURE COMPUTATION'
+ END IF
+ IF (LFLAT.AND.(.NOT.OFLAT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" OROGRAPHY IS NOT EQUAL TO ZERO ", &
+ & "IN INITIAL FILE" ,/, &
+ & "******* OROGRAPHY HAS BEEN SET TO ZERO *********",/, &
+ & "ACCORDING TO ZERO OROGRAPHY, SIMPLIFICATIONS HAVE ", &
+ & "BEEN MADE IN COMPUTATIONS")')
+ END IF
+END IF
+!
+!* 3.8 System of equations
+!
+IF ( HEQNSYS /= CEQNSYS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU HAVE CHANGED THE SYSTEM OF EQUATIONS'
+ WRITE(ILUOUT,FMT=*) 'THE ANELASTIC CONSTRAINT IS PERHAPS CHANGED :'
+ WRITE(ILUOUT,FMT=*) 'FOR THE INITIAL FILE YOU HAVE USED ',HEQNSYS
+ WRITE(ILUOUT,FMT=*) 'FOR THE RUN YOU PLAN TO USE ',CEQNSYS
+ WRITE(ILUOUT,FMT=*) 'THIS CAN LEAD TO A NUMERICAL EXPLOSION IN THE FIRST TIME STEPS'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+! 3.9 Numerical schemes
+!
+IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. &
+ (CTEMP_SCHEME /= 'LEFR') .AND. (CTEMP_SCHEME /= 'RKC4') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("CEN4TH SCHEME HAS TO BE USED WITH ",&
+ &"CTEMP_SCHEME = LEFR of RKC4 ONLY")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( (CUVW_ADV_SCHEME == 'WENO_K') .AND. LNUMDIFU ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE NUMERICAL DIFFUSION ",&
+ &"WITH WENO SCHEME ALREADY DIFFUSIVE")')
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 4. CHECK COHERENCE BETWEEN EXSEG VARIABLES
+! ---------------------------------------
+!
+!* 4.1 coherence between coupling variables in EXSEG file
+!
+IF (KMI == 1) THEN
+ NCPL_NBR = 0
+ DO JCI = 1,JPCPLFILEMAX
+ IF (LEN_TRIM(CCPLFILE(JCI)) /= 0) THEN ! Finds the number
+ NCPL_NBR = NCPL_NBR + 1 ! of coupling files
+ ENDIF
+ IF (JCI/=JPCPLFILEMAX) THEN ! Deplaces the coupling files
+ IF ((LEN_TRIM(CCPLFILE(JCI)) == 0) .AND. &! names if one missing
+ (LEN_TRIM(CCPLFILE(JCI+1)) /= 0)) THEN
+ DO JI=JCI,JPCPLFILEMAX-1
+ CCPLFILE(JI)=CCPLFILE(JI+1)
+ END DO
+ CCPLFILE(JPCPLFILEMAX)=' '
+ END IF
+ END IF
+ END DO
+!
+ IF (NCPL_NBR /= 0) THEN
+ LSTEADYLS = .FALSE.
+ ELSE
+ LSTEADYLS = .TRUE.
+ ENDIF
+END IF
+!
+!* 4.3 check consistency in forcing switches
+!
+IF ( LFORCING ) THEN
+ IF ( LRELAX_THRV_FRC .AND. ( LTEND_THRV_FRC .OR. LGEOST_TH_FRC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) &
+ 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
+ WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
+ END IF
+!
+ IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
+ WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
+ WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CRELAX_HEIGHT_TYPE.NE."FIXE" .AND. CRELAX_HEIGHT_TYPE.NE."THGR" ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'CRELAX_HEIGHT_TYPE MUST BE EITHER "FIXE" OR "THGR"'
+ WRITE(ILUOUT,FMT=*) 'BUT IT IS "', CRELAX_HEIGHT_TYPE, '"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( .NOT.LCORIO .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT HAVE A GEOSTROPHIC FORCING WITHOUT'
+ WRITE(ILUOUT,FMT=*) 'ACTIVATING LCORIOLIS OPTION'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( LPGROUND_FRC ) THEN
+ WRITE(ILUOUT,FMT=*) 'SURFACE PRESSURE FORCING NOT YET IMPLEMENTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+END IF
+!
+IF (LTRANS .AND. .NOT. LFLAT ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU ASK FOR A CONSTANT SPEED DOMAIN TRANSLATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NOT IN THE FLAT TERRAIN CASE:'
+ WRITE(ILUOUT,FMT=*) 'THIS IS NOT ALLOWED ACTUALLY'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+!* 4.4 Check the coherence between the LUSERn and LHORELAX
+!
+IF (.NOT. LUSERV .AND. LHORELAX_RV) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RV FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (.NOT. LUSERC .AND. LHORELAX_RC) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (.NOT. LUSERR .AND. LHORELAX_RR) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RR FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (.NOT. LUSERI .AND. LHORELAX_RI) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RI FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (.NOT. LUSERS .AND. LHORELAX_RS) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RS FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (.NOT. LUSERG .AND. LHORELAX_RG) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RG FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (.NOT. LUSERH .AND. LHORELAX_RH) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RH FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (CTURB=='NONE' .AND. LHORELAX_TKE) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX TKE FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+IF (CCLOUD/='C2R2' .AND. CCLOUD/='KHKO' .AND. LHORELAX_SVC2R2) THEN
+ LHORELAX_SVC2R2=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C2R2 or KHKO FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC2R2=FALSE'
+END IF
+!
+IF (CCLOUD/='C3R5' .AND. LHORELAX_SVC1R3) THEN
+ LHORELAX_SVC1R3=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C3R5 FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC1R3=FALSE'
+END IF
+!
+IF (CCLOUD/='LIMA' .AND. LHORELAX_SVLIMA) THEN
+ LHORELAX_SVLIMA=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX LIMA FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVLIMA=FALSE'
+END IF
+!
+IF (CELEC(1:3) /= 'ELE' .AND. LHORELAX_SVELEC) THEN
+ LHORELAX_SVELEC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ELEC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVELEC=FALSE'
+END IF
+!
+IF (.NOT. LUSECHEM .AND. LHORELAX_SVCHEM) THEN
+ LHORELAX_SVCHEM=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHEM=FALSE'
+END IF
+!
+IF (.NOT. LUSECHIC .AND. LHORELAX_SVCHIC) THEN
+ LHORELAX_SVCHIC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ICE CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHIC=FALSE'
+END IF
+!
+IF (.NOT. LORILAM .AND. LHORELAX_SVAER) THEN
+ LHORELAX_SVAER=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX AEROSOL FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVAER=FALSE'
+END IF
+
+IF (.NOT. LDUST .AND. LHORELAX_SVDST) THEN
+ LHORELAX_SVDST=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX DUST FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVDST=FALSE'
+END IF
+
+IF (.NOT. LSALT .AND. LHORELAX_SVSLT) THEN
+ LHORELAX_SVSLT=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SEA SALT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSLT=FALSE'
+END IF
+
+IF (.NOT. LPASPOL .AND. LHORELAX_SVPP) THEN
+ LHORELAX_SVPP=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX PASSIVE POLLUTANT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVPP=FALSE'
+END IF
+#ifdef MNH_FOREFIRE
+IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN
+ LHORELAX_SVFF=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX FOREFIRE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE'
+END IF
+#endif
+IF (.NOT. LBLAZE .AND. LHORELAX_SVFIRE) THEN
+ LHORELAX_SVFIRE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLAZE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFIRE=FALSE'
+END IF
+IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN
+ LHORELAX_SVCS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CONDITIONAL SAMPLING FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCS=FALSE'
+END IF
+
+IF (.NOT. LBLOWSNOW .AND. LHORELAX_SVSNW) THEN
+ LHORELAX_SVSNW=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLOWING SNOW FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSNW=FALSE'
+END IF
+
+IF (ANY(LHORELAX_SV(NSV+1:))) THEN
+ LHORELAX_SV(NSV+1:)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SV(NSV+1:) FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(NSV+1:)=FALSE'
+END IF
+!
+!* 4.5 check the number of points for the horizontal relaxation
+!
+IF ( NRIMX > KRIMX .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMX = KRIMX
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMX =',NRIMX
+END IF
+!
+IF ( L2D .AND. KRIMY>0 ) THEN
+ NRIMY = 0
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A 2D MODEL THEREFORE NRIMY=0 '
+END IF
+!
+IF ( NRIMY > KRIMY .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMY = KRIMY
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMY =',NRIMY
+END IF
+!
+IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
+ (.NOT. LHORELAX_SVC2R2).AND. (.NOT. LHORELAX_SVC1R3) .AND. &
+ (.NOT. LHORELAX_SVLIMA).AND. &
+ (.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. &
+ (.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. &
+ (.NOT. LHORELAX_SVCS) .AND. (.NOT. LHORELAX_SVFIRE) .AND. &
+#ifdef MNH_FOREFIRE
+ (.NOT. LHORELAX_SVFF) .AND. &
+#endif
+ (.NOT. LHORELAX_RV) .AND. (.NOT. LHORELAX_RC) .AND. &
+ (.NOT. LHORELAX_RR) .AND. (.NOT. LHORELAX_RI) .AND. &
+ (.NOT. LHORELAX_RS) .AND. (.NOT. LHORELAX_RG) .AND. &
+ (.NOT. LHORELAX_RH) .AND. (.NOT. LHORELAX_TKE) .AND. &
+ (.NOT. LHORELAX_SVCHIC).AND. &
+ (NRIMX /= 0 .OR. NRIMY /= 0)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE NRIMX=NRIMY=0 '
+ NRIMX=0
+ NRIMY=0
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (NRIMX==0 .OR. (NRIMY==0 .AND. .NOT.(L2D) ))) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NRIMX OR NRIMY=0 CHANGE YOUR VALUES '
+ WRITE(ILUOUT,FMT=*) "LHORELAX_UVWTH=",LHORELAX_UVWTH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC2R2=",LHORELAX_SVC2R2
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC1R3=",LHORELAX_SVC1R3
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLIMA=",LHORELAX_SVLIMA
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVELEC=",LHORELAX_SVELEC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHEM=",LHORELAX_SVCHEM
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFIRE=",LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF
+#endif
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCS=",LHORELAX_SVCS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SV=",LHORELAX_SV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RV=",LHORELAX_RV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RC=",LHORELAX_RC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RR=",LHORELAX_RR
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RI=",LHORELAX_RI
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RG=",LHORELAX_RG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RS=",LHORELAX_RS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RH=",LHORELAX_RH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_TKE=", LHORELAX_TKE
+ WRITE(ILUOUT,FMT=*) "NRIMX=",NRIMX
+ WRITE(ILUOUT,FMT=*) "NRIMY=",NRIMY
+ WRITE(ILUOUT,FMT=*) "L2D=",L2D
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (KMI /=1)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR A NESTED MODEL BUT THE COUPLING IS ALREADY DONE'
+ WRITE(ILUOUT,FMT=*) 'BY THE GRID NESTING. CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
+ .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
+ WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
+ELSE
+ GRELAX = .NOT.(LUSERV_G(NDAD(KMI))) .AND. LUSERV_G(KMI).AND. LHORELAX_RV
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERC) .AND. LUSERC .AND. LHORELAX_RC
+ELSE
+ GRELAX = .NOT.(LUSERC_G(NDAD(KMI))) .AND. LUSERC_G(KMI).AND. LHORELAX_RC
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RC FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERR) .AND. LUSERR .AND. LHORELAX_RR
+ELSE
+ GRELAX = .NOT.(LUSERR_G(NDAD(KMI))) .AND. LUSERR_G(KMI).AND. LHORELAX_RR
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RR FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERI) .AND. LUSERI .AND. LHORELAX_RI
+ELSE
+ GRELAX = .NOT.(LUSERI_G(NDAD(KMI))) .AND. LUSERI_G(KMI).AND. LHORELAX_RI
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RI FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERG) .AND. LUSERG .AND. LHORELAX_RG
+ELSE
+ GRELAX = .NOT.(LUSERG_G(NDAD(KMI))) .AND. LUSERG_G(KMI).AND. LHORELAX_RG
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RG FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERH) .AND. LUSERH .AND. LHORELAX_RH
+ELSE
+ GRELAX = .NOT.(LUSERH_G(NDAD(KMI))) .AND. LUSERH_G(KMI).AND. LHORELAX_RH
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RH FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERS) .AND. LUSERS .AND. LHORELAX_RS
+ELSE
+ GRELAX = .NOT.(LUSERS_G(NDAD(KMI))) .AND. LUSERS_G(KMI).AND. LHORELAX_RS
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RS FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = HTURB=='NONE' .AND. LUSETKE(1).AND. LHORELAX_TKE
+ELSE
+ GRELAX = .NOT.(LUSETKE(NDAD(KMI))) .AND. LUSETKE(KMI) .AND. LHORELAX_TKE
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE TKE FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+DO JSV = 1,NSV_USER
+!
+ IF (KMI==1) THEN
+ GRELAX = KSV_USER<JSV .AND. LUSESV(JSV,1).AND. LHORELAX_SV(JSV)
+ ELSE
+ GRELAX = .NOT.(LUSESV(JSV,NDAD(KMI))) .AND. LUSESV(JSV,KMI) .AND. LHORELAX_SV(JSV)
+ END IF
+ !
+ IF ( GRELAX ) THEN
+ LHORELAX_SV(JSV)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE ',JSV,' SV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(',JSV,')=FALSE'
+ END IF
+END DO
+!
+!* 4.6 consistency in LES diagnostics choices
+!
+IF (CLES_NORM_TYPE=='EKMA' .AND. .NOT. LCORIO) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE EKMAN NORMALIZATION'
+ WRITE(ILUOUT,FMT=*) 'BUT CORIOLIS FORCE IS NOT USED (LCORIO=.FALSE.)'
+ WRITE(ILUOUT,FMT=*) 'THEN, NO NORMALIZATION IS PERFORMED'
+ CLES_NORM_TYPE='NONE'
+END IF
+!
+!* 4.7 Check the coherence with LNUMDIFF
+!
+IF (L1D .AND. (LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE HORIZONTAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'BUT YOU ARE IN A COLUMN MODEL (L1D=.TRUE.).'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFU and LNUMDIFTH and LNUMDIFSV'
+ WRITE(ILUOUT,FMT=*) 'ARE SET TO FALSE'
+ LNUMDIFU=.FALSE.
+ LNUMDIFTH=.FALSE.
+ LNUMDIFSV=.FALSE.
+END IF
+!
+IF (.NOT. LNUMDIFTH .AND. LZDIFFU) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE HORIZONTAL DIFFUSION (LNUMDIFTH=F)'
+ WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO USE Z-NUMERICAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFTH IS SET TO TRUE'
+ LNUMDIFTH=.TRUE.
+END IF
+!
+!* 4.8 Other
+!
+IF (XTNUDGING < 4.*XTSTEP) THEN
+ XTNUDGING = 4.*XTSTEP
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("TIME SCALE FOR NUDGING CAN NOT BE SMALLER THAN", &
+ & " FOUR TIMES THE TIME STEP")')
+ WRITE(ILUOUT,FMT=*) 'XTNUDGING is SET TO ',XTNUDGING
+END IF
+!
+!
+IF (XWAY(KMI) == 3. ) THEN
+ XWAY(KMI) = 2.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY=3 DOES NOT EXIST ANYMORE; ", &
+ & " IT IS REPLACED BY XWAY=2 ")')
+END IF
+!
+IF ( (KMI == 1) .AND. XWAY(KMI) /= 0. ) THEN
+ XWAY(KMI) = 0.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY MUST BE EQUAL TO 0 FOR DAD MODEL")')
+END IF
+!
+!JUANZ ZRESI solver need BSPLITTING
+IF ( CPRESOPT == 'ZRESI' .AND. CSPLIT /= 'BSPLITTING' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("Paralleliez in Z solver CPRESOPT=ZRESI need also CSPLIT=BSPLITTING ")')
+ WRITE(ILUOUT,FMT=*) ' ERROR you have to set also CSPLIT=BSPLITTING '
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( LEN_TRIM(HINIFILEPGD)>0 ) THEN
+ IF ( CINIFILEPGD/=HINIFILEPGD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) ' ERROR : in EXSEG1.nam, in NAM_LUNITn you have CINIFILEPGD= ',CINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' whereas in .des you have CINIFILEPGD= ',HINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' Please check your Namelist '
+ WRITE(ILUOUT,FMT=*) ' For example, you may have specified the un-nested PGD file instead of the nested PGD file '
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*) ' MESONH ABORTS'
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*)
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ELSE
+ CINIFILEPGD = ''
+!* note that after a spawning, there is no value for CINIFILEPGD in the .des file,
+! so the checking cannot be made if the user starts a simulation directly from
+! a spawned file (without the prep_real_case stage)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5. WE DO NOT FORGET TO UPDATE ALL DOLLARN NAMELIST VARIABLES
+! ---------------------------------------------------------
+!
+CALL UPDATE_NAM_LUNITN
+CALL UPDATE_NAM_CONFN
+CALL UPDATE_NAM_DRAGTREEN
+CALL UPDATE_NAM_DRAGBLDGN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_ADVN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL UPDATE_NAM_PARAM_ECRADN
+#endif
+CALL UPDATE_NAM_PARAM_KAFRN
+CALL UPDATE_NAM_PARAM_MFSHALLN
+CALL UPDATE_NAM_LBCN
+CALL UPDATE_NAM_NUDGINGN
+CALL UPDATE_NAM_TURBN
+CALL UPDATE_NAM_BLANKN
+CALL UPDATE_NAM_CH_MNHCN
+CALL UPDATE_NAM_CH_SOLVERN
+CALL UPDATE_NAM_SERIESN
+CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_PROFILERn
+CALL UPDATE_NAM_STATIONn
+CALL UPDATE_NAM_FIREn
+!-------------------------------------------------------------------------------
+WRITE(UNIT=ILUOUT,FMT='(/)')
+!-------------------------------------------------------------------------------
+!
+!* 6. FORMATS
+! -------
+!
+9000 FORMAT(/,'NOTE IN READ_EXSEG FOR MODEL ', I2, ' : ',/, &
+ '--------------------------------')
+9001 FORMAT(/,'CAUTION ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------------' )
+9002 FORMAT(/,'WARNING IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------' )
+9003 FORMAT(/,'FATAL ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '--------------------------------------' )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_EXSEG_n
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
index 2ab08f041204aeff43b7d3cdd2f003c06a640dd0..64d5eec3a4b455a24aac79de5c59f425d0789e2c 100644
--- a/src/mesonh/ext/resolved_cloud.f90
+++ b/src/mesonh/ext/resolved_cloud.f90
@@ -303,7 +303,7 @@ USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED, &
PARAM_ICE
-USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM
+USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN, RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
USE MODD_SALT, ONLY: LSALT
@@ -990,8 +990,8 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF (LPTSPLIT) THEN
- CALL LIMA (1, IKU, 1, &
- PTSTEP, TPFILE, &
+ CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, &
PRHODREF, PEXNREF, ZDZZ, &
PRHODJ, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
@@ -999,7 +999,7 @@ SELECT CASE ( HCLOUD )
PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PRAINFR )
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR )
ELSE
IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
@@ -1010,14 +1010,14 @@ SELECT CASE ( HCLOUD )
PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
- IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ IF (NMOM_I.GE.1) CALL LIMA_COLD(CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_ACT, &
PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PINPRS, PINPRG, PINPRH )
!
- IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ IF (OWARM .AND. NMOM_I.GE.1) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_ACT, &
PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
@@ -1033,7 +1033,8 @@ SELECT CASE ( HCLOUD )
PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PCLDFR, PICEFR, PRAINFR, PSRCS )
ELSE IF (LPTSPLIT) THEN
- CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX, KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, &
+ CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ KRR, KMI, CCONDENS, CLAMBDA3, &
OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
PDTHRAD, PW_ACT, &
diff --git a/src/mesonh/micro/ini_lima_warm.f90 b/src/mesonh/micro/ini_lima_warm.f90
deleted file mode 100644
index aea2517cab9d168a998aa6785bd35693674050d9..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/ini_lima_warm.f90
+++ /dev/null
@@ -1,477 +0,0 @@
-!MNH_LIC Copyright 2013-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_INI_LIMA_WARM
-! #########################
-!
-INTERFACE
- SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
-!
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA_WARM
-!
-END INTERFACE
-!
-END MODULE MODI_INI_LIMA_WARM
-! #########################################
- SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
-! #########################################
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to initialize the constants used in the
-!! microphysical scheme LIMA for the warm phase species and processes.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_REF
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_LIMA_WARM
-USE MODD_PARAMETERS
-USE MODD_LUNIT, ONLY : TLUOUT0
-!
-USE MODI_LIMA_FUNCTIONS
-USE MODI_HYPGEO
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IKB ! Coordinates of the first and last physical
- ! points along z
-INTEGER :: J1 ! Internal loop indexes
-INTEGER :: JMOD ! Internal loop to index the CCN modes
-!
-REAL, DIMENSION(6) :: ZGAMC, ZGAMR ! parameters involving various moments of
- ! the generalized gamma law
-!
-REAL :: ZTT ! Temperature in Celsius
-REAL :: ZLV ! Latent heat of vaporization
-REAL :: ZSS ! Supersaturation
-REAL :: ZPSI1, ZG ! Psi1 and G functions
-REAL :: ZAHENR ! r_star (FH92)
-REAL :: ZVTRMAX ! Raindrop maximal fall velocity
-REAL :: ZRHO00 ! Surface reference air density
-REAL :: ZSURF_TEN ! Water drop surface tension
-REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
- ! discretize the HYP functions
-!
-!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
-LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
- ! listing
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. CHARACTERISTICS OF THE SPECIES
-! ------------------------------
-!
-!
-!* 1.1 Cloud droplet characteristics
-!
-XAC = (XPI/6.0)*XRHOLW
-XBC = 3.0
-XCC = XRHOLW*XG/(18.0*1.816E-5) ! Stokes flow (Pruppacher eq. 10-138 for T=293K)
-!XCC = XRHOLW*XG/(18.0*1.7E-5) ! Stokes flow (Pruppacher eq. 10-138 for T=273K)
-XDC = 2.0
-!
-XF0C = 1.00
-XF2C = 0.108
-!
-XC1C = 1./2.
-!
-!* 1.2 Raindrops characteristics
-!
-XAR = (XPI/6.0)*XRHOLW
-XBR = 3.0
-XCR = 842.
-XDR = 0.8
-!
-XF0R = 0.780
-!Correction BVIE Pruppacher 1997 eq. 13-61
-!XF1R = 0.265
-XF1R = 0.308
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
-! ----------------------------------------
-!
-!
-!* 2.1 Cloud droplet distribution
-!
-!XALPHAC = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
-!XNUC = 3.0 ! Gamma law with little dispersion
-!
-!* 2.2 Raindrop distribution
-!
-!XALPHAR = 3.0 ! Gamma law of the raindrops (here volume-like distribution)
-!XNUR = 3.0 ! Gamma law for the raindrops
-!XNUR = 0.1
-!
-!* 2.3 Precalculation of the gamma function momentum
-!
-!
-ZGAMC(1) = GAMMA_X0D(XNUC)
-ZGAMC(2) = MOMG(XALPHAC,XNUC,3.)
-ZGAMC(3) = MOMG(XALPHAC,XNUC,6.)
-ZGAMC(4) = ZGAMC(3)-ZGAMC(2)**2 ! useful for Sig_c
-ZGAMC(5) = MOMG(XALPHAC,XNUC,9.)
-ZGAMC(6) = MOMG(XALPHAC,XNUC,3.)**(2./3.)/MOMG(XALPHAC,XNUC,2.)
-!
-ZGAMR(1) = GAMMA_X0D(XNUR)
-ZGAMR(2) = MOMG(XALPHAR,XNUR,3.)
-ZGAMR(3) = MOMG(XALPHAR,XNUR,6.)
-ZGAMR(4) = MOMG(XALPHAR,XNUR,6.)
-ZGAMR(5) = MOMG(XALPHAR,XNUR,9.)
-ZGAMR(6) = MOMG(XALPHAR,XNUR,3.)**(2./3.)/MOMG(XALPHAR,XNUR,2.)
-!
-!* 2.4 Csts for the shape parameter
-!
-XLBC = XAR*ZGAMC(2)
-XLBEXC = 1.0/XBC
-!
-XNR = 1.0/(XAR*MOMG(XALPHAR,XNUR,XBR))
-XCCR = 8.E6
-XCXR = -1.
-IF (NMOM_R.EQ.1) THEN
- XLBEXR = 1.0/(XCXR-XBR)
- XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
-ELSE
- XLBR = XAR*ZGAMR(2)
- XLBEXR = 1.0/XBR
-END IF
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 3. CONSTANTS FOR THE SEDIMENTATION
-! -------------------------------
-!
-!
-!* 4.1 Exponent of the fall-speed air density correction
-!
-IKB = 1 + JPVEXT
-! Correction
-!ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
-ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C
-!
-!* 4.2 Constants for sedimentation
-!
-XFSEDRR = XCR*GAMMA_X0D(XNUR+(XDR+3.)/XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)* &
- (ZRHO00)**XCEXVT
-XFSEDCR = XCR*GAMMA_X0D(XNUR+XDR/XALPHAR)/GAMMA_X0D(XNUR)* &
- (ZRHO00)**XCEXVT
-XFSEDRC = XCC*GAMMA_X0D(XNUC+(XDC+3.)/XALPHAC)/GAMMA_X0D(XNUC+3./XALPHAC)* &
- (ZRHO00)**XCEXVT
-XFSEDCC = XCC*GAMMA_X0D(XNUC+XDC/XALPHAC)/GAMMA_X0D(XNUC)* &
- (ZRHO00)**XCEXVT
-
-!
-XLB(2) = XLBC
-XLBEX(2) = XLBEXC
-XD(2) = XDC
-XFSEDR(2) = XFSEDRC
-XFSEDC(2) = XFSEDCC
-!
-XLB(3) = XLBR
-XLBEX(3) = XLBEXR
-XD(3) = XDR
-XFSEDR(3) = XFSEDRR
-XFSEDC(3) = XFSEDCR
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 4. CONSTANTS FOR THE NUCLEATION PROCESS
-! ------------------------------------
-!
-!
-XWMIN = 0.01 ! Minimal positive vertical velocity required
- ! for the activation process in Twomey and CPB scheme
-XTMIN = -0.000278 ! Minimal cooling required 1K/h
-!
-XDIVA = 226.E-7 ! Diffusivity of water vapor in the air
-XTHCO = 24.3E-3 ! Air thermal conductivity
-!
-! ( 8 Mw (Sigma)sw )3 Pi*Rho_l
-! XCSTDCRIT = ( -------------- ) * --------
-! ( 3 Ra Rhow ) 6
-!
-ZSURF_TEN = 76.1E-3 ! Surface tension of a water drop at T=0 C
-XCSTDCRIT = (XPI/6.)*XRHOLW*( (8.0*ZSURF_TEN )/( 3.0*XRV*XRHOLW ) )**3
-!
-!
-!
-! 4.1 Tabulation of the hypergeometric functions in 'no units'
-! --------------------------------------------------------
-!
-! In LIMA's nucleation parameterization,
-! supersaturation is not in % : Smax=0.01 for a 1% supersaturation.
-! This is accounted for in the modified Beta and C values.
-!
-! Here, we tabulate the
-! F(mu,k/2, k/2+1 ,-Beta S**2) -> XHYPF12
-! F(mu,k/2,(k+3)/2,-Beta S**2) -> XHYPF32 functions
-! using a logarithmic scale for S
-!
-NHYP = 500 ! Number of points for the tabulation
-ALLOCATE (XHYPF12( NHYP, NMOD_CCN ))
-ALLOCATE (XHYPF32( NHYP, NMOD_CCN ))
-!
-ZSMIN = 1.0E-5 ! Minimum supersaturation set at 0.001 %
-ZSMAX = 5.0E-2 ! Maximum supersaturation set at 5 %
-XHYPINTP1 = REAL(NHYP-1)/LOG(ZSMAX/ZSMIN)
-XHYPINTP2 = REAL(NHYP)-XHYPINTP1*LOG(ZSMAX)
-!
-DO JMOD = 1,NMOD_CCN
- DO J1 = 1,NHYP
- ZSS =ZSMAX*(ZSMIN/ZSMAX)**(REAL(NHYP-J1)/REAL(NHYP-1))
- XHYPF12(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
- 0.5*XKHEN_MULTI(JMOD)+1.0,XBETAHEN_MULTI(JMOD),ZSS)
- XHYPF32(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
- 0.5*XKHEN_MULTI(JMOD)+1.5,XBETAHEN_MULTI(JMOD),ZSS)
- END DO
-ENDDO
-!
-NAHEN = 81 ! Tabulation for each Kelvin degree in the range XTT-40 to XTT+40
-XAHENINTP1 = 1.0
-XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
-!
-! Compute the tabulation of function of T :
-!
-! 1
-! XAHENG = -----------------------
-! XCSTHEN * G**(3/2)
-!
-! Compute constants for the calculation of Smax.
-! XCSTHEN = 1/(rho_l 2 pi)
-! PSI1
-! PSI3
-! T
-! Lv
-! G
-!
-ALLOCATE (XAHENG(NAHEN))
-ALLOCATE (XAHENG2(NAHEN))
-ALLOCATE (XAHENG3(NAHEN))
-ALLOCATE (XPSI1(NAHEN))
-ALLOCATE (XPSI3(NAHEN))
-XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
-DO J1 = 1,NAHEN
- ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
- ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
- XPSI1(J1) = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
- XPSI3(J1) = -1*XMV*ZLV/(XMD*XRD*(ZTT**2)) ! Psi3
- ZG = 1./( XRHOLW*( (XRV*ZTT)/ & ! G
- (XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
- + (ZLV/ZTT)**2/(XTHCO*XRV) ) )
- XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
- XAHENG2(J1) = 1/(ZG)**(1./2.) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
- XAHENG3(J1) = (ZG) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
-END DO
-!-------------------------------------------------------------------------------
-!
-! Parameters used to initialise the droplet and drop concentration
-! from the respective mixing ratios (used in RESTART_RAIN_C2R2)
-!
-! Droplet case
-!
-!!ALLOCATE(XCONCC_INI(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3),SIZE(PNFS,4))) !NMOD_CCN))
-!! XCONCC_INI(:,:,:,:) = 0.8 * PNFS(:,:,:,:) ! 80% of the maximum CCN conc. is assumed
-!
-! Raindrop case
-!
-XCONCR_PARAM_INI = (1.E7)**3/(XPI*XRHOLW) ! MP law with N_O=1.E7 m-1 is assumed
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 5. CONSTANTS FOR THE COALESCENCE PROCESSES
-! ---------------------------------------
-!
-!
-!* 6.1 Csts for the coalescence processes
-!
-XKERA1 = 2.59E15 ! From Long a1=9.44E9 cm-3 so XKERA1= 9.44E9*1E6*(PI/6)**2
-XKERA2 = 3.03E3 ! From Long a2=5.78E3 so XKERA2= 5.78E3* (PI/6)
-!
-! Cst for the cloud droplet selfcollection process
-!
-XSELFC = XKERA1*ZGAMC(3)
-!
-! Cst for the autoconversion process
-!
-XAUTO1 = 6.25E18*(ZGAMC(2))**(1./3.)*SQRT(ZGAMC(4))
-XAUTO2 = 0.5E6*(ZGAMC(4))**(1./6.)
-XLAUTR = 2.7E-2
-XLAUTR_THRESHOLD = 0.4
-XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
-XITAUTR_THRESHOLD = 7.5
-XCAUTR = 3.5E9
-XR0 = 25.0E-6
-!
-! Cst for the accretion process
-!
-XACCR1 = ZGAMR(2)**(1./3.)
-XACCR2 = 5.0E-6
-XACCR3 = 12.6E-4
-XACCR4 = XAUTO2
-XACCR5 = 3.5
-XACCR6 = 1.2*XCAUTR
-XACCR_CLARGE1 = XKERA2*ZGAMC(2)
-XACCR_CLARGE2 = XKERA2*ZGAMR(2)
-XACCR_RLARGE1 = XKERA2*ZGAMC(3)*XRHOLW*(XPI/6.0)
-XACCR_RLARGE2 = XKERA2*ZGAMC(2)*ZGAMR(2)*XRHOLW*(XPI/6.0)
-XACCR_CSMALL1 = XKERA1*ZGAMC(3)
-XACCR_CSMALL2 = XKERA1*ZGAMR(3)
-XACCR_RSMALL1 = XKERA1*ZGAMC(5)*XRHOLW*(XPI/6.0)
-XACCR_RSMALL2 = XKERA1*ZGAMC(2)*ZGAMR(3)*XRHOLW*(XPI/6.0)
-!
-! ICE3 accretion of cloud droplets by rain drops
-!
-XFCACCR = (XPI/4.0)*XCCR*XCR*(ZRHO00**XCEXVT)*MOMG(XALPHAR,XNUR,XDR+2.0)
-XEXCACCR = -XDR-3.0
-!
-! Cst for the raindrop self-collection/breakup process
-!
-XSCBU2 = XKERA2*ZGAMR(2)
-XSCBU3 = XKERA1*ZGAMR(3)
-XSCBU_EFF1 = 0.6E-3
-XSCBU_EFF2 = 2.0E-3
-XSCBUEXP1 = -2500.0
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 6. CONSTANTS FOR THE "SONTANEOUS" BREAK-UP
-! ---------------------------------------
-!
-!
-XSPONBUD1 = 3.0E-3
-XSPONBUD2 = 4.0E-3
-XSPONBUD3 = 5.0E-3
-XSPONCOEF2 = ((XSPONBUD3/XSPONBUD2)**3 - 1.0)/(XSPONBUD3-XSPONBUD1)**2
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 7. CONSTANTS FOR EVAPORATION PROCESS
-! ---------------------------------------
-!
-!
-X0CNDC = (4.0*XPI)*XC1C*XF0C*MOMG(XALPHAC,XNUC,1.)
-X2CNDC = (4.0*XPI)*XC1C*XF2C*XCC*MOMG(XALPHAC,XNUC,XDC+2.0)
-!
-! Valeurs utiles pour le calcul de l'évaporation en fonction de N_r
-!
-!XEX0EVAR = -1.0
-!XEX1EVAR = -1.0 - (XDR+1.0)*0.5
-!XEX2EVAR = -0.5*XCEXVT
-!
-!X0EVAR = (2.0*XPI)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR)
-!X1EVAR = (2.0*XPI)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
-! GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR)
-!
-!
-! Valeurs utiles pour le calcul de l'évaporation en fonction de r_r
-!
-XEX0EVAR = 2.0
-XEX1EVAR = 2.0 - (XDR+1.0)*0.5
-XEX2EVAR = -0.5*XCEXVT
-!
-X0EVAR = (12.0)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)
-X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
- GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR+3./XALPHAR)
-!
-XCEVAP = 0.86
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 8. SET-UP RADIATIVE PARAMETERS
-! ---------------------------
-!
-!
-! R_eff_c = XFREFFC * (rho*r_c/N_c)**(1/3)
-!
-!
-XFREFFC = 0.5 * ZGAMC(6) * (1.0/XAC)**(1.0/3.0)
-XFREFFR = 0.5 * ZGAMR(6) * (1.0/XAR)**(1.0/3.0)
-!
-! Coefficients used to compute reff when both cloud and rain are present
-!
-XCREC = 1.0/ (ZGAMC(6) * XAC**(2.0/3.0))
-XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 9. SOME PRINTS FOR CONTROL
-! -----------------------
-!
-!
-GFLAG = .TRUE.
-IF (GFLAG) THEN
- ILUOUT0 = TLUOUT0%NLU
- WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
- WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCC,XDC
- WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
- XALPHAC,XNUC
- WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
- WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
- XAR,XBR
- WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
- XCR,XDR
-!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
-!!$ XALPHAR,XNUR
-!!$ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
-!!$ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
-!!$ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
-!!$ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
-END IF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE INI_LIMA_WARM
diff --git a/src/mesonh/micro/lima_adjust.f90 b/src/mesonh/micro/lima_adjust.f90
index 54b749e8be0e1166ef23eda588f09ffb95cc164b..abfe49fb7ebc640c3de1588cc78a245db2e6745a 100644
--- a/src/mesonh/micro/lima_adjust.f90
+++ b/src/mesonh/micro/lima_adjust.f90
@@ -168,8 +168,8 @@ use mode_tools, only: Countjv
!
USE MODI_CONDENS
USE MODI_CONDENSATION
-USE MODI_LIMA_FUNCTIONS
-USE MODI_LIMA_CCN_ACTIVATION
+USE MODE_LIMA_FUNCTIONS
+USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -357,22 +357,22 @@ PCIT(:,:,:) = 0.
PCCS(:,:,:) = 0.
PCIS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
!
IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
!
-IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+IF ( NMOM_C.GE.2 .AND. NMOD_CCN.GE.1 ) THEN
ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
END IF
!
-IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IFN.GE.1 ) THEN
ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
@@ -390,13 +390,13 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
+ if ( nmom_c.ge.2) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. nmom_i.ge.2) &
+ if ( nmom_i.ge.2) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ if ( nmom_c.ge.2 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
@@ -404,7 +404,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
- if ( lcold ) then
+ if ( nmom_i.ge.2 ) then
do jl = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
@@ -1096,7 +1096,7 @@ WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
PCIS(:,:,:) = 0.0
END WHERE
!
-IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
+IF (NMOM_I.GE.2 .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
ZW1(:,:,:) = 0.
IF (NMOD_IFN .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PINS,DIM=4)
IF (NMOD_IMM .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PNIS,DIM=4)
@@ -1108,7 +1108,7 @@ IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
ENDWHERE
END IF
!
-IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
+IF (NMOM_I.GE.2 .AND. NMOD_IFN.GE.1) THEN
DO JMOD_IFN = 1, NMOD_IFN
PIFS(:,:,:,JMOD_IFN) = PIFS(:,:,:,JMOD_IFN) + &
ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
@@ -1118,7 +1118,7 @@ IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
ENDDO
END IF
!
-IF (LCOLD .AND. NMOD_IMM.GE.1) THEN
+IF (NMOM_I.GE.2 .AND. NMOD_IMM.GE.1) THEN
JMOD_IMM = 0
DO JMOD = 1, NMOD_CCN
IF (NIMM(JMOD) == 1) THEN
@@ -1145,7 +1145,7 @@ WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
END WHERE
!
ZW1(:,:,:) = 0.
-IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+IF (NMOM_C.GE.2 .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
ZW2(:,:,:) = 0.
WHERE ( ZW(:,:,:) > 0. )
@@ -1153,7 +1153,7 @@ WHERE ( ZW(:,:,:) > 0. )
ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
ENDWHERE
!
-IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+IF (NMOM_C.GE.2 .AND. NMOD_CCN.GE.1) THEN
DO JMOD = 1, NMOD_CCN
PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
@@ -1230,22 +1230,22 @@ IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
!
IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
!
-IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+IF ( NMOM_C.GE.2 .AND. NMOD_CCN.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
END IF
!
-IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IFN.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
END IF
!
-IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+IF ( NMOM_I.GE.2 .AND. NMOD_IMM.GE.1 ) THEN
PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
END IF
!
@@ -1281,13 +1281,13 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) &
+ if ( nmom_c.ge.2) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. nmom_i.ge.2) &
+ if ( nmom_i.ge.2) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
- if ( lwarm ) then
+ if ( nmom_c.ge.2 ) then
do jl = 1, nmod_ccn
idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
@@ -1295,7 +1295,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
- if ( lcold ) then
+ if ( nmom_i.ge.2 ) then
do jl = 1, nmod_ifn
idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
diff --git a/src/mesonh/micro/lima_cold.f90 b/src/mesonh/micro/lima_cold.f90
index 56ee422eb7a119cf64698742900da317719b4c39..b4c6b16540847310eea1d18a38e22c5713e339d0 100644
--- a/src/mesonh/micro/lima_cold.f90
+++ b/src/mesonh/micro/lima_cold.f90
@@ -8,7 +8,7 @@
! #####################
!
INTERFACE
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ SUBROUTINE LIMA_COLD (CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRT, PSVT, &
@@ -16,6 +16,9 @@ INTERFACE
PINPRS, PINPRG, PINPRH)
!
USE MODD_NSV, only: NSV_LIMA_BEG
+USE MODD_CST, ONLY: CST_t
+!
+TYPE(CST_t), INTENT(IN) :: CST
!
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
@@ -52,7 +55,7 @@ END INTERFACE
END MODULE MODI_LIMA_COLD
!
! ######################################################################
- SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ SUBROUTINE LIMA_COLD (CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRT, PSVT, &
@@ -111,6 +114,7 @@ END MODULE MODI_LIMA_COLD
!* 0. DECLARATIONS
! ------------
+USE MODD_CST, ONLY: CST_t
use modd_budget, only: lbu_enable, &
lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
@@ -131,6 +135,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
@@ -261,16 +267,16 @@ PCSS(:,:,:) = 0.
PCGS(:,:,:) = 0.
PCHS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCST(:,:,:) = PSVT(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NH)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
@@ -323,9 +329,9 @@ END IF
!
if ( lbu_enable ) then
if ( lbudget_ri .and. osedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv .and. osedi ) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
if (NMOM_S.GE.2) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', pcss(:, :, :) * prhodj(:, :, :) )
@@ -341,9 +347,9 @@ CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PCSS=PCSS, PCGS=PCGS, PCHS=PCHS )
if ( lbu_enable ) then
if ( lbudget_ri .and. osedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv .and. osedi ) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
if (NMOM_S.GE.2) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ns), 'SEDI', pcss(:, :, :) * prhodj(:, :, :) )
@@ -367,7 +373,7 @@ IF (LNUCL) THEN
PTHS, PRVS, PRCS, PRIS, &
PCCS, PCIS, PINS )
ELSE
- CALL LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ CALL LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
@@ -375,7 +381,7 @@ IF (LNUCL) THEN
PNAS, PIFS, PINS, PNIS )
END IF
!
- IF (LWARM .OR. (LHHONI .AND. NMOD_CCN.GE.1)) THEN
+ IF (NMOM_C.GE.1 .OR. (LHHONI .AND. NMOD_CCN.GE.1)) THEN
CALL LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_NU, &
@@ -393,7 +399,7 @@ END IF
!* 4. SLOW PROCESSES: depositions, aggregation
! ----------------------------------------
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
!
IF(NMOM_S.GE.2) THEN
CALL LIMA_COLD_SLOW_PROCESSES(PTSTEP, KMI, PZZ, PRHODJ, &
@@ -449,9 +455,9 @@ IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
-IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
IF ( NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = PCSS(:,:,:)
IF ( NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = PCGS(:,:,:)
IF ( NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = PCHS(:,:,:)
diff --git a/src/mesonh/micro/lima_cold_hom_nucl.f90 b/src/mesonh/micro/lima_cold_hom_nucl.f90
index 407ae868d0a8dc3de26edbc0c024a60fe0c4ba79..cf9fbfe5898328b4b9f941a15c5a8b6fcefbb910 100644
--- a/src/mesonh/micro/lima_cold_hom_nucl.f90
+++ b/src/mesonh/micro/lima_cold_hom_nucl.f90
@@ -104,7 +104,7 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI,
XG
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, LWARM, LRAIN
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, NMOM_C, NMOM_R
USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
@@ -485,7 +485,7 @@ IF (INEGT.GT.0) THEN
! Compute the droplet homogeneous nucleation source: RCHONI
! -> Pruppacher(1995)
!
-IF (LWARM) THEN
+IF (NMOM_C.GE.2) THEN
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONC', &
Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
@@ -547,7 +547,7 @@ END IF
!
! Compute the drop homogeneous nucleation source: RRHONG
!
-IF (LWARM .AND. LRAIN) THEN
+IF (NMOM_R.GE.2) THEN
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONR', &
Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
diff --git a/src/mesonh/micro/lima_cold_slow_processes.f90 b/src/mesonh/micro/lima_cold_slow_processes.f90
index 0f74d6562a71c2d67b28f644df40dd449eb50bdd..64917a92a27c4bc1f32425e3d931f9919750fd89 100644
--- a/src/mesonh/micro/lima_cold_slow_processes.f90
+++ b/src/mesonh/micro/lima_cold_slow_processes.f90
@@ -98,7 +98,7 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
USE MODD_NSV, ONLY: NSV_LIMA_NI, NSV_LIMA_NS
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: LSNOW, LSNOW_T, XRTMIN, XCTMIN, &
+USE MODD_PARAM_LIMA, ONLY: LSNOW_T, XRTMIN, XCTMIN, &
XALPHAI, XALPHAS, XNUI, XNUS, NMOM_S
USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XNS, XBI, XCXS, XCCS, &
XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
diff --git a/src/mesonh/micro/lima_functions.f90 b/src/mesonh/micro/lima_functions.f90
deleted file mode 100644
index b5a8f17d782405a0467ae9e39bc3d7cf8faf4b6a..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_functions.f90
+++ /dev/null
@@ -1,307 +0,0 @@
-!MNH_LIC Copyright 2016-2019 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.
-!-----------------------------------------------------------------
-! Modifications:
-! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
-! P. Wautelet 19/04/2019: use modd_precision kinds
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!-----------------------------------------------------------------
-!#################################
- MODULE MODI_LIMA_FUNCTIONS
-!#################################
-!
-INTERFACE
-!
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
- REAL, INTENT(IN) :: PALPHA
- REAL, INTENT(IN) :: PNU
- REAL, INTENT(IN) :: PP
- REAL :: PMOMG
-END FUNCTION MOMG
-!
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-END FUNCTION RECT
-!
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-END FUNCTION DELTA
-!
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-END FUNCTION DELTA_VEC
-!
-SUBROUTINE GAULAG(x,w,n,alf)
- INTEGER, INTENT(IN) :: n
- REAL, INTENT(IN) :: alf
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAULAG
-!
-SUBROUTINE GAUHER(x,w,n)
- INTEGER, INTENT(IN) :: n
- REAL, DIMENSION(n), INTENT(INOUT) :: w, x
-END SUBROUTINE GAUHER
-!
-END INTERFACE
-!
-END MODULE MODI_LIMA_FUNCTIONS
-!
-!------------------------------------------------------------------------------
-!
-!###########################################
-FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
-!###########################################
-!
-! auxiliary routine used to compute the Pth moment order of the generalized
-! gamma law
-!
- USE MODI_GAMMA
-!
- IMPLICIT NONE
-!
- REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
- REAL :: PNU ! second shape parameter of the dimensionnal distribution
- REAL :: PP ! order of the moment
- REAL :: PMOMG ! result: moment of order ZP
-!
- PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
-!
-END FUNCTION MOMG
-!
-!------------------------------------------------------------------------------
-!
-!#############################################
-FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
-!#############################################
-!
-! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PRECT
-!
- PRECT(:) = PB
- WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
- PRECT(:) = PA
- END WHERE
- RETURN
-!
-END FUNCTION RECT
-!
-!-------------------------------------------------------------------------------
-!
-!###############################################
-FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
-!###############################################
-!
-! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
-! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, INTENT(IN) :: PX1
- REAL, INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
-!
-!* local variable
-!
- REAL :: ZA
-!
- ZA = 6.0*(PA-PB)/(PX2-PX1)**3
- WHERE (PX(:).LT.PX1)
- PDELTA(:) = PA
- ELSEWHERE (PX(:).GE.PX2)
- PDELTA(:) = PB
- ELSEWHERE
- PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
- + ZA*PX1*PX2* (PX(:)) &
- - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
- + (ZA/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA
-!
-!-------------------------------------------------------------------------------
-!
-!#######################################################
-FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
-!#######################################################
-!
-! Same as DELTA for vectorized PX1 and PX2 arguments
-!
- IMPLICIT NONE
-!
- REAL, INTENT(IN) :: PA
- REAL, INTENT(IN) :: PB
- REAL, DIMENSION(:), INTENT(IN) :: PX
- REAL, DIMENSION(:), INTENT(IN) :: PX1
- REAL, DIMENSION(:), INTENT(IN) :: PX2
- REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
-!
-!* local variable
-!
- REAL, DIMENSION(SIZE(PX,1)) :: ZA
-!
- ZA(:) = 0.0
- wHERE (PX(:)<=PX1(:))
- PDELTA_VEC(:) = PA
- ELSEWHERE (PX(:)>=PX2(:))
- PDELTA_VEC(:) = PB
- ELSEWHERE
- ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
- PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
- + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
- - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
- + (ZA(:)/3.0)* (PX(:)**3)
- END WHERE
- RETURN
-!
-END FUNCTION DELTA_VEC
-!
-!-------------------------------------------------------------------------------
-!
-!###########################
-SUBROUTINE gaulag(x,w,n,alf)
-!###########################
- use modd_precision, only: MNHREAL64
-
- INTEGER n,MAXIT
- REAL alf,w(n),x(n)
- REAL(kind=MNHREAL64) :: EPS
- PARAMETER (EPS=3.D-14,MAXIT=10)
- INTEGER i,its,j
- REAL ai
- REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
-!
- REAL SUMW
-!
- do 13 i=1,n
- if(i.eq.1)then
- z=(1.+alf)*(3.+.92*alf)/(1.+2.4*n+1.8*alf)
- else if(i.eq.2)then
- z=z+(15.+6.25*alf)/(1.+.9*alf+2.5*n)
- else
- ai=i-2
- z=z+((1.+2.55*ai)/(1.9*ai)+1.26*ai*alf/(1.+3.5*ai))* &
- (z-x(i-2))/(1.+.3*alf)
- endif
- do 12 its=1,MAXIT
- p1=1.d0
- p2=0.d0
- do 11 j=1,n
- p3=p2
- p2=p1
- p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j
-11 continue
- pp=(n*p1-(n+alf)*p2)/z
- z1=z
- z=z1-p1/pp
- if(abs(z-z1).le.EPS)goto 1
-12 continue
-1 x(i)=z
- w(i)=-exp(gammln(alf+n)-gammln(real(n)))/(pp*n*p2)
-13 continue
-!
-! NORMALISATION
-!
- SUMW = 0.0
- DO 14 I=1,N
- SUMW = SUMW + W(I)
-14 CONTINUE
- DO 15 I=1,N
- W(I) = W(I)/SUMW
-15 CONTINUE
-!
- return
-END SUBROUTINE gaulag
-!
-!------------------------------------------------------------------------------
-!
-!##########################################
-SUBROUTINE gauher(x,w,n)
-!##########################################
- use modd_precision, only: MNHREAL64
-
- INTEGER n,MAXIT
- REAL w(n),x(n)
- REAL(kind=MNHREAL64) :: EPS,PIM4
- PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
- INTEGER i,its,j,m
- REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
-!
- REAL SUMW
-!
- m=(n+1)/2
- do 13 i=1,m
- if(i.eq.1)then
- z=sqrt(real(2*n+1))-1.85575*(2*n+1)**(-.16667)
- else if(i.eq.2)then
- z=z-1.14*n**.426/z
- else if (i.eq.3)then
- z=1.86*z-.86*x(1)
- else if (i.eq.4)then
- z=1.91*z-.91*x(2)
- else
- z=2.*z-x(i-2)
- endif
- do 12 its=1,MAXIT
- p1=PIM4
- p2=0.d0
- do 11 j=1,n
- p3=p2
- p2=p1
- p1=z*sqrt(2.d0/j)*p2-sqrt(dble(j-1)/dble(j))*p3
-11 continue
- pp=sqrt(2.d0*n)*p2
- z1=z
- z=z1-p1/pp
- if(abs(z-z1).le.EPS)goto 1
-12 continue
-1 x(i)=z
- x(n+1-i)=-z
- pp=pp/PIM4 ! NORMALIZATION
- w(i)=2.0/(pp*pp)
- w(n+1-i)=w(i)
-13 continue
-!
-! NORMALISATION
-!
- SUMW = 0.0
- DO 14 I=1,N
- SUMW = SUMW + W(I)
-14 CONTINUE
- DO 15 I=1,N
- W(I) = W(I)/SUMW
-15 CONTINUE
-!
- return
-END SUBROUTINE gauher
-!
-!------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/lima_inst_procs.f90 b/src/mesonh/micro/lima_inst_procs.f90
deleted file mode 100644
index 6a5aa149ea7368975e06dead5a299fc9e96d8226..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_inst_procs.f90
+++ /dev/null
@@ -1,197 +0,0 @@
-!MNH_LIC Copyright 2018-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_LIMA_INST_PROCS
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN, &
- PCF1D, PIF1D, PPF1D )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
-!
- END SUBROUTINE LIMA_INST_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_INST_PROCS
-!
-!
-! ###########################################################################
-SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PINT, &
- P_CR_BRKU, & ! spontaneous break up of drops (BRKU) : Nr
- P_TH_HONR, P_RR_HONR, P_CR_HONR, & ! rain drops homogeneous freezing (HONR) : rr, Nr, rg=-rr, th
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
- PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
- PB_CC, PB_CR, PB_CI, &
- PB_IFNN, &
- PCF1D, PIF1D, PPF1D )
-! ###########################################################################
-!
-!! PURPOSE
-!! -------
-!! Compute sources of instantaneous microphysical processes for the
-!! time-split version of LIMA
-!!
-!! AUTHOR
-!! ------
-!! B. Vié * CNRM *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/03/2018
-!!
-!-------------------------------------------------------------------------------
-!
-!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LWARM, LRAIN, NMOM_R
-!
-USE MODI_LIMA_DROPS_BREAK_UP
-USE MODI_LIMA_DROPS_HOM_FREEZING
-USE MODI_LIMA_ICE_MELTING
-
-IMPLICIT NONE
-
-
-
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PPABST ! abs. pressure at time t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PINT ! IFN C. activated at t
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_BRKU ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_HONR !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RR_HONR ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CR_HONR ! Concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_TH_IMLT !
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_RC_IMLT ! mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: P_CC_IMLT ! Concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_TH ! Cumulated theta change
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RV ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RC ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RR ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RI ! Cumulated mr change (kg/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_RG ! Cumulated mr change (kg/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CC ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration change (#/kg)
-REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
-!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
-REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
-!
-!-------------------------------------------------------------------------------
-!
-IF (LWARM .AND. LRAIN .AND. NMOM_R.GE.2) THEN
- CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, & ! no dependance on CF, IF or PF
- PCRT, PRRT, &
- P_CR_BRKU, &
- PB_CR )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCRT, &
- P_TH_HONR, P_RR_HONR, P_CR_HONR, &
- PB_TH, PB_RR, PB_CR, PB_RG )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LWARM) THEN
- CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
- PEXNREF, PPABST, & ! but ice fraction becomes cloud fraction
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & ! -> where ?
- PCIT, PINT, &
- P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
- PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
- !
- !PCF1D(:)=MAX(PCF1D(:),PIF1D(:))
- !PIF1D(:)=0.
- !
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_INST_PROCS
diff --git a/src/mesonh/micro/lima_mixed.f90 b/src/mesonh/micro/lima_mixed.f90
index 400969656b513327addf6ebc070bff61d2e22fce..96fa6513876b27137b222d8b68de552fa8b65c9a 100644
--- a/src/mesonh/micro/lima_mixed.f90
+++ b/src/mesonh/micro/lima_mixed.f90
@@ -104,9 +104,9 @@ USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XALPI, XBETAI, XGAMI
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, &
- NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL, LSNOW_T, &
- NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, &
+ NMOD_CCN, NMOD_IMM, LSNOW_T, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR
USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC, &
XLBDAS_MAX, XLBDAS_MIN, XTRANS_MP_GAMMAS, &
@@ -316,16 +316,16 @@ PCSS(:,:,:) = 0.
PCGS(:,:,:) = 0.
PCHS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCST(:,:,:) = PSVT(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NH)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
-IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_I.GE.2 ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
IF ( NMOM_S.GE.2 ) PCSS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NS)
IF ( NMOM_G.GE.2 ) PCGS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NG)
IF ( NMOM_H.GE.2 ) PCHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NH)
@@ -608,7 +608,7 @@ IF( IMICRO >= 0 ) THEN
! 3. Compute the fast RS and RG processes
! ------------------------------------
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
CALL LIMA_MIXED_FAST_PROCESSES(ZRHODREF, ZZT, ZPRES, PTSTEP, &
ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
@@ -749,12 +749,12 @@ IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
!
! Prepare 3D number concentrations
!
-PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_I.GE.2 ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
IF ( NMOM_S.GE.2 ) PSVS(:,:,:,NSV_LIMA_NS) = PCSS(:,:,:)
IF ( NMOM_G.GE.2 ) PSVS(:,:,:,NSV_LIMA_NG) = PCGS(:,:,:)
IF ( NMOM_H.GE.2 ) PSVS(:,:,:,NSV_LIMA_NH) = PCHS(:,:,:)
-PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
!
IF ( NMOD_CCN .GE. 1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
diff --git a/src/mesonh/micro/lima_mixed_fast_processes.f90 b/src/mesonh/micro/lima_mixed_fast_processes.f90
index 6537474b4c65b126bd6e1052f844cd77d45c2e8b..fbd6f4262aeee15270085e26359d1cf0939daf31 100644
--- a/src/mesonh/micro/lima_mixed_fast_processes.f90
+++ b/src/mesonh/micro/lima_mixed_fast_processes.f90
@@ -309,13 +309,13 @@ LOGICAL :: M2_ICE
!-------------------------------------------------------------------------------
!
M2_ICE = NMOM_S.GE.2 .AND. NMOM_G.GE.2
-IF (LHAIL) M2_ICE = M2_ICE .AND. NMOM_H.GE.2
+IF (NMOM_H.GE.1) M2_ICE = M2_ICE .AND. NMOM_H.GE.2
!
! #################
! FAST RS PROCESSES
! #################
!
-SNOW: IF (LSNOW) THEN
+SNOW: IF (NMOM_S.GE.1) THEN
!
!
!* 1.1 Cloud droplet riming of the aggregates
@@ -832,7 +832,7 @@ ZZW1(:,2:3) = 0.0
GACC(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) .AND. (PZT(:)<XTT)
IGACC = COUNT( GACC(:) )
!
-IF( IGACC>0 .AND. LRAIN) THEN
+IF( IGACC>0 .AND. NMOM_R.GE.2) THEN
! Budget storage
if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
@@ -1269,7 +1269,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
Unpack( pcss1d(:), mask = gmicro(:, :, :), field = pcss(:, :, :) ) * prhodj(:, :, :) )
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ng), 'WETG', &
Unpack( pcgs1d(:), mask = gmicro(:, :, :), field = pcgs(:, :, :) ) * prhodj(:, :, :) )
- if (LHAIL) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
+ if (NMOM_H.GE.2) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
Unpack( pchs1d(:), mask = gmicro(:, :, :), field = pchs(:, :, :) ) * prhodj(:, :, :) )
end if
end if
@@ -1506,7 +1506,7 @@ END WHERE
!
ZZW(:) = 0.0
NHAIL = 0.
-IF (LHAIL) NHAIL = 1.
+IF (NMOM_H.GE.1) NHAIL = 1.
DO JJ=1, SIZE(PRGT1D)
IF ( PRGT1D(JJ)>XRTMIN(6) .AND. PZT(JJ)<XTT .AND. &
(ZRDRYG(JJ)-ZZW1(JJ,2)-ZZW1(JJ,3))>(ZRWETG(JJ)-ZZW1(JJ,5)-ZZW1(JJ,6)) .AND. (ZRWETG(JJ)-ZZW1(JJ,5)-ZZW1(JJ,6))>0.0 ) THEN
@@ -1576,7 +1576,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
Unpack( pcss1d(:), mask = gmicro(:, :, :), field = pcss(:, :, :) ) * prhodj(:, :, :) )
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ng), 'WETG', &
Unpack( pcgs1d(:), mask = gmicro(:, :, :), field = pcgs(:, :, :) ) * prhodj(:, :, :) )
- if (LHAIL) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
+ if (NMOM_H.GE.2) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nh), 'WETG', &
Unpack( pchs1d(:), mask = gmicro(:, :, :), field = pchs(:, :, :) ) * prhodj(:, :, :) )
end if
end if
@@ -1767,7 +1767,7 @@ end if
! #################
!
!
-HAIL: IF (LHAIL) THEN
+HAIL: IF (NMOM_H.GE.1) THEN
!
GHAIL(:) = PRHT1D(:)>XRTMIN(7)
IHAIL = COUNT(GHAIL(:))
diff --git a/src/mesonh/micro/lima_mixed_slow_processes.f90 b/src/mesonh/micro/lima_mixed_slow_processes.f90
index 1daf983b673fe3e601bdfe4ccd33a7a5f7f93304..609f54dd8d8f6d0a7ca7af505805ca7b9be8083f 100644
--- a/src/mesonh/micro/lima_mixed_slow_processes.f90
+++ b/src/mesonh/micro/lima_mixed_slow_processes.f90
@@ -132,7 +132,7 @@ use modd_budget, only: lbu_enable, nbumod,
USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW
USE MODD_NSV
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, LSNOW, LHAIL, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, XCCG, XCXG, &
X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG, &
@@ -202,7 +202,7 @@ INTEGER :: JMOD_IFN
! ---------------------------------------------
!
!
-IF (LSNOW) THEN
+IF (NMOM_S.GE.1) THEN
ZZW(:) = 0.0
WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) )
ZZW(:) = ( ZSSI(:)/ZAI(:)/ZRHODREF(:) ) * ZCGT(:) * &
@@ -230,7 +230,7 @@ END IF
! ---------------------------------------------
!
!
-IF (LHAIL .AND. NMOM_H.GE.2) THEN
+IF (NMOM_H.GE.2) THEN
ZZW(:) = 0.0
WHERE ( (ZRHT(:)>XRTMIN(7)) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) )
ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * ZCHT(:) * &
diff --git a/src/mesonh/micro/lima_notadjust.f90 b/src/mesonh/micro/lima_notadjust.f90
index ddd221297382b329637fea4589002845dcf4a696..255eaa618018099ffbd634f2e738f5541e0a4479 100644
--- a/src/mesonh/micro/lima_notadjust.f90
+++ b/src/mesonh/micro/lima_notadjust.f90
@@ -14,6 +14,7 @@ INTERFACE
PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PICEFR, PRAINFR, PSRCS )
!
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -30,10 +31,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentrations source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
@@ -120,10 +121,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentrations source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
@@ -192,7 +193,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) then
+ if ( nmom_c.ge.2) then
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
idx = NBUDGET_SV1 - 1 + jl
@@ -206,7 +207,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
! if ( lscav .and. laero_mass ) &
! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
! * prhodj(:, :, :) )
-! if ( lcold ) then
+! if ( nmom_i.ge.2 ) then
! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
! idx = NBUDGET_SV1 - 1 + jl
@@ -611,7 +612,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- if ( lwarm .and. nmom_c.ge.2) then
+ if (nmom_c.ge.2) then
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
idx = NBUDGET_SV1 - 1 + jl
@@ -625,7 +626,7 @@ if ( nbumod == kmi .and. lbu_enable ) then
! if ( lscav .and. laero_mass ) &
! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
! * prhodj(:, :, :) )
-! if ( lcold ) then
+! if ( nmom_i.ge.2 ) then
! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
! idx = NBUDGET_SV1 - 1 + jl
diff --git a/src/mesonh/micro/lima_nucleation_procs.f90 b/src/mesonh/micro/lima_nucleation_procs.f90
deleted file mode 100644
index 07213550da89d9bb98882dbae62392b49d708ded..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_nucleation_procs.f90
+++ /dev/null
@@ -1,392 +0,0 @@
-!MNH_LIC Copyright 2018-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_LIMA_NUCLEATION_PROCS
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_NUCLEATION_PROCS
-! #############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-! #############################################################################
-!
-!! PURPOSE
-!! -------
-!! Compute nucleation processes for the time-split version of LIMA
-!!
-!! AUTHOR
-!! ------
-!! B. Vié * CNRM *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/03/2018
-! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
-! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
-! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
-! B. Vie 03/2022: Add option for 1-moment pristine ice
-!-------------------------------------------------------------------------------
-!
-use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
- lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- tbudgets
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
-USE MODD_TURB_n, ONLY : LSUBG_COND
-
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
-
-USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_CCN_HOM_FREEZING
-USE MODI_LIMA_MEYERS_NUCLEATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODE_RAIN_ICE_NUCLEATION
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-!-------------------------------------------------------------------------------
-!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHS, ZRIS, ZRVS, ZRHT, ZCIT, ZT
-!
-integer :: idx
-INTEGER :: JL
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
-
- IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
-
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_CCN_ACTIVATION( TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- END IF
-
- WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
-
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
- if ( lbu_enable ) then
- if ( lbudget_sv ) then
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
-
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
- CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
- z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
- -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- ZTHS=PTHT/PTSTEP
- ZRVS=PRVT/PTSTEP
- ZRIS=PRIT/PTSTEP
- ZRHT=0.
- ZCIT=PCIT
- ZT=PT
- CALL RAIN_ICE_NUCLEATION(1+JPHEXT, SIZE(PT,1)-JPHEXT, 1+JPHEXT, SIZE(PT,2)-JPHEXT, 1+JPVEXT, SIZE(PT,3)-JPVEXT, 6, &
- PTSTEP, PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- ZCIT, PEXNREF, ZTHS, ZRVS, ZRIS, ZT, ZRHT)
- !
-! Z_TH_HIND=ZTHS*PTSTEP-PTHT
-! Z_RI_HIND=ZRIS*PTSTEP-PRIT
-! Z_CI_HIND=ZCIT-PCIT
- PCIT=ZCIT
- PRIT=ZRIS*PTSTEP
- PTHT=ZTHS*PTSTEP
- PRVT=ZRVS*PTSTEP
-! Z_TH_HINC=0.
-! Z_RC_HINC=0.
-! Z_CC_HINC=0.
-! !
-! if ( lbu_enable ) then
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
-! z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-!
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
-! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-! end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-
- CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/mesonh/micro/lima_phillips.f90 b/src/mesonh/micro/lima_phillips.f90
index 1ca330e353e142451acd53c6bec902cae233b4b8..2374f6725e657d915e3dce6501dab6ff527b0025 100644
--- a/src/mesonh/micro/lima_phillips.f90
+++ b/src/mesonh/micro/lima_phillips.f90
@@ -8,13 +8,16 @@
! #########################
!
INTERFACE
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ SUBROUTINE LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
PCIT, PCCS, PCIS, &
PNAS, PIFS, PINS, PNIS )
!
+USE MODD_CST, ONLY: CST_t
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -59,7 +62,7 @@ END INTERFACE
END MODULE MODI_LIMA_PHILLIPS
!
! #####################################################################
- SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, &
+ SUBROUTINE LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRIS, &
@@ -128,9 +131,7 @@ use modd_budget, only: lbu_enable, nbumod,
lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
tbudgets
-USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XALPW, XBETAW, XGAMW, XPI
+USE MODD_CST, ONLY : CST_t
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_CCN_ACTI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
@@ -141,13 +142,15 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_LIMA_PHILLIPS_INTEG
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+USE MODE_LIMA_PHILLIPS_INTEG, ONLY: LIMA_PHILLIPS_INTEG
+USE MODE_LIMA_PHILLIPS_REF_SPECTRUM, ONLY: LIMA_PHILLIPS_REF_SPECTRUM
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -273,12 +276,12 @@ ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
! Temperature
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/CST%XP00 ) ** (CST%XRD/CST%XCPD)
!
! Saturation over ice
!
-ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
-ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+ZW(:,:,:) = EXP( CST%XALPI - CST%XBETAI/ZT(:,:,:) - CST%XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (CST%XMV/CST%XMD) * ZW(:,:,:) )
!
!
!-------------------------------------------------------------------------------
@@ -289,7 +292,7 @@ ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
!
!
GNEGT(:,:,:) = .FALSE.
-GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<CST%XTT-2.0 .AND. &
ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
@@ -384,17 +387,17 @@ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
! -----------------------------------------
!
!
-ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
-ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
-ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
-ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ZTCELSIUS(:) = ZZT(:)-CST%XTT ! T [°C]
+ZZW(:) = ZEXNREF(:)*( CST%XCPD+CST%XCPV*ZRVT(:)+CST%XCL*(ZRCT(:)+ZRRT(:)) &
+ +CST%XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ZLSFACT(:) = (CST%XLSTT+(CST%XCPV-CST%XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (CST%XLVTT+(CST%XCPV-CST%XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
!
-ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
-ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+ZZW(:) = EXP( CST%XALPI - CST%XBETAI/ZZT(:) - CST%XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((CST%XMV/CST%XMD)*ZZW(:)) ! Saturation over ice
!
-ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
-ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+ZZY(:) = EXP( CST%XALPW - CST%XBETAW/ZZT(:) - CST%XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((CST%XMV/CST%XMD)*ZZY(:)) ! Saturation over water
!
ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
!
@@ -423,12 +426,12 @@ END IF
!
! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
!
-CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+CALL LIMA_PHILLIPS_REF_SPECTRUM(CST, ZZT, ZSI, ZSI_W, ZZY)
!
! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
!
-CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+CALL LIMA_PHILLIPS_INTEG(CST, ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/lima_phillips_integ.f90 b/src/mesonh/micro/lima_phillips_integ.f90
deleted file mode 100644
index 3af3048c6be9e97c9e7f21db12995e446ec2c802..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_phillips_integ.f90
+++ /dev/null
@@ -1,163 +0,0 @@
-! ###############################
- MODULE MODI_LIMA_PHILLIPS_INTEG
-! ###############################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT
-REAL, DIMENSION(:), INTENT(IN) :: ZSI
-REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
-REAL, DIMENSION(:), INTENT(IN) :: ZSW
-REAL, DIMENSION(:), INTENT(IN) :: ZZY
-REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
-!
-END SUBROUTINE LIMA_PHILLIPS_INTEG
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_INTEG
-!
-! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the fraction of each aerosol
-!! species (DM1, DM2, BC, O) that may be activated, following Phillips (2008)
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT, XPI
-USE MODD_PARAM_LIMA, ONLY : XMDIAM_IFN, XSIGMA_IFN, NSPECIE, XFRAC_REF, &
- XH, XAREA1, XGAMMA, XABSCISS, XWEIGHT, NDIAM, &
- XT0, XDT0, XDSI0, XSW0, XTX1, XTX2
-USE MODI_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
-USE MODI_GAMMA_INC
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT
-REAL, DIMENSION(:), INTENT(IN) :: ZSI
-REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
-REAL, DIMENSION(:), INTENT(IN) :: ZSW
-REAL, DIMENSION(:), INTENT(IN) :: ZZY
-REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JSPECIE, JL, JL2
-REAL :: XB
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZZX, & ! Work array
- ZFACTOR, &
- ZSUBSAT, &
- ZEMBRYO
-!
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTEG ! Mask to integrate over the
- ! AP size spectrum
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
-!
- ALLOCATE(ZZX (SIZE(ZZT)) ) ; ZZX(:) = 0.0
- ALLOCATE(ZFACTOR (SIZE(ZZT)) )
- ALLOCATE(ZSUBSAT (SIZE(ZZT)) )
- ALLOCATE(ZEMBRYO (SIZE(ZZT)) )
- ALLOCATE(GINTEG (SIZE(ZZT)) )
-
-! Compute log in advance for efficiency
- XB = LOG(0.1E-6/XMDIAM_IFN(JSPECIE))/(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)))
-! ZFACTOR = f_c
- ZFACTOR(:) = DELTA(1.,XH(JSPECIE),ZZT(:),XT0(JSPECIE),XT0(JSPECIE)+XDT0(JSPECIE)) &
- * DELTA_VEC(0.,1.,ZSI(:),ZSI0(:,JSPECIE),ZSI0(:,JSPECIE)+XDSI0(JSPECIE)) / XGAMMA
-! ZSUBSAT = H_X
- ZSUBSAT(:) = MIN(ZFACTOR(:)+(1.0-ZFACTOR(:))*DELTA(0.,1.,ZSW(:),XSW0,1.) , 1.0)
-! ZEMBRYO = µ_X/(pi*(D_X)**2) = A
- ZEMBRYO(:) = ZSUBSAT(:)*DELTA(1.,0.,ZZT(:),XTX1(JSPECIE),XTX2(JSPECIE)) &
- * XFRAC_REF(JSPECIE)*ZZY(:)/XAREA1(JSPECIE)
-!
-! For T warmer than -35°C, the integration is approximated with µ_X << 1
-! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
-!
-! WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
-! ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
-! * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
-! * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
-! END WHERE
-
- DO JL = 1, SIZE(ZZT)
- IF (ZZT(JL)>(XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
- ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
- * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
- * (1.0+SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
- END IF
- ENDDO
-
-!
-! For other T, integration between 0 and infinity is made with a Gauss-Hermite
-! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
-! Beware : here, weights are normalized : XWEIGHT = wi/sqrt(pi)
-!
- GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
-!
- DO JL = 1, NDIAM
- DO JL2 = 1, SIZE(GINTEG)
- IF (GINTEG(JL2)) THEN
- ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
- * EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
- END IF
- ENDDO
- ENDDO
-!
-! DO JL2 = 1, SIZE(GINTEG)
-! IF (GINTEG(JL2)) THEN
-! ZZX(JL2) = ZZX(JL2) + 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
-! * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
-! * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
-! END IF
-! ENDDO
- DO JL2 = 1, SIZE(GINTEG)
- IF (GINTEG(JL2)) THEN
- ZZX(JL2) = 1 + ZZX(JL2) &
- - ( 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
- * ( 1.0-SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) )
- END IF
- ENDDO
-!
- Z_FRAC_ACT(:,JSPECIE)=ZZX(:)
-!
- DEALLOCATE(ZZX)
- DEALLOCATE(ZFACTOR)
- DEALLOCATE(ZSUBSAT)
- DEALLOCATE(ZEMBRYO)
- DEALLOCATE(GINTEG)
-!
-ENDDO
-!
-END SUBROUTINE LIMA_PHILLIPS_INTEG
diff --git a/src/mesonh/micro/lima_phillips_ref_spectrum.f90 b/src/mesonh/micro/lima_phillips_ref_spectrum.f90
deleted file mode 100644
index d549d7051fc8cb3c43ef7d755fe31da9060dd8b0..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_phillips_ref_spectrum.f90
+++ /dev/null
@@ -1,140 +0,0 @@
-! ######################################
- MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-! ######################################
-!
-INTERFACE
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
-REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
-REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
-!
-END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
-END INTERFACE
-END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-!
-! ######################################################################
- SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
-! ######################################################################
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the reference activation spectrum
-!! described by Phillips (2008)
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Phillips et al., 2008: An empirical parameterization of heterogeneous
-!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE MODD_PARAM_LIMA, ONLY : XGAMMA, XRHO_CFDC
-USE MODI_LIMA_FUNCTIONS, ONLY : RECT, DELTA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
-REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
-REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
-REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZMAX, &
- ZMOY, &
- ZZY1, &
- ZZY2, &
- Z1, &
- Z2, &
- ZSI2
-!
-REAL :: XPSI
-!
-!-------------------------------------------------------------------------------
-!
-ALLOCATE(ZMAX(SIZE(ZZT))) ; ZMAX(:)= 0.0
-ALLOCATE(ZMOY(SIZE(ZZT))) ; ZMOY(:)= 0.0
-ALLOCATE(ZZY1(SIZE(ZZT))) ; ZZY1(:)= 0.0
-ALLOCATE(ZZY2(SIZE(ZZT))) ; ZZY2(:)= 0.0
-ALLOCATE(Z1(SIZE(ZZT))) ; Z1(:) = 0.0
-ALLOCATE(Z2(SIZE(ZZT))) ; Z2(:) = 0.0
-ALLOCATE(ZSI2(SIZE(ZZT))) ; ZSI2(:)= 0.0
-!
-ZZY(:) = 0.0
-!
-XPSI = 0.058707*XGAMMA/XRHO_CFDC
-!
-ZSI2(:)=min(ZSI(:),ZSI_W(:))
-!
-WHERE( ZSI(:)>1.0 )
-!
-!* T <= -35 C
-!
- ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
- * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
-!
-!* -35 C < T <= -25 C (in Appendix A)
-!
- ZZY1(:) =1000.*XGAMMA/XRHO_CFDC &
- * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3
- ZZY2(:) =1000.*XPSI &
- * EXP(12.96*(MIN(ZSI2(:),7.)-1.0)-0.639)
-!
-!* -35 C < T <= -30 C
-!
- ZMAX(:) =1000.*XGAMMA/XRHO_CFDC &
- * ( EXP(12.96*(ZSI_W(:)-1.1)) )**0.3 &
- * RECT(1.,0.,ZZT(:),(XTT-35.),(XTT-30.))
-!
-!* -30 C < T <= -25 C
-!
- ZMAX(:) = ZMAX(:) +1000.*XPSI &
- * EXP( 12.96*(ZSI_W(:)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-30.),(XTT-25.))
- Z1(:) = MIN(ZZY1(:), ZMAX(:))
- Z2(:) = MIN(ZZY2(:), ZMAX(:))
-!
-!* T > -25 C
-!
- ZZY(:) = ZZY(:) + 1000.*XPSI &
- * EXP( 12.96*(MIN(ZSI2(:),7.)-1.0)-0.639 ) &
- * RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
-END WHERE
-!
-WHERE (Z2(:)>0.0 .AND. Z1(:)>0.0)
- ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(XTT-35.),(XTT-25.))
- ZZY(:) = ZZY(:) + MIN(ZMOY(:),ZMAX(:)) ! N_{IN,1,*}
-END WHERE
-!
-!++cb++
-DEALLOCATE(ZMAX)
-DEALLOCATE(ZMOY)
-DEALLOCATE(ZZY1)
-DEALLOCATE(ZZY2)
-DEALLOCATE(Z1)
-DEALLOCATE(Z2)
-!--cb--
-!
-END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/mesonh/micro/lima_precip_scavenging.f90 b/src/mesonh/micro/lima_precip_scavenging.f90
deleted file mode 100644
index aaabf3f298cc30a22fab869f8602151d82e12897..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_precip_scavenging.f90
+++ /dev/null
@@ -1,856 +0,0 @@
-!MNH_LIC Copyright 2013-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_LIMA_PRECIP_SCAVENGING
-! ##################################
-!
-INTERFACE
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
- PPABST, PTHT, PSVT, PRSVS, PINPAP )
-
-use modd_nsv, only: nsv_lima_beg
-
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
-INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except
- ! for the first time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
-!
-END SUBROUTINE LIMA_PRECIP_SCAVENGING
-END INTERFACE
-END MODULE MODI_LIMA_PRECIP_SCAVENGING
-!
-!########################################################################
- SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
- PRRT, PRHODREF, PRHODJ, PZZ, &
- PPABST, PTHT, PSVT, PRSVS, PINPAP )
-!########################################################################x
-!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total number
-!! below-cloud scavenging rate.
-!!
-!!
-!!** METHOD
-!! ------
-!! We assume a generalized gamma distribution law for the raindrop.
-!! The aerosols particles distribution follows a log-normal law.
-!! First, we have to compute the Collision Efficiency, which takes
-!! account of the three most important wet removal mechanism :
-!! Brownian diffusion, interception and inertial impaction.
-!! It is a function of several number (like Reynolds, Schmidt
-!! or Stokes number for instance). Consequently,
-!! we need first to calculate these numbers.
-!!
-!! Then the scavenging coefficient is deduced from the integration
-!! of the droplet size distribution, the falling velocity of
-!! raindrop and aerosol, their diameter, and the collision
-!! (or collection) efficiency, over the spectrum of droplet
-!! diameters.
-!!
-!! The total scavenging rate of aerosol is computed from the
-!! integration, over all the spectrum of particles aerosols
-!! diameters, of the scavenging coefficient.
-!!
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine SCAV_MASS_SEDIMENTATION
-!!
-!! Function COLL_EFFIC : computes the collision efficiency
-!!
-!! Function CONTJV |
-!! Function GAUHER |
-!! Function GAULAG |-> in lima_functions.f90
-!! Function GAMMLN |
-!!
-!!
-!! REFERENCES
-!! ----------
-!! Seinfeld and Pandis
-!! Andronache
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!!
-! P. Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
-! P. Wautelet 03/06/2020: bugfix: correct array starts for PSVT and PRSVS
-! P. Wautelet 11/02/2021: bugfix: ZRTMIN was of wrong size (replaced by a scalar)
-! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
-!-------------------------------------------------------------------------------
-!
-!* 0.DECLARATIONS
-! --------------
-!
-use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
-USE MODD_CST
-USE MODD_NSV
-USE MODD_PARAMETERS
-USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC, &
- XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
- NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
- XALPHAR, XNUR, &
- LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
- XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
- XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
-
-use mode_budget, only: Budget_store_init, Budget_store_end
-use mode_tools, only: Countjv
-
-USE MODI_GAMMA
-USE MODI_INI_NSV
-USE MODI_LIMA_FUNCTIONS
-
-IMPLICIT NONE
-!
-!* 0.1 declarations of dummy arguments :
-!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
-INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except
- ! for the first time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-!
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
-REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-INTEGER :: JSV ! CCN or IFN mode
-INTEGER :: J1, J2, IJ, JMOD
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GRAIN, &! Test where rain is present
- GSCAV ! Test where rain is present
-INTEGER , DIMENSION(SIZE(GSCAV)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-INTEGER :: ISCAV
-!
-REAL :: ZDENS_RATIO, & !density ratio
- ZNUM, & !PNU-1.
- ZSHAPE_FACTOR
-!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: PCRT ! cloud droplet conc.
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDAR, & !slope parameter of the
- ! generalized Gamma
- !distribution law for the
- !raindrop
- ZVISC_RATIO, & !viscosity ratio
- ZMFPA, & !Mean Free Path
- ZRHODREF, & !Air Density [kg/m**3]
- ZVISCA, & !Viscosity of Air [kg/(m*s)]
- ZT, & !Absolute Temperature
- ZPABST, &
- ZRRT, &
- ZCONCP, &
- ZCONCR, &
- ZTOT_SCAV_RATE,&
- ZTOT_MASS_RATE,&
- ZMEAN_SCAV_COEF
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: &
- ZVOLDR, & !Mean volumic Raindrop diameter [m]
- ZBC_SCAV_COEF, &
- ZCUNSLIP, & !CUnningham SLIP correction factor
- ZST_STAR, & !critical Stokes number for impaction
- ZSC, & !aerosol particle Schmidt number
- ZRE, & !raindrop Reynolds number (for radius)
- ZFVELR, & !Falling VELocity of the Raindrop
- ZRELT, & !RELaxation Time of the particle [s]
- ZDIFF !Particle Diffusivity
-!
-REAL, DIMENSION(NDIAMP) :: ZVOLDP, & !Mean volumic diameter [m]
- ZABSCISSP, & !Aerosol Abscisses
- ZWEIGHTP !Aerosol Weights
-REAL, DIMENSION(NDIAMR) :: ZABSCISSR, & !Raindrop Abscisses
- ZWEIGHTR !Raindrop Weights
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOL_EF, &! Collision efficiency
- ZSIZE_RATIO, &! Size Ratio
- ZST ! Stokes number
-!
-REAL, DIMENSION(SIZE(PRRT,1),SIZE(PRRT,2),SIZE(PRRT,3)) :: ZRRS
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: PMEAN_SCAV_COEF, & !Mean Scavenging
- ! Coefficient
- PTOT_SCAV_RATE, & !Total Number
- ! Scavenging Rate
- PTOT_MASS_RATE !Total Mass
- ! Scavenging Rate
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
- ::PBC_SCAV_COEF !Scavenging Coefficient
-REAL, DIMENSION(:), ALLOCATABLE :: ZKNUDSEN ! Knuudsen number
-!
-! Opt. BVIE
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZT_3D, ZCONCR_3D, ZVISCA_3D, ZMFPA_3D, &
- ZVISC_RATIO_3D, ZLAMBDAR_3D, FACTOR_3D
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
- :: ZVOLDR_3D, ZVOLDR_3D_INV, ZVOLDR_3D_POW, &
- ZFVELR_3D, ZRE_3D, ZRE_3D_SQRT, ZST_STAR_3D
-REAL, DIMENSION(:), ALLOCATABLE :: FACTOR
-REAL, DIMENSION(:,:), ALLOCATABLE :: &
- ZRE_SQRT, & ! SQRT of raindrop Reynolds number
- ZRE_INV, & ! INV of raindrop Reynolds number
- ZSC_INV, & ! INV of aerosol particle Schmidt number
- ZSC_SQRT, & ! SQRT of aerosol particle Schmidt number
- ZSC_3SQRT, & ! aerosol particle Schmidt number**(1./3.)
- ZVOLDR_POW, & ! Mean volumic Raindrop diameter [m] **(2+ZDR)
- ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
-REAL :: ZDENS_RATIO_SQRT
-INTEGER :: SV_VAR, NM, JM
-integer :: idx
-REAL :: XMDIAMP
-REAL :: XSIGMAP
-REAL :: XRHOP
-REAL :: XFRACP
-!
-!
-!
-!------------------------------------------------------------------------------
-
-if ( lbudget_sv ) then
- do jl = 1, nmod_ccn
- idx = nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
- end do
- do jl = 1, nmod_ifn
- idx = nsv_lima_ifn_free - 1 + jl
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
- end do
- if ( laero_mass ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
- end if
-end if
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-IIB=1+JPHEXT
-IIE=SIZE(PRHODREF,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PRHODREF,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PRHODREF,3) - JPVEXT
-!
-! PCRT
-PCRT(:,:,:)=PSVT(:,:,:,NSV_LIMA_NR)
-!
-! Rain mask
-GRAIN(:,:,:) = .FALSE.
-GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) = (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) &
- .AND. PCRT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(3) )
-!
-! Initialize the total mass scavenging rate if LAERO_MASS=T
-IF (LAERO_MASS) PTOT_MASS_RATE(:,:,:) = 0.
-!
-! Quadrature method: compute absissae and weights
-CALL GAUHER(ZABSCISSP,ZWEIGHTP,NDIAMP)
-ZNUM = XNUR-1.0E0
-CALL GAULAG(ZABSCISSR,ZWEIGHTR,NDIAMR,ZNUM)
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 2. NUMERICAL OPTIMIZATION
-! ----------------------
-!
-!
-! Optimization : compute in advance parameters depending on rain particles and
-! environment conditions only, to avoid multiple identical computations in loops
-!
-!
-ZSHAPE_FACTOR = GAMMA_X0D(XNUR+3./XALPHAR)/GAMMA_X0D(XNUR)
-!
-WHERE ( GRAIN(:,:,:) )
- !
- ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 )**(XRD/XCPD)
- ZCONCR_3D(:,:,:) = PCRT(:,:,:) * PRHODREF(:,:,:) ![/m3]
- ! Sutherland law for viscosity of air
- ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**1.5*(XTREF+XT_SUTH_A) &
- /(XT_SUTH_A+ZT_3D(:,:,:))
- ! Air mean free path
- ZMFPA_3D(:,:,:) = XMFPA0*(XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
- ! Viscosity ratio
- ZVISC_RATIO_3D(:,:,:) = ZVISCA_3D(:,:,:)/XVISCW !!!!! inversé par rapport à orig. !
- ! Rain drops parameters
- ZLAMBDAR_3D(:,:,:) = ( ((XPI/6.)*ZSHAPE_FACTOR*XRHOLW*ZCONCR_3D(:,:,:)) &
- /(PRHODREF(:,:,:)*PRRT(:,:,:)) )**(1./3.) ![/m]
- FACTOR_3D(:,:,:) = XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
- !
-END WHERE
-!
-DO J2=1,NDIAMR
- WHERE ( GRAIN(:,:,:) )
- ! exchange of variables: [m]
- ZVOLDR_3D(:,:,:,J2) = ZABSCISSR(J2)**(1./XALPHAR)/ZLAMBDAR_3D(:,:,:)
- ZVOLDR_3D_INV(:,:,:,J2) = 1./ZVOLDR_3D(:,:,:,J2)
- ZVOLDR_3D_POW(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)**(2.+XDR)
- ! Raindrop Falling VELocity [m/s]
- ZFVELR_3D(:,:,:,J2) = XCR*(ZVOLDR_3D(:,:,:,J2)**XDR)*(XRHO00/PRHODREF(:,:,:))**(0.4)
- ! Reynolds number
- ZRE_3D(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)*ZFVELR_3D(:,:,:,J2) &
- *PRHODREF(:,:,:)/(2.0*ZVISCA_3D(:,:,:))
- ZRE_3D_SQRT(:,:,:,J2) = SQRT( ZRE_3D(:,:,:,J2) )
- ! Critical Stokes number
- ZST_STAR_3D(:,:,:,J2) = (1.2+(LOG(1.+ZRE_3D(:,:,:,J2)))/12.) &
- /(1.+LOG(1.+ZRE_3D(:,:,:,J2)))
- END WHERE
-END DO
-!
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 3. AEROSOL SCAVENGING
-! ------------------
-!
-!
-! Iteration over the aerosol type and mode
-!
-DO JSV = 1, NMOD_CCN+NMOD_IFN
-!
- IF (JSV .LE. NMOD_CCN) THEN
- JMOD = JSV
- SV_VAR = NSV_LIMA_CCN_FREE -1 + JMOD ! Variable number in PSVT
- NM = 1 ! Number of species (for IFN int. mixing)
- ELSE
- JMOD = JSV - NMOD_CCN
- SV_VAR = NSV_LIMA_IFN_FREE -1 + JMOD
- NM = NSPECIE
- END IF
-!
- PBC_SCAV_COEF(:,:,:,:) = 0.
- PMEAN_SCAV_COEF(:,:,:) = 0.
- PTOT_SCAV_RATE(:,:,:) = 0.
-!
- GSCAV(:,:,:) = .FALSE.
- GSCAV(IIB:IIE,IJB:IJE,IKB:IKE) =GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) .AND. &
- (PSVT(IIB:IIE,IJB:IJE,IKB:IKE,SV_VAR)>1.0E-2)
- ISCAV = COUNTJV(GSCAV(:,:,:),I1(:),I2(:),I3(:))
-!
- IF( ISCAV>=1 ) THEN
- ALLOCATE(ZVISC_RATIO(ISCAV))
- ALLOCATE(ZRHODREF(ISCAV))
- ALLOCATE(ZVISCA(ISCAV))
- ALLOCATE(ZT(ISCAV))
- ALLOCATE(ZRRT(ISCAV))
- ALLOCATE(ZCONCR(ISCAV))
- ALLOCATE(ZLAMBDAR(ISCAV))
- ALLOCATE(ZCONCP(ISCAV))
- ALLOCATE(ZMFPA(ISCAV))
- ALLOCATE(ZTOT_SCAV_RATE(ISCAV))
- ALLOCATE(ZTOT_MASS_RATE(ISCAV))
- ALLOCATE(ZMEAN_SCAV_COEF(ISCAV))
- ALLOCATE(ZPABST(ISCAV))
- ALLOCATE(ZKNUDSEN(ISCAV))
- ALLOCATE(FACTOR(ISCAV))
-!
- ALLOCATE(ZCUNSLIP(ISCAV,NDIAMP))
- ALLOCATE(ZBC_SCAV_COEF(ISCAV,NDIAMP))
- ALLOCATE(ZSC(ISCAV,NDIAMP))
- ALLOCATE(ZSC_INV(ISCAV,NDIAMP))
- ALLOCATE(ZSC_SQRT(ISCAV,NDIAMP))
- ALLOCATE(ZSC_3SQRT(ISCAV,NDIAMP))
- ALLOCATE(ZRELT(ISCAV,NDIAMP))
- ALLOCATE(ZDIFF(ISCAV,NDIAMP))
- ALLOCATE(ZVOLDR(ISCAV,NDIAMR))
- ALLOCATE(ZVOLDR_POW(ISCAV,NDIAMR))
- ALLOCATE(ZVOLDR_INV(ISCAV,NDIAMR))
- ALLOCATE(ZRE(ISCAV,NDIAMR))
- ALLOCATE(ZRE_INV(ISCAV,NDIAMR))
- ALLOCATE(ZRE_SQRT(ISCAV,NDIAMR))
- ALLOCATE(ZST_STAR(ISCAV,NDIAMR))
- ALLOCATE(ZFVELR(ISCAV,NDIAMR))
- ALLOCATE(ZST(ISCAV,NDIAMP,NDIAMR))
- ALLOCATE(ZCOL_EF(ISCAV,NDIAMP,NDIAMR))
- ALLOCATE(ZSIZE_RATIO(ISCAV,NDIAMP,NDIAMR))
-!
- ZMEAN_SCAV_COEF(:)=0.
- ZTOT_SCAV_RATE(:) =0.
- ZTOT_MASS_RATE(:) =0.
- DO JL=1,ISCAV
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZT(JL) = ZT_3D(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZCONCP(JL) = PSVT(I1(JL),I2(JL),I3(JL),SV_VAR)*ZRHODREF(JL)![/m3]
- ZCONCR(JL) = ZCONCR_3D(I1(JL),I2(JL),I3(JL)) ![/m3]
- ZVISCA(JL) = ZVISCA_3D(I1(JL),I2(JL),I3(JL))
- ZMFPA(JL) = ZMFPA_3D(I1(JL),I2(JL),I3(JL))
- ZVISC_RATIO(JL) = ZVISC_RATIO_3D(I1(JL),I2(JL),I3(JL))
- ZLAMBDAR(JL) = ZLAMBDAR_3D(I1(JL),I2(JL),I3(JL))
- FACTOR(JL) = FACTOR_3D(I1(JL),I2(JL),I3(JL))
- ZVOLDR(JL,:) = ZVOLDR_3D(I1(JL),I2(JL),I3(JL),:)
- ZVOLDR_POW(JL,:) = ZVOLDR_3D_POW(I1(JL),I2(JL),I3(JL),:)
- ZVOLDR_INV(JL,:) = ZVOLDR_3D_INV(I1(JL),I2(JL),I3(JL),:)
- ZFVELR(JL,:) = ZFVELR_3D(I1(JL),I2(JL),I3(JL),:)
- ZRE(JL,:) = ZRE_3D(I1(JL),I2(JL),I3(JL),:)
- ZRE_SQRT(JL,:) = ZRE_3D_SQRT(I1(JL),I2(JL),I3(JL),:)
- ZST_STAR(JL,:) = ZST_STAR_3D(I1(JL),I2(JL),I3(JL),:)
- ENDDO
- ZRE_INV(:,:) = 1./ZRE(:,:)
-
- IF (ANY(ZCONCR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
- IF (ANY(ZLAMBDAR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
-!
-!------------------------------------------------------------------------------------
-!
-! Loop over the different species (for IFN int. mixing)
-!
- DO JM = 1, NM ! species (DM1,DM2,BC,O) for IFN
- IF ( JSV .LE. NMOD_CCN ) THEN ! CCN case
- XRHOP = XRHO_CCN(JMOD)
- XMDIAMP = 2*XR_MEAN_CCN(JMOD)
- XSIGMAP = EXP(XLOGSIG_CCN(JMOD))
- XFRACP = 1.0
- ELSE ! IFN case
- XRHOP = XRHO_IFN(JM)
- XMDIAMP = XMDIAM_IFN(JM)
- XSIGMAP = XSIGMA_IFN(JM)
- XFRACP = XFRAC(JM,JMOD)
- END IF
- !-----------------------------------------------------------------------------
- ! Loop over the aerosols particles diameters (log normal distribution law) :
- !
- DO J1=1,NDIAMP
- ! exchange of variables: [m]
- ZVOLDP(J1) = XMDIAMP * EXP(ZABSCISSP(J1)*SQRT(2.)*LOG(XSIGMAP))
- ! Cunningham slip correction factor (1+alpha*Knudsen)
- ZKNUDSEN(:) = MIN( 20.,ZVOLDP(J1)/ZMFPA(:) )
- ZCUNSLIP(:,J1) = 1.0+2.0/ZKNUDSEN(:)*(1.257+0.4*EXP(-0.55*ZKNUDSEN(:)))
- ! Diffusion coefficient
- ZDIFF(:,J1) = XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*XPI*ZVISCA(:)*ZVOLDP(J1))
- ! Schmidt number
- ZSC(:,J1) = ZVISCA(:)/(ZRHODREF(:)*ZDIFF(:,J1))
- ZSC_INV(:,J1) = 1./ZSC(:,J1)
- ZSC_SQRT(:,J1) = SQRT( ZSC(:,J1) )
- ZSC_3SQRT(:,J1) = ZSC(:,J1)**(1./3.)
- ! Characteristic Time Required for reaching terminal velocity
- ZRELT(:,J1) = (ZVOLDP(J1)**2)*ZCUNSLIP(:,J1)*XRHOP/(18.*ZVISCA(:))
- ! Density number
- ZDENS_RATIO = XRHOP/XRHOLW
- ZDENS_RATIO_SQRT = SQRT(ZDENS_RATIO)
- ! Initialisation
- ZBC_SCAV_COEF(:,J1)=0.
- !-------------------------------------------------------------------------
- ! Loop over the drops diameters (generalized Gamma distribution) :
- !
- DO J2=1,NDIAMR
- ! Stokes number
- ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*XG) &
- *ZVOLDR_INV(:,J2)
- ! Size Ratio
- ZSIZE_RATIO(:,J1,J2) = ZVOLDP(J1)*ZVOLDR_INV(:,J2)
- ! Collision Efficiency
- ZCOL_EF(:,J1,J2) = COLL_EFFI(ZRE, ZRE_INV, ZRE_SQRT, ZSC, ZSC_INV, &
- ZSC_SQRT, ZSC_3SQRT, ZST, ZST_STAR, &
- ZSIZE_RATIO, ZVISC_RATIO, ZDENS_RATIO_SQRT)
- ! Below-Cloud Scavenging Coefficient for a fixed ZVOLDP: [/s]
- ZBC_SCAV_COEF(:,J1) = ZBC_SCAV_COEF(:,J1) + &
- ZCOL_EF(:,J1,J2) * ZWEIGHTR(J2) * FACTOR(:) * ZVOLDR_POW(:,J2)
- END DO
- ! End of the loop over the drops diameters
- !--------------------------------------------------------------------------
-
- ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
- ZTOT_SCAV_RATE(:) = ZTOT_SCAV_RATE(:) - &
- ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1)
- ! Total MASS Scavenging Rate of aerosol [kg.m**-3.s**-1]
- ZTOT_MASS_RATE(:) = ZTOT_MASS_RATE(:) + &
- ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1) &
- *XPI/6.*XRHOP*(ZVOLDP(J1)**3)
- END DO
- ! End of the loop over the drops diameters
- !--------------------------------------------------------------------------
-
- ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
- PTOT_SCAV_RATE(:,:,:)=UNPACK(ZTOT_SCAV_RATE(:),MASK=GSCAV(:,:,:),FIELD=0.0)
- ! Free particles (CCN or IFN) [/s]:
- PRSVS(:,:,:,SV_VAR) = max(PRSVS(:,:,:,SV_VAR)+PTOT_SCAV_RATE(:,:,:) &
- * PRHODJ(:,:,:)/PRHODREF(:,:,:) , 0.0 )
- ! Total MASS Scavenging Rate of aerosol which REACH THE FLOOR because of
- ! rain sedimentation [kg.m**-3.s**-1]
- IF (LAERO_MASS)THEN
- PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
- UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
- CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
- PRHODREF, PRRT, PSVT(:,:,:,NSV_LIMA_SCAVMASS),&
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS), PINPAP )
- PRSVS(:,:,:,NSV_LIMA_SCAVMASS)=PRSVS(:,:,:,NSV_LIMA_SCAVMASS) + &
- PTOT_MASS_RATE(:,:,:)*PRHODJ(:,:,:)/PRHODREF(:,:,:)
- END IF
- ENDDO
-! End of the loop over the aerosol species
-!--------------------------------------------------------------------------
-!
-!
-!
- DEALLOCATE(FACTOR)
- DEALLOCATE(ZSC_INV)
- DEALLOCATE(ZSC_SQRT)
- DEALLOCATE(ZSC_3SQRT)
- DEALLOCATE(ZRE_INV)
- DEALLOCATE(ZRE_SQRT)
- DEALLOCATE(ZVOLDR_POW)
- DEALLOCATE(ZVOLDR_INV)
-!
- DEALLOCATE(ZFVELR)
- DEALLOCATE(ZRE)
- DEALLOCATE(ZST_STAR)
- DEALLOCATE(ZST)
- DEALLOCATE(ZSIZE_RATIO)
- DEALLOCATE(ZCOL_EF)
- DEALLOCATE(ZVOLDR)
- DEALLOCATE(ZDIFF)
- DEALLOCATE(ZRELT)
- DEALLOCATE(ZSC)
- DEALLOCATE(ZCUNSLIP)
- DEALLOCATE(ZBC_SCAV_COEF)
-!
- DEALLOCATE(ZTOT_SCAV_RATE)
- DEALLOCATE(ZTOT_MASS_RATE)
- DEALLOCATE(ZMEAN_SCAV_COEF)
-!
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZCONCR)
- DEALLOCATE(ZLAMBDAR)
- DEALLOCATE(ZCONCP)
- DEALLOCATE(ZVISC_RATIO)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZVISCA)
- DEALLOCATE(ZPABST)
- DEALLOCATE(ZKNUDSEN)
- DEALLOCATE(ZT)
- DEALLOCATE(ZMFPA)
- ENDIF
-ENDDO
-!
-if ( lbudget_sv ) then
- do jl = 1, nmod_ccn
- idx = nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
- end do
- do jl = 1, nmod_ifn
- idx = nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
- end do
- if ( laero_mass ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
- end if
-end if
-!------------------------------------------------------------------------------
-!
-!
-!* 3. SUBROUTINE AND FUNCTION
-! -----------------------
-!
-!
-CONTAINS
-!
-!------------------------------------------------------------------------------
-! ##########################################################################
- SUBROUTINE SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ,&
- PRHODREF, PRAIN, PSVT_MASS, PRSVS_MASS, PINPAP )
-! ##########################################################################
-!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total mass of aerosol
-!! scavenged by precipitations
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMENTATION )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 22/07/07
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CONF
-!
-USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XBR, XDR, XFSEDRR
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KTCOUNT ! Current time step number
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRAIN ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT_MASS ! Precip. aerosols at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSVS_MASS ! Precip. aerosols source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JJ, JK, JN, JRR ! Loop indexes
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-REAL :: ZTSTEP ! Large time step for rain sedimentation
-!
-!
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIM ! where to compute the SED processes
-INTEGER :: ISEDIM
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW, & ! work array
- ZWSED, & ! sedimentation fluxes
- ZZS ! Rain water m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRS, & ! Rain water m.r. source
- ZRHODREF, & ! RHO Dry REFerence
- ZZW ! Work array
-!
-REAL :: ZRTMIN3
-!
-!
-REAL :: ZVTRMAX, ZDZMIN, ZT
-REAL, SAVE :: ZEXSEDR
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER, SAVE :: ISPLITR
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 2.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- ZVTRMAX = 10.
- ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
- ISPLITR = 1
- SPLIT : DO
- ZT = 2.* PTSTEP / REAL(ISPLITR)
- IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
- ISPLITR = ISPLITR + 1
- END DO SPLIT
-!
- ZEXSEDR = (XBR+XDR+1.0)/(XBR+1.0)
-!
-END IF firstcall
-!
-!* 2.2 time splitting loop initialization
-!
-IF( (KTCOUNT==1) .AND. (CCONF=='START') ) THEN
- ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
- ZTSTEP = PTSTEP ! Large time step
- ELSE
- ZTSPLITR= 2. * PTSTEP / REAL(ISPLITR)
- ZTSTEP = 2. * PTSTEP
-END IF
-!
-!* 2.3 compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-!
-ZRTMIN3 = XRTMIN(3) / ZTSTEP
-ZZS(:,:,:) = PRAIN(:,:,:)
-DO JN = 1 , ISPLITR
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
-!
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
- IF( JN==1 ) THEN
- ZZS(:,:,:) = ZZS(:,:,:) * ZTSTEP
- DO JK = IKB , IKE-1
- ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
- END DO
- ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
- END IF
- ALLOCATE(ZRRS(ISEDIM))
- ALLOCATE(ZRHODREF(ISEDIM))
- DO JL=1,ISEDIM
- ZRRS(JL) = ZZS(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
-!
-!* 2.2.1 for rain
-!
- ZZW(:) = XFSEDRR * ZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-XCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB , IKE
- ZZS(:,:,JK) = ZZS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- IF( JN==1 ) THEN
- PINPAP(:,:) = ZWSED(:,:,IKB)* &
- ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN3,PRRT(:,:,IKB)) )
- END IF
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZRRS)
- DEALLOCATE(ZZW)
- IF( JN==ISPLITR ) THEN
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
- ZWSED(:,:,:) = 0.0
- WHERE( GSEDIM(:,:,:) )
- ZWSED(:,:,:) = 1.0/ZTSTEP - PRAIN(:,:,:)/ZZS(:,:,:)
- END WHERE
- END IF
- END IF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-!
-PRSVS_MASS(:,:,:) = PRSVS_MASS(:,:,:) + ZWSED(:,:,:)*PSVT_MASS(:,:,:)
-!
-END SUBROUTINE SCAV_MASS_SEDIMENTATION
-!
-!------------------------------------------------------------------------------
-!
-!###################################################################
- FUNCTION COLL_EFFI (PRE, PRE_INV, PRE_SQRT, PSC, PSC_INV, PSC_SQRT, &
- PSC_3SQRT, PST, PST_STAR, PSIZE_RATIO, &
- PVISC_RATIO, PDENS_RATIO_SQRT) RESULT(PCOL_EF)
-!###################################################################
-!
-!Compute the Raindrop-Aerosol Collision Efficiency
-!
-!* 0. DECLARATIONS
-! ---------------
-!
- IMPLICIT NONE
-!
- INTEGER :: I
-!
- REAL, DIMENSION(:,:), INTENT(IN) :: PRE
- REAL, DIMENSION(:,:), INTENT(IN) :: PRE_INV
- REAL, DIMENSION(:,:), INTENT(IN) :: PRE_SQRT
- REAL, DIMENSION(:,:), INTENT(IN) :: PSC
- REAL, DIMENSION(:,:), INTENT(IN) :: PSC_INV
- REAL, DIMENSION(:,:), INTENT(IN) :: PSC_SQRT
- REAL, DIMENSION(:,:), INTENT(IN) :: PSC_3SQRT
- REAL, DIMENSION(:,:), INTENT(IN) :: PST_STAR
-!
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PST
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIZE_RATIO
-!
- REAL, DIMENSION(:), INTENT(IN) :: PVISC_RATIO
- REAL, INTENT(IN) :: PDENS_RATIO_SQRT
-!
- REAL, DIMENSION(SIZE(ZRE,1)) :: PCOL_EF !result : collision efficiency
-!
-!-------------------------------------------------------------------------------
-!
- PCOL_EF(:) = (4.*PSC_INV(:,J1)*PRE_INV(:,J2)*(1.+0.4*PRE_SQRT(:,J2) &
- *PSC_3SQRT(:,J1)+0.16*PRE_SQRT(:,J2)*PSC_SQRT(:,J1))) &
- +(4.*PSIZE_RATIO(:,J1,J2)*(PVISC_RATIO(:) &
- +(1.+2.*PRE_SQRT(:,J2))*PSIZE_RATIO(:,J1,J2)))
- DO I=1,ISCAV
- IF (PST(I,J1,J2)>PST_STAR(I,J2)) THEN
- PCOL_EF(I) = PCOL_EF(I) &
- +(PDENS_RATIO_SQRT*((PST(I,J1,J2)-PST_STAR(I,J2)) &
- /(PST(I,J1,J2)-PST_STAR(I,J2)+2./3.))**(3./2.))
- ENDIF
- ENDDO
- END FUNCTION COLL_EFFI
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_PRECIP_SCAVENGING
diff --git a/src/mesonh/micro/lima_warm.f90 b/src/mesonh/micro/lima_warm.f90
index 97ff7edb8ce5000ddb47d67efbcde89932c74a91..4f954463b5071171871a778652241b6c1bc44738 100644
--- a/src/mesonh/micro/lima_warm.f90
+++ b/src/mesonh/micro/lima_warm.f90
@@ -262,11 +262,11 @@ PCRT(:,:,:) = 0.
PCCS(:,:,:) = 0.
PCRS(:,:,:) = 0.
!
-IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_C.GE.2 ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
!
-IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
-IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( NMOM_C.GE.2 ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOM_R.GE.2 ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
!
IF ( NMOD_CCN .GE. 1 ) THEN
ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
@@ -311,10 +311,10 @@ ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
!
!
if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rr .and. orain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. nmom_r.ge.1 ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
- if ( orain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2 ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
end if
CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
@@ -326,10 +326,10 @@ CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PINPRR3D )
if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rr .and. orain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. nmom_r.ge.1 ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
- if ( orain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+ if ( nmom_r.ge.2 ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
end if
!
! 2.bis Deposition at 1st level above ground
@@ -411,7 +411,7 @@ END IF ! LACTI
! ------------------------
!
!
-IF (ORAIN) THEN
+IF (NMOM_R.GE.2) THEN
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
@@ -466,8 +466,8 @@ IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
!
! Prepare 3D number concentrations
!
-IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
-IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( NMOM_C.GE.2 ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( NMOM_R.GE.2 ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
!
IF ( NMOD_CCN .GE. 1 ) THEN
PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
diff --git a/src/mesonh/micro/lima_warm_coal.f90 b/src/mesonh/micro/lima_warm_coal.f90
index 1c264a8fd844abd9c9e484ab25f60fdd5cbc938f..01d0bd60c6ecccca42efa09722ba36e0fda446f0 100644
--- a/src/mesonh/micro/lima_warm_coal.f90
+++ b/src/mesonh/micro/lima_warm_coal.f90
@@ -244,7 +244,7 @@ IF( IMICRO >= 0 ) THEN
!
!-------------------------------------------------------------------------------
!
-IF (LRAIN) THEN
+IF (NMOM_R.GE.2) THEN
!
!* 2. Self-collection of cloud droplets
! ------------------------------------
@@ -445,7 +445,7 @@ IF (LRAIN) THEN
if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
END IF
-END IF ! LRAIN
+END IF
!
!
!-------------------------------------------------------------------------------
diff --git a/src/mesonh/micro/modn_param_lima.f90 b/src/mesonh/micro/modn_param_lima.f90
index 44d46714532cecea5636b296e32983968ea57ab6..390ba1dc8853237ddf00550f04dbeb9465636c3d 100644
--- a/src/mesonh/micro/modn_param_lima.f90
+++ b/src/mesonh/micro/modn_param_lima.f90
@@ -17,7 +17,7 @@ USE MODD_PARAM_LIMA
IMPLICIT NONE
!
!
-NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
+NAMELIST/NAM_PARAM_LIMA/LNUCL, LSEDI, LHHONI, LMEYERS, &
NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
NMOD_IFN, XIFN_CONC, LIFN_HOM, &
CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
@@ -25,7 +25,7 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
LCIBU, XNDEBRIS_CIBU, LRDSF, LMURAKAMI, &
- LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LACTI, LSEDC, LACTIT, LBOUND, LSPRO, &
LADJ, LKHKO, LKESSLERAC, NMOM_C, NMOM_R, &
NMOD_CCN, XCCN_CONC, &
LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
diff --git a/tools/check_commit_ial.sh b/tools/check_commit_ial.sh
index 55e0785ea8688e86d42f49d7f9c8fee729ba675f..e5136d8dccf4bc21859488c9abe359cd67d0d378 100755
--- a/tools/check_commit_ial.sh
+++ b/tools/check_commit_ial.sh
@@ -360,6 +360,7 @@ if [ $packcreation -eq 1 ]; then
#Move manually files outside of mpa (a find on the whole repository would take too much a long time)
[ -f $EXT/yomparar.F90 ] && mv $EXT/yomparar.F90 ../arpifs/module/
[ -f $EXT/namparar.nam.h ] && mv $EXT/namparar.nam.h ../arpifs/namelist
+ [ -f $EXT/namlima.nam.h ] && mv $EXT/namlima.nam.h ../arpifs/namelist
[ -f $EXT/suparar.F90 ] && mv $EXT/suparar.F90 ../arpifs/phys_dmn/
[ -f $EXT/apl_arome.F90 ] && mv $EXT/apl_arome.F90 ../arpifs/phys_dmn/
[ -f $EXT/suphmpa.F90 ] && mv $EXT/suphmpa.F90 ../arpifs/phys_dmn/
diff --git a/tools/conf_tests/big_3D/aro48t3.sh b/tools/conf_tests/big_3D/aro48t3.sh
index 4663a7184bbbee85922b83a16d966b5cbc780451..433a17b9376902ac5e501267f48df2b91969a12b 100644
--- a/tools/conf_tests/big_3D/aro48t3.sh
+++ b/tools/conf_tests/big_3D/aro48t3.sh
@@ -33,8 +33,8 @@ export OMP_NUM_THREADS=$SLURM_CPUS_PER_TASK
# Total number of MPI tasks:
MPI_TASKS=$SLURM_NTASKS
# Number of tasks reserved for the I/O server : 2 (hyperthreaded) nodes
-NTASKS_IO=$(($(grep processor /proc/cpuinfo | wc -l)/1/$OMP_NUM_THREADS))
-
+#NTASKS_IO=$(($(grep processor /proc/cpuinfo | wc -l)/1/$OMP_NUM_THREADS))
+NTASKS_IO=0
echo NNODES=$NNODES
echo MPITASKS_PER_NODE=$MPITASKS_PER_NODE
echo