diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 783bad812b268012a3888a4a6089814fb275244e..0597b379c5aeca8cd26e19d71a7b33d4fa478296 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -895,6 +895,8 @@ IF (KMI == 1) THEN
LDEPOSC = .FALSE.
XVDEPOSC= 0.02 ! 2 cm/s
LSNOW_T=.FALSE.
+ LPACK_INTERP=.TRUE.
+ LPACK_MICRO=.TRUE. ! Meso-NH does not work with LPACK_MICRO=.FALSE.
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index e94400bedbdec4ccb3e551a056dcb944ed15e1f5..275e7eca4ed889e565eafd2cdb9ddc19f63d760d 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1584,7 +1584,7 @@ END IF
NSV, NSV_LGBEG, NSV_LGEND,CPROGRAM, &
NSV_LIMA_NR, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
L2D, LNOMIXLG,LFLAT, &
- LCOUPLES, LBLOWSNOW, LIBM, &
+ LCOUPLES, LBLOWSNOW, LIBM,LFLYER, &
GCOMPUTE_SRC, XRSNOW, &
LOCEAN, LDEEPOC, LDIAG_IN_RUN, &
CTURBLEN_CLOUD, CCLOUD, &
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 275735ad4619a18591c04982befd70e0cc9d0b68..2ab08f041204aeff43b7d3cdd2f003c06a640dd0 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -477,12 +477,10 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
!
INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
!UPG*PT
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
!UPG*PT
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
!
INTEGER :: JMOD, JMOD_IFN
@@ -579,10 +577,6 @@ END IF
!UPG*PT
!
-IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
- ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
- ZRSMIN(:) = XRTMIN(:) / PTSTEP
-END IF
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! ---------------------------------------
@@ -832,22 +826,9 @@ SELECT CASE ( HCLOUD )
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
- LLMICRO(:,:,:) = .FALSE.
- LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=PRT(IIB:IIE,IJB:IJE,IKB:IKE,2)>XRTMIN(2) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,3)>XRTMIN(3) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,5)>XRTMIN(5) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)>XRTMIN(6)
- LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,2)>ZRSMIN(2) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,3)>ZRSMIN(3) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>ZRSMIN(4) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,5)>ZRSMIN(5) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,6)>ZRSMIN(6)
CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
- COUNT(LLMICRO), COUNT(LLMICRO), &
- .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI,&
- PTSTEP, KRR, LLMICRO, ZEXN, &
+ 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
+ PTSTEP, KRR, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
@@ -937,26 +918,11 @@ SELECT CASE ( HCLOUD )
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
- LLMICRO(:,:,:) = .FALSE.
- LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=PRT(IIB:IIE,IJB:IJE,IKB:IKE,2)>XRTMIN(2) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,3)>XRTMIN(3) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,5)>XRTMIN(5) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)>XRTMIN(6) .OR. &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,7)>XRTMIN(7)
- LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,2)>ZRSMIN(2) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,3)>ZRSMIN(3) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>ZRSMIN(4) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,5)>ZRSMIN(5) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,6)>ZRSMIN(6) .OR. &
- PRS(IIB:IIE,IJB:IJE,IKB:IKE,7)>ZRSMIN(7)
CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
- COUNT(LLMICRO), COUNT(LLMICRO), &
- .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI,&
- PTSTEP, KRR, LLMICRO, ZEXN, &
+ 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
+ PTSTEP, KRR, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
diff --git a/src/PHYEX/micro/interp_micro.func.h b/src/PHYEX/micro/interp_micro.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..ec9a912eafdbc59d879bea36596c0f73461e4ecb
--- /dev/null
+++ b/src/PHYEX/micro/interp_micro.func.h
@@ -0,0 +1,269 @@
+!These routines are intented to be included in the contains part of other subroutines.
+!To allow the transformation for GPU, no local array must be declared.
+!If a temporary local array is needed, it must be added as a buffer in the interface (IBUF?, ZBUF?)
+
+SUBROUTINE INTERP_MICRO_1D(KPROMA, KSIZE, PIN, KNUM, P1, P2, &
+ LDPACK, LDMASK, KBUF1, KBUF2, PBUF1, PBUF2, &
+ KLEN, &
+ PLT1, POUT1, PLT2, POUT2, PLT3, POUT3)
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KPROMA !Array size
+INTEGER, INTENT(IN) :: KSIZE !Last usefull array index
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PIN !Input array
+INTEGER, INTENT(IN) :: KNUM !Number of points in the look-up table
+REAL, INTENT(IN) :: P1 !Scaling factor
+REAL, INTENT(IN) :: P2 !Scaling factor
+LOGICAL, INTENT(IN) :: LDPACK !.TRUE. to perform packing
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMASK !Computation mask
+INTEGER, DIMENSION(KPROMA), INTENT(OUT) :: KBUF1, KBUF2 !Buffer arrays
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PBUF1, PBUF2 !Buffer arrays
+INTEGER, INTENT(OUT) :: KLEN !Number of active points
+REAL, DIMENSION(KNUM), INTENT(IN) :: PLT1 !Look-up table
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: POUT1 !Interpolated values
+REAL, DIMENSION(KNUM), INTENT(IN) , OPTIONAL :: PLT2
+REAL, DIMENSION(KPROMA), INTENT(OUT), OPTIONAL :: POUT2
+REAL, DIMENSION(KNUM), INTENT(IN) , OPTIONAL :: PLT3
+REAL, DIMENSION(KPROMA), INTENT(OUT), OPTIONAL :: POUT3
+
+INTEGER :: JL
+INTEGER :: IINDEX
+REAL :: ZINDEX
+
+IF (LDPACK) THEN
+
+ !Pack input array
+ KLEN=0
+ DO JL=1, KSIZE
+ IF (LDMASK(JL)) THEN
+ KLEN=KLEN+1
+ PBUF1(KLEN)=PIN(JL)
+ KBUF1(KLEN)=JL
+ ENDIF
+ ENDDO
+
+ IF (KLEN>0) THEN
+ !Index computation
+ !$mnh_expand_array(JL=1:KLEN)
+ PBUF1(1:KLEN) = MAX(1.00001, MIN(REAL(KNUM)-0.00001, P1 * LOG(PBUF1(1:KLEN)) + P2))
+ KBUF2(1:KLEN) = INT(PBUF1(1:KLEN))
+ PBUF1(1:KLEN) = PBUF1(1:KLEN) - REAL(KBUF2(1:KLEN))
+ !$mnh_end_expand_array(JL=1:KLEN)
+
+ !Interpolation and unpack
+ !$mnh_expand_array(JL=1:KLEN)
+ PBUF2(1:KLEN) = PLT1(KBUF2(1:KLEN)+1) * PBUF1(1:KLEN) &
+ &-PLT1(KBUF2(1:KLEN) ) * (PBUF1(1:KLEN) - 1.0)
+ !$mnh_end_expand_array(JL=1:KLEN)
+ POUT1(:)=0.
+ DO JL=1, KLEN
+ POUT1(KBUF1(JL))=PBUF2(JL)
+ ENDDO
+
+ !Interpolation and unpack 2
+ IF(PRESENT(PLT2)) THEN
+ !$mnh_expand_array(JL=1:KLEN)
+ PBUF2(1:KLEN) = PLT2(KBUF2(1:KLEN)+1) * PBUF1(1:KLEN) &
+ &-PLT2(KBUF2(1:KLEN) ) * (PBUF1(1:KLEN) - 1.0)
+ !$mnh_end_expand_array(JL=1:KLEN)
+ POUT2(:)=0.
+ DO JL=1, KLEN
+ POUT2(KBUF1(JL))=PBUF2(JL)
+ ENDDO
+ ENDIF
+
+ !Interpolation and unpack 3
+ IF(PRESENT(PLT3)) THEN
+ !$mnh_expand_array(JL=1:KLEN)
+ PBUF2(1:KLEN) = PLT3(KBUF2(1:KLEN)+1) * PBUF1(1:KLEN) &
+ &-PLT3(KBUF2(1:KLEN) ) * (PBUF1(1:KLEN) - 1.0)
+ !$mnh_end_expand_array(JL=1:KLEN)
+ POUT3(:)=0.
+ DO JL=1, KLEN
+ POUT3(KBUF1(JL))=PBUF2(JL)
+ ENDDO
+ ENDIF
+
+ ENDIF
+
+ELSE
+
+ KLEN=0
+ DO JL=1, KSIZE
+ IF (LDMASK(JL)) THEN
+ KLEN=KLEN+1
+
+ !Index computation
+ ZINDEX = MAX(1.00001, MIN(REAL(KNUM)-0.00001, P1 * LOG(PIN(JL)) + P2))
+ IINDEX = INT(ZINDEX)
+ ZINDEX = ZINDEX - REAL(IINDEX)
+
+ !Interpolations
+ POUT1(JL) = PLT1(IINDEX+1) * ZINDEX &
+ &-PLT1(IINDEX ) * (ZINDEX - 1.0)
+
+ IF(PRESENT(PLT2)) THEN
+ POUT2(JL) = PLT2(IINDEX+1) * ZINDEX &
+ &-PLT2(IINDEX ) * (ZINDEX - 1.0)
+ ENDIF
+
+ IF(PRESENT(PLT3)) THEN
+ POUT3(JL) = PLT3(IINDEX+1) * ZINDEX &
+ &-PLT3(IINDEX ) * (ZINDEX - 1.0)
+ ENDIF
+
+ ELSE
+ POUT1(JL) = 0.
+ IF(PRESENT(PLT2)) POUT2(JL) = 0.
+ IF(PRESENT(PLT3)) POUT3(JL) = 0.
+ ENDIF
+ ENDDO
+
+ENDIF
+END SUBROUTINE INTERP_MICRO_1D
+
+SUBROUTINE INTERP_MICRO_2D(KPROMA, KSIZE, PIN1, PIN2, KNUM1, KNUM2, P11, P12, P21, P22,&
+ LDPACK, LDMASK, KBUF1, KBUF2, KBUF3, PBUF1, PBUF2, PBUF3, &
+ KLEN, &
+ PLT1, POUT1, PLT2, POUT2, PLT3, POUT3)
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KPROMA !Array size
+INTEGER, INTENT(IN) :: KSIZE !Last usefull array index
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PIN1 !Input array
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PIN2 !Input array
+INTEGER, INTENT(IN) :: KNUM1 !First dimension of the look-up table
+INTEGER, INTENT(IN) :: KNUM2 !Second dimension of the look-up table
+REAL, INTENT(IN) :: P11 !Scaling factor
+REAL, INTENT(IN) :: P12 !Scaling factor
+REAL, INTENT(IN) :: P21 !Scaling factor
+REAL, INTENT(IN) :: P22 !Scaling factor
+LOGICAL, INTENT(IN) :: LDPACK !.TRUE. to perform packing
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMASK !Computation mask
+INTEGER, DIMENSION(KPROMA), INTENT(OUT) :: KBUF1, KBUF2, KBUF3 !Buffer arrays
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PBUF1, PBUF2, PBUF3 !Buffer arrays
+INTEGER, INTENT(OUT) :: KLEN !Number of active points
+REAL, DIMENSION(KNUM1, KNUM2), INTENT(IN) :: PLT1 !Look-up table
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: POUT1 !Interpolated values from the first look-up table
+REAL, DIMENSION(KNUM1, KNUM2), INTENT(IN) , OPTIONAL :: PLT2 !Other look-up table
+REAL, DIMENSION(KPROMA), INTENT(OUT), OPTIONAL :: POUT2 !Interpolated values from the second look-up table
+REAL, DIMENSION(KNUM2, KNUM1), INTENT(IN) , OPTIONAL :: PLT3 !Another look-up table **CAUTION, TABLE IS REVERSED**
+REAL, DIMENSION(KPROMA), INTENT(OUT), OPTIONAL :: POUT3 !Interpolated values from the third look-up table
+
+INTEGER :: JL
+INTEGER :: IINDEX1, IINDEX2
+REAL :: ZINDEX1, ZINDEX2
+
+IF (LDPACK) THEN
+
+ !Pack input array
+ KLEN=0
+ DO JL=1, KSIZE
+ IF (LDMASK(JL)) THEN
+ KLEN=KLEN+1
+ PBUF1(KLEN)=PIN1(JL)
+ PBUF2(KLEN)=PIN2(JL)
+ KBUF3(KLEN)=JL
+ ENDIF
+ ENDDO
+
+ IF (KLEN>0) THEN
+ !Index computation
+ !$mnh_expand_array(JL=1:KLEN)
+ PBUF1(1:KLEN) = MAX(1.00001, MIN(REAL(KNUM1)-0.00001, P11 * LOG(PBUF1(1:KLEN)) + P12))
+ KBUF1(1:KLEN) = INT(PBUF1(1:KLEN))
+ PBUF1(1:KLEN) = PBUF1(1:KLEN) - REAL(KBUF1(1:KLEN))
+
+ PBUF2(1:KLEN) = MAX(1.00001, MIN(REAL(KNUM2)-0.00001, P21 * LOG(PBUF2(1:KLEN)) + P22))
+ KBUF2(1:KLEN) = INT(PBUF2(1:KLEN))
+ PBUF2(1:KLEN) = PBUF2(1:KLEN) - REAL(KBUF2(1:KLEN))
+ !$mnh_end_expand_array(JL=1:KLEN)
+
+ !Interpolation and unpack 1
+ DO JL=1, KLEN
+ PBUF3(JL) = ( PLT1(KBUF1(JL)+1,KBUF2(JL)+1)* PBUF2(JL) &
+ -PLT1(KBUF1(JL)+1,KBUF2(JL) )*(PBUF2(JL) - 1.0)) * PBUF1(JL) &
+ -( PLT1(KBUF1(JL) ,KBUF2(JL)+1)* PBUF2(JL) &
+ -PLT1(KBUF1(JL) ,KBUF2(JL) )*(PBUF2(JL) - 1.0)) * (PBUF1(JL) - 1.0)
+ ENDDO
+ POUT1(:)=0.
+ DO JL=1, KLEN
+ POUT1(KBUF3(JL))=PBUF3(JL)
+ ENDDO
+
+ !Interpolation and unpack 2
+ IF(PRESENT(PLT2)) THEN
+ DO JL=1, KLEN
+ PBUF3(JL) = ( PLT2(KBUF1(JL)+1,KBUF2(JL)+1)* PBUF2(JL) &
+ -PLT2(KBUF1(JL)+1,KBUF2(JL) )*(PBUF2(JL) - 1.0)) * PBUF1(JL) &
+ -( PLT2(KBUF1(JL) ,KBUF2(JL)+1)* PBUF2(JL) &
+ -PLT2(KBUF1(JL) ,KBUF2(JL) )*(PBUF2(JL) - 1.0)) * (PBUF1(JL) - 1.0)
+ ENDDO
+ POUT2(:)=0.
+ DO JL=1, KLEN
+ POUT2(KBUF3(JL))=PBUF3(JL)
+ ENDDO
+ ENDIF
+
+ !Interpolation and unpack 3
+ IF(PRESENT(PLT3)) THEN
+ DO JL=1, KLEN
+ PBUF3(JL) = ( PLT3(KBUF2(JL)+1,KBUF1(JL)+1)* PBUF1(JL) &
+ -PLT3(KBUF2(JL)+1,KBUF1(JL) )*(PBUF1(JL) - 1.0)) * PBUF2(JL) &
+ -( PLT3(KBUF2(JL) ,KBUF1(JL)+1)* PBUF1(JL) &
+ -PLT3(KBUF2(JL) ,KBUF1(JL) )*(PBUF1(JL) - 1.0)) * (PBUF2(JL) - 1.0)
+ ENDDO
+ POUT3(:)=0.
+ DO JL=1, KLEN
+ POUT3(KBUF3(JL))=PBUF3(JL)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ELSE
+
+ KLEN=0
+ DO JL=1, KSIZE
+ IF (LDMASK(JL)) THEN
+ KLEN=KLEN+1
+
+ !Indexes computation
+ ZINDEX1 = MAX(1.00001, MIN(REAL(KNUM1)-0.00001, P11 * LOG(PIN1(JL)) + P12))
+ IINDEX1 = INT(ZINDEX1)
+ ZINDEX1 = ZINDEX1 - REAL(IINDEX1)
+
+ ZINDEX2 = MAX(1.00001, MIN(REAL(KNUM1)-0.00001, P21 * LOG(PIN2(JL)) + P22))
+ IINDEX2 = INT(ZINDEX2)
+ ZINDEX2 = ZINDEX2 - REAL(IINDEX2)
+
+ !Interpolations
+ POUT1(JL) = ( PLT1(IINDEX1+1,IINDEX2+1)* ZINDEX2 &
+ -PLT1(IINDEX1+1,IINDEX2 )*(ZINDEX2 - 1.0)) * ZINDEX1 &
+ -( PLT1(IINDEX1 ,IINDEX2+1)* ZINDEX2 &
+ -PLT1(IINDEX1 ,IINDEX2 )*(ZINDEX2 - 1.0)) * (ZINDEX1 - 1.0)
+
+ IF(PRESENT(PLT2)) THEN
+ POUT2(JL) = ( PLT2(IINDEX1+1,IINDEX2+1)* ZINDEX2 &
+ -PLT2(IINDEX1+1,IINDEX2 )*(ZINDEX2 - 1.0)) * ZINDEX1 &
+ -( PLT2(IINDEX1 ,IINDEX2+1)* ZINDEX2 &
+ -PLT2(IINDEX1 ,IINDEX2 )*(ZINDEX2 - 1.0)) * (ZINDEX1 - 1.0)
+ ENDIF
+
+ IF(PRESENT(PLT3)) THEN
+ POUT3(JL) = ( PLT3(IINDEX2+1,IINDEX1+1)* ZINDEX1 &
+ -PLT3(IINDEX2+1,IINDEX1 )*(ZINDEX1 - 1.0)) * ZINDEX2 &
+ -( PLT3(IINDEX2 ,IINDEX1+1)* ZINDEX1 &
+ -PLT3(IINDEX2 ,IINDEX1 )*(ZINDEX1 - 1.0)) * (ZINDEX2 - 1.0)
+ ENDIF
+
+ ELSE
+ POUT1(JL)=0.
+ IF(PRESENT(PLT2)) POUT2(JL)=0.
+ IF(PRESENT(PLT3)) POUT3(JL)=0.
+ ENDIF
+ ENDDO
+
+ENDIF
+END SUBROUTINE INTERP_MICRO_2D
diff --git a/src/PHYEX/micro/modd_fields_address.f90 b/src/PHYEX/micro/modd_fields_address.f90
index 322b9957ea830dde6c34b2108f5a385d036deb16..45786b5a345ddb2ad6ccc02514a1d9cc1fde73dd 100644
--- a/src/PHYEX/micro/modd_fields_address.f90
+++ b/src/PHYEX/micro/modd_fields_address.f90
@@ -44,4 +44,50 @@ INTEGER, PARAMETER :: & ! pointer of fields in microphysic species arrays :
& IRG=6, & ! Graupel
& IRH=7 ! Hail
!
+! Pointers for tendency arrays
+! Tendencies are computed either directly as a tendency or as a mixing ratio change that is transformed, afterwards, in a tendency
+! The second type is suffixed by _MR
+! Some final tendencies can have two contributions (one from a tendency, one from a mixing ratio change).
+! In the following list, order matters:
+! - first are the normal tendencies directly computed as tendencies
+! - second are the tendencies computed only from a mixing ratio change
+! - third are the indexes used to designate the mising ratio change part of double-contribution tendencies
+INTEGER, PARAMETER :: IBUNUM=47, & ! Total number
+ IBUNUM_MR=3, & ! Number of tendencies computed only from a mixing ratio change
+ IBUNUM_EXTRA=2 ! Extra terms
+INTEGER, PARAMETER :: &
+ !normal tendencies directly computed as tendencies
+ & IRCHONI=1, & ! Homogeneous nucleation
+ & IRVDEPS=2, & ! Deposition on r_s,
+ & IRIAGGS=3, & ! Aggregation on r_s
+ & IRIAUTS=4, & ! Autoconversion of r_i for r_s production
+ & IRVDEPG=5, & ! Deposition on r_g
+ & IRCAUTR=6, & ! Autoconversion of r_c for r_r production
+ & IRCACCR=7, & ! Accretion of r_c for r_r production
+ & IRREVAV=8, & ! Evaporation of r_r
+ & IRCBERI=9, & ! Bergeron-Findeisen effect
+ & IRHMLTR=10, & ! Melting of the hailstones
+ & IRSMLTG=11, & ! Conversion-Melting of the aggregates
+ & IRCMLTSR=12, & ! Cloud droplet collection onto aggregates by positive temperature
+ & IRRACCSS=13, IRRACCSG=14, IRSACCRG=15, & ! Rain accretion onto the aggregates
+ & IRCRIMSS=16, IRCRIMSG=17, IRSRIMCG=18, & ! Cloud droplet riming of the aggregates
+ & IRICFRRG=19, IRRCFRIG=20, IRICFRR=21, & ! Rain contact freezing
+ & IRCWETG=22, IRIWETG=23, IRRWETG=24, IRSWETG=25, & ! Graupel wet growth
+ & IRCDRYG=26, IRIDRYG=27, IRRDRYG=28, IRSDRYG=29, & ! Graupel dry growth
+ & IRWETGH=30, & ! Conversion of graupel into hail
+ & IRGMLTR=31, & ! Melting of the graupel
+ & IRCWETH=32, IRIWETH=33, IRSWETH=34, IRGWETH=35, IRRWETH=36, & ! Dry growth of hailstone
+ & IRCDRYH=37, IRIDRYH=38, IRSDRYH=39, IRRDRYH=40, IRGDRYH=41, & ! Wet growth of hailstone
+ & IRDRYHG=42, &
+
+ !tendencies computed only with a mixing ratio change
+ & IRVHENI_MR=43, & ! heterogeneous nucleation mixing ratio change
+ & IRRHONG_MR=44, & ! Spontaneous freezing mixing ratio change
+ & IRIMLTC_MR=45, & ! Cloud ice melting mixing ratio change
+
+ !Extra term computed as a mixing ratio change, to be added to other term
+ & IRSRIMCG_MR=46,& ! Cloud droplet riming of the aggregates
+ & IRWETGH_MR=47 ! Conversion of graupel into hail
+INTEGER, PARAMETER, DIMENSION(IBUNUM-IBUNUM_EXTRA+1:IBUNUM) :: IBUEXTRAIND=(/18, 30/)
+!
END MODULE MODD_FIELDS_ADDRESS
diff --git a/src/PHYEX/micro/modd_param_ice.f90 b/src/PHYEX/micro/modd_param_ice.f90
index 0ce2390e82aaf1e1f0d3eade38cf81cce5809452..8f7ea8f52195660c051d6204d788300fc215c487 100644
--- a/src/PHYEX/micro/modd_param_ice.f90
+++ b/src/PHYEX/micro/modd_param_ice.f90
@@ -79,6 +79,9 @@ LOGICAL :: LSEDIM_AFTER ! sedimentation done before (.FALSE.) or after (.TRUE.)
!
REAL :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme
LOGICAL :: LSNOW_T ! Snow parameterization from Wurtz (2021)
+!
+LOGICAL :: LPACK_INTERP !To pack arrays before computing the different interpolations (kernels and other)
+LOGICAL :: LPACK_MICRO !To pack arrays before computing the process tendencies
END TYPE PARAM_ICE_t
!
TYPE(PARAM_ICE_t), SAVE, TARGET :: PARAM_ICE
@@ -98,7 +101,9 @@ LOGICAL, POINTER :: LWARM => NULL(), &
LADJ_BEFORE => NULL(), &
LADJ_AFTER => NULL(), &
LSEDIM_AFTER => NULL(),&
- LSNOW_T => NULL()
+ LSNOW_T => NULL(),&
+ LPACK_INTERP => NULL(),&
+ LPACK_MICRO => NULL()
REAL, POINTER :: XVDEPOSC => NULL(), &
XFRACM90 => NULL(), &
@@ -138,6 +143,8 @@ SUBROUTINE PARAM_ICE_ASSOCIATE()
LADJ_AFTER => PARAM_ICE%LADJ_AFTER
LSEDIM_AFTER => PARAM_ICE%LSEDIM_AFTER
LSNOW_T => PARAM_ICE%LSNOW_T
+ LPACK_INTERP => PARAM_ICE%LPACK_INTERP
+ LPACK_MICRO => PARAM_ICE%LPACK_MICRO
!
XVDEPOSC => PARAM_ICE%XVDEPOSC
XFRACM90 => PARAM_ICE%XFRACM90
diff --git a/src/PHYEX/micro/mode_ice4_budgets.f90 b/src/PHYEX/micro/mode_ice4_budgets.f90
new file mode 100644
index 0000000000000000000000000000000000000000..99cf34f3123f146272562530c881fec1efb33a29
--- /dev/null
+++ b/src/PHYEX/micro/mode_ice4_budgets.f90
@@ -0,0 +1,436 @@
+!MNH_LIC Copyright 1995-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.
+!-----------------------------------------------------------------
+! ######spl
+MODULE MODE_ICE4_BUDGETS
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_BUDGETS(D, PARAMI, BUCONF, KSIZE, PTSTEP, KRR, K1, K2, &
+ PLVFACT, PLSFACT, PRHODJ, PEXNREF, &
+ PRVHENI, PBU_PACK, &
+ TBUDGETS, KBUDGETS)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+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
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+!
+USE MODD_FIELDS_ADDRESS ! index number for prognostic (theta and mixing ratios) and budgets
+!
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PTSTEP
+INTEGER, INTENT(IN) :: KRR
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
+INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PRHODJ
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PEXNREF
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PRVHENI
+REAL, DIMENSION(KSIZE, IBUNUM-IBUNUM_EXTRA), INTENT(IN) :: PBU_PACK
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+INTEGER :: JIJ, JK, JL
+INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_DIFF, ZZ_LVFACT, ZZ_LSFACT
+REAL :: ZINV_TSTEP
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_BUDGETS', 0, ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IIJB=D%NIJB
+IIJE=D%NIJE
+ZINV_TSTEP=1./PTSTEP
+!
+IF (BUCONF%LBUDGET_TH) THEN
+ ZZ_DIFF(:,:)=0.
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ZZ_LVFACT(JIJ, JK) = PLVFACT(JIJ, JK) / PEXNREF(JIJ, JK)
+ ZZ_LSFACT(JIJ, JK) = PLSFACT(JIJ, JK) / PEXNREF(JIJ, JK)
+ ZZ_DIFF(JIJ, JK) = ZZ_LSFACT(JIJ, JK) - ZZ_LVFACT(JIJ, JK)
+ ENDDO
+ ENDDO
+END IF
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVHENI_MR) * ZINV_TSTEP
+END DO
+DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ZW1(JIJ,JK)=ZW1(JIJ,JK)+PRVHENI(JIJ,JK)
+ ENDDO
+ENDDO
+#ifdef REPRO48
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HENU', ZW1(:, :) *PRHODJ(:, :))
+#else
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIN', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIN', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIN', ZW1(:, :) *PRHODJ(:, :))
+#endif
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCHONI) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HON', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HON', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HON', ZW1(:, :) *PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRRHONG_MR) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'SFR', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'SFR', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'SFR', ZW1(:, :) *PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVDEPS) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ZW1(:, :) *PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIAGGS) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', -ZW1(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', ZW1(:, :)*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIAUTS) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AUTS', -ZW1(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AUTS', ZW1(:, :)*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRVDEPG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ZW1(:, :) *PRHODJ(:, :))
+
+IF(PARAMI%LWARM) THEN
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCAUTR) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', -ZW1(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', ZW1(:, :)*PRHODJ(:, :))
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCACCR) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', -ZW1(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', ZW1(:, :)*PRHODJ(:, :))
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRREVAV) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', -ZW1(:, :)*ZZ_LVFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', -ZW1(:, :) *PRHODJ(:, :))
+ENDIF
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCRIMSS) * ZINV_TSTEP
+END DO
+ZW2(:,:) = 0.
+DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRCRIMSG) * ZINV_TSTEP
+END DO
+ZW3(:,:) = 0.
+DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRSRIMCG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRRACCSS) * ZINV_TSTEP
+END DO
+ZW2(:,:) = 0.
+DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRACCSG) * ZINV_TSTEP
+END DO
+ZW3(:,:) = 0.
+DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRSACCRG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRSMLTG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', -ZW1(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', ZW1(:, :)*PRHODJ(:, :))
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCMLTSR) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CMEL', -ZW1(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CMEL', ZW1(:, :)*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRICFRRG) * ZINV_TSTEP
+END DO
+ZW2(:,:) = 0.
+DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRCFRIG) * ZINV_TSTEP
+END DO
+ZW3(:,:) = 0.
+DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRICFRR) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :)+ZW2(:, :))*PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCWETG) * ZINV_TSTEP
+END DO
+ZW2(:,:) = 0.
+DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRWETG) * ZINV_TSTEP
+END DO
+ZW3(:,:) = 0.
+DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIWETG) * ZINV_TSTEP
+END DO
+ZW4(:,:) = 0.
+DO JL=1, KSIZE
+ ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSWETG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', -ZW2(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', -ZW3(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', -ZW4(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
+ & *PRHODJ(:, :))
+
+IF(KRR==7) THEN
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRWETGH) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GHCV', -ZW1(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'GHCV', ZW1(:, :)*PRHODJ(:, :))
+END IF
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCDRYG) * ZINV_TSTEP
+END DO
+ZW2(:,:) = 0.
+DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRDRYG) * ZINV_TSTEP
+END DO
+ZW3(:,:) = 0.
+DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIDRYG) * ZINV_TSTEP
+END DO
+ZW4(:,:) = 0.
+DO JL=1, KSIZE
+ ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSDRYG) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', -ZW2(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', -ZW3(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', -ZW4(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
+ & *PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRGMLTR) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ZW1(:, :) *PRHODJ(:, :))
+
+IF(KRR==7) THEN
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCWETH) * ZINV_TSTEP
+ END DO
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRWETH) * ZINV_TSTEP
+ END DO
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIWETH) * ZINV_TSTEP
+ END DO
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSWETH) * ZINV_TSTEP
+ END DO
+ ZW5(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(K1(JL), K2(JL)) = PBU_PACK(JL, IRGWETH) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :) *PRHODJ(:, :))
+#ifdef REPRO48
+#else
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :) *PRHODJ(:, :))
+#endif
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
+ &ZW4(:, :)+ZW5(:, : )) *PRHODJ(:, :))
+
+#if defined(REPRO48) || defined(REPRO55)
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRGWETH) * ZINV_TSTEP
+ END DO
+#endif
+#ifdef REPRO48
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :)-ZW1(:, :))*PRHODJ(:, :))
+#endif
+#ifdef REPRO55
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW1(:, :)*PRHODJ(:, :))
+#endif
+#if defined(REPRO48) || defined(REPRO55)
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :))
+#endif
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCDRYH) * ZINV_TSTEP
+ END DO
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(K1(JL), K2(JL)) = PBU_PACK(JL, IRRDRYH) * ZINV_TSTEP
+ END DO
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(K1(JL), K2(JL)) = PBU_PACK(JL, IRIDRYH) * ZINV_TSTEP
+ END DO
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(K1(JL), K2(JL)) = PBU_PACK(JL, IRSDRYH) * ZINV_TSTEP
+ END DO
+ ZW5(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(K1(JL), K2(JL)) = PBU_PACK(JL, IRGDRYH) * ZINV_TSTEP
+ END DO
+ ZW6(:,:) = 0.
+#if defined(REPRO48) || defined(REPRO55)
+ !ZW6 must be removed when REPRO* will be suppressed
+ DO JL=1, KSIZE
+ ZW6(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP
+ END DO
+#endif
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :)+ZW6(:, :)) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
+ &ZW4(:, :)+ZW5(:, :)-ZW6(:, :)) &
+ & *PRHODJ(:, :))
+
+#if defined(REPRO48) || defined(REPRO55)
+#else
+ !When REPRO48 will be suppressed, ZW6 must be removed
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW1(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :))
+#endif
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRHMLTR) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ZW1(:, :) *PRHODJ(:, :))
+ENDIF
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRIMLTC_MR) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', -ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ZW1(:, :) *PRHODJ(:, :))
+
+ZW1(:,:) = 0.
+DO JL=1, KSIZE
+ ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCBERI) * ZINV_TSTEP
+END DO
+IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ZW1(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', -ZW1(:, :) *PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', ZW1(:, :) *PRHODJ(:, :))
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_BUDGETS', 1, ZHOOK_HANDLE)
+!
+END SUBROUTINE ICE4_BUDGETS
+!
+END MODULE MODE_ICE4_BUDGETS
diff --git a/src/PHYEX/micro/mode_ice4_correct_negativities.f90 b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
new file mode 100644
index 0000000000000000000000000000000000000000..12f8b08aa4eed8fc9565d2fc7462d48cf92eabff
--- /dev/null
+++ b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
@@ -0,0 +1,118 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_ICE4_CORRECT_NEGATIVITIES
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
+ &PRI, PRS, PRG, &
+ &PTH, PLVFACT, PLSFACT, PRH)
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KRR
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
+REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
+!
+REAL :: ZW
+INTEGER :: JIJ, JK, IKTB, IKTE, IIJB, IIJE
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+!We correct negativities with conservation
+DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ! 1) deal with negative values for mixing ratio, except for vapor
+ ZW =PRC(JIJ,JK)-MAX(PRC(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+ PRC(JIJ,JK)=PRC(JIJ,JK)-ZW
+
+ ZW =PRR(JIJ,JK)-MAX(PRR(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+ PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+
+ ZW =PRI(JIJ,JK)-MAX(PRI(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRI(JIJ,JK)=PRI(JIJ,JK)-ZW
+
+ ZW =PRS(JIJ,JK)-MAX(PRS(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+
+ ZW =PRG(JIJ,JK)-MAX(PRG(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
+
+ IF(KRR==7) THEN
+ ZW =PRH(JIJ,JK)-MAX(PRH(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+ ENDIF
+
+ ! 2) deal with negative vapor mixing ratio
+
+ ! for rc and ri, we keep ice fraction constant
+ ZW=MIN(1., MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.) / &
+ &MAX(PRC(JIJ,JK)+PRI(JIJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW* &
+ &(PRC(JIJ,JK)*PLVFACT(JIJ,JK)+PRI(JIJ,JK)*PLSFACT(JIJ,JK))
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW*(PRC(JIJ,JK)+PRI(JIJ,JK))
+ PRC(JIJ,JK)=(1.-ZW)*PRC(JIJ,JK)
+ PRI(JIJ,JK)=(1.-ZW)*PRI(JIJ,JK)
+
+ ZW=MIN(MAX(PRR(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+
+ ZW=MIN(MAX(PRS(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+
+ ZW=MIN(MAX(PRG(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+
+ IF(KRR==7) THEN
+ ZW=MIN(MAX(PRH(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ ENDIF
+ ENDDO
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
+!
+END SUBROUTINE ICE4_CORRECT_NEGATIVITIES
+!
+END MODULE MODE_ICE4_CORRECT_NEGATIVITIES
diff --git a/src/PHYEX/micro/mode_ice4_fast_rg.f90 b/src/PHYEX/micro/mode_ice4_fast_rg.f90
index a3457b89e99265cb6324ac53302a3616e871d308..e861b521e69116ceee0607e9998e1debd2314a0e 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rg.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rg.f90
@@ -97,15 +97,14 @@ REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
& IFREEZ1=7, IFREEZ2=8
LOGICAL, DIMENSION(KPROMA) :: GDRY, LLDRYG
-INTEGER, DIMENSION(KPROMA) :: I1
INTEGER :: IGDRY
-REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2, ZBUF3
+INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2, IBUF3
REAL, DIMENSION(KPROMA) :: ZZW, &
ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
ZRWETG_INIT !Initial wet growth rate of the graupeln
REAL :: ZZW0D
-INTEGER :: JJ, JL
+INTEGER :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -171,58 +170,23 @@ DO JL=1, KSIZE
ENDDO
! Wet and dry collection of rs on graupel (6.2.1)
-IGDRY = 0
DO JL = 1, KSIZE
IF (PRST(JL)>ICED%XRTMIN(5) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JL
GDRY(JL) = .TRUE.
ELSE
GDRY(JL) = .FALSE.
PRG_TEND(JL, IRSDRYG)=0.
PRG_TEND(JL, IRSWETG)=0.
- END IF
+ ENDIF
ENDDO
+
IF(.NOT. LDSOFT) THEN
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAG(:), PLBDAS(:), ICEP%NDRYLBDAG, ICEP%NDRYLBDAS, &
+ &ICEP%XDRYINTP1G, ICEP%XDRYINTP2G, ICEP%XDRYINTP1S, ICEP%XDRYINTP2S, &
+ &PARAMI%LPACK_INTERP, GDRY(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGDRY, &
+ &ICEP%XKER_SDRYG(:,:), ZZW(:))
IF(IGDRY>0)THEN
- !
- !* 6.2.3 select the (PLBDAG,PLBDAS) couplet
- !
- DO JJ = 1, IGDRY
- ZVEC1(JJ) = PLBDAG(I1(JJ))
- ZVEC2(JJ) = PLBDAS(I1(JJ))
- END DO
- !
- !* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
- ! tabulate the SDRYG-kernel
- !
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(ICEP%NDRYLBDAG)-0.00001, &
- ICEP%XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+ICEP%XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAS)-0.00001, &
- ICEP%XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+ICEP%XDRYINTP2S))
- IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
- !
- !* 6.2.5 perform the bilinear interpolation of the normalized
- ! SDRYG-kernel
- !
- DO JJ=1, IGDRY
- ZVEC3(JJ) = ( ICEP%XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGDRY
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GDRY(1:KSIZE))
PRG_TEND(1:KSIZE, IRSWETG)=ICEP%XFSDRYG*ZZW(1:KSIZE) & ! RSDRYG
@@ -245,11 +209,8 @@ ENDIF
!
!* 6.2.6 accretion of raindrops on the graupeln
!
-IGDRY = 0
DO JL = 1, KSIZE
IF (PRRT(JL)>ICED%XRTMIN(3) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JL
GDRY(JL) = .TRUE.
ELSE
GDRY(JL) = .FALSE.
@@ -258,45 +219,12 @@ DO JL = 1, KSIZE
ENDDO
IF(.NOT. LDSOFT) THEN
!
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAG(:), PLBDAR(:), ICEP%NDRYLBDAG, ICEP%NDRYLBDAR, &
+ &ICEP%XDRYINTP1G, ICEP%XDRYINTP2G, ICEP%XDRYINTP1R, ICEP%XDRYINTP2R, &
+ &PARAMI%LPACK_INTERP, GDRY(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGDRY, &
+ &ICEP%XKER_RDRYG(:,:), ZZW(:))
IF(IGDRY>0) THEN
- !
- !* 6.2.8 select the (PLBDAG,PLBDAR) couplet
- !
- DO JJ = 1, IGDRY
- ZVEC1(JJ) = PLBDAG(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- ENDDO
- !
- !* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
- ! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
- ! tabulate the RDRYG-kernel
- !
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAG)-0.00001, &
- ICEP%XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+ICEP%XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAR)-0.00001, &
- ICEP%XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+ICEP%XDRYINTP2R))
- IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
- !
- !* 6.2.10 perform the bilinear interpolation of the normalized
- ! RDRYG-kernel
- !
- DO JJ=1, IGDRY
- ZVEC3(JJ)= ( ICEP%XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGDRY
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GDRY(1:KSIZE))
PRG_TEND(1:KSIZE, IRRDRYG) = ICEP%XFRDRYG*ZZW(1:KSIZE) & ! RRDRYG
@@ -439,6 +367,11 @@ DO JL=1, KSIZE
ENDDO
!
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 1, ZHOOK_HANDLE)
-
+!
+CONTAINS
+!
+INCLUDE "interp_micro.func.h"
+!
END SUBROUTINE ICE4_FAST_RG
+!
END MODULE MODE_ICE4_FAST_RG
diff --git a/src/PHYEX/micro/mode_ice4_fast_rh.f90 b/src/PHYEX/micro/mode_ice4_fast_rh.f90
index 3d13263d73a3d9d3da053943622cc70cc540113b..c35275a392405ce6ac6d661d415b0f4191b5549b 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rh.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rh.f90
@@ -93,9 +93,8 @@ INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRS
& IFREEZ1=9, IFREEZ2=10
LOGICAL, DIMENSION(KPROMA) :: GWET
INTEGER :: IGWET
-INTEGER, DIMENSION(KPROMA) :: I1
-REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2, ZBUF3
+INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2, IBUF3
REAL, DIMENSION(KPROMA) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
@@ -134,11 +133,8 @@ ENDDO
!
!* 7.2.1 accretion of aggregates on the hailstones
!
-IGWET = 0
DO JL = 1, KSIZE
IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JL
GWET(JL) = .TRUE.
ELSE
GWET(JL) = .FALSE.
@@ -147,45 +143,12 @@ DO JL = 1, KSIZE
ENDIF
ENDDO
IF(.NOT. LDSOFT) THEN
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAH(:), PLBDAS(:), ICEP%NWETLBDAH, ICEP%NWETLBDAS, &
+ &ICEP%XWETINTP1H, ICEP%XWETINTP2H, ICEP%XWETINTP1S, ICEP%XWETINTP2S, &
+ &PARAMI%LPACK_INTERP, GWET(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGWET, &
+ &ICEP%XKER_SWETH(:,:), ZZW(:))
IF(IGWET>0)THEN
- !
- !* 7.2.3 select the (PLBDAH,PLBDAS) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAS(I1(JJ))
- ENDDO
- !
- !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
- ! tabulate the SWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAH)-0.00001, &
- ICEP%XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + ICEP%XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAS)-0.00001, &
- ICEP%XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + ICEP%XWETINTP2S ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.5 perform the bilinear interpolation of the normalized
- ! SWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( ICEP%XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRSWETH)=ICEP%XFSWETH*ZZW(1:KSIZE) & ! RSWETH
@@ -207,11 +170,8 @@ ENDIF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
-IGWET = 0
DO JL = 1, KSIZE
IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JL
GWET(JL) = .TRUE.
ELSE
GWET(JL) = .FALSE.
@@ -220,45 +180,12 @@ DO JL = 1, KSIZE
END IF
ENDDO
IF(.NOT. LDSOFT) THEN
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAH(:), PLBDAG(:), ICEP%NWETLBDAH, ICEP%NWETLBDAG, &
+ &ICEP%XWETINTP1H, ICEP%XWETINTP2H, ICEP%XWETINTP1G, ICEP%XWETINTP2G, &
+ &PARAMI%LPACK_INTERP, GWET(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGWET, &
+ &ICEP%XKER_GWETH(:,:), ZZW(:))
IF(IGWET>0)THEN
- !
- !* 7.2.8 select the (PLBDAH,PLBDAG) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAG(I1(JJ))
- END DO
- !
- !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
- ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
- ! tabulate the GWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAG)-0.00001, &
- ICEP%XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + ICEP%XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAG)-0.00001, &
- ICEP%XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + ICEP%XWETINTP2G ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.10 perform the bilinear interpolation of the normalized
- ! GWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( ICEP%XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRGWETH)=ICEP%XFGWETH*ZZW(1:KSIZE) & ! RGWETH
@@ -279,11 +206,8 @@ ENDIF
!
!* 7.2.11 accretion of raindrops on the hailstones
!
-IGWET = 0
DO JL = 1, KSIZE
IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JL
GWET(JL) = .TRUE.
ELSE
GWET(JL) = .FALSE.
@@ -291,45 +215,12 @@ DO JL = 1, KSIZE
ENDIF
ENDDO
IF(.NOT. LDSOFT) THEN
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAH(:), PLBDAR(:), ICEP%NWETLBDAH, ICEP%NWETLBDAR, &
+ &ICEP%XWETINTP1H, ICEP%XWETINTP2H, ICEP%XWETINTP1R, ICEP%XWETINTP2R, &
+ &PARAMI%LPACK_INTERP, GWET(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGWET, &
+ &ICEP%XKER_RWETH(:,:), ZZW(:))
IF(IGWET>0)THEN
- !
- !* 7.2.12 select the (PLBDAH,PLBDAR) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- ENDDO
- !
- !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
- ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
- ! tabulate the RWETH-kernel
- !
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(ICEP%NWETLBDAH)-0.00001, &
- ICEP%XWETINTP1H*LOG(ZVEC1(1:IGWET))+ICEP%XWETINTP2H))
- IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
- !
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(ICEP%NWETLBDAR)-0.00001, &
- ICEP%XWETINTP1R*LOG(ZVEC2(1:IGWET))+ICEP%XWETINTP2R))
- IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
- !
- !* 7.2.14 perform the bilinear interpolation of the normalized
- ! RWETH-kernel
- !
- DO JJ=1, IGWET
- ZVEC3(JJ)= ( ICEP%XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRRWETH) = ICEP%XFRWETH*ZZW(1:KSIZE) & ! RRWETH
@@ -476,5 +367,9 @@ ENDDO
!
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH', 1, ZHOOK_HANDLE)
!
+CONTAINS
+!
+INCLUDE "interp_micro.func.h"
+!
END SUBROUTINE ICE4_FAST_RH
END MODULE MODE_ICE4_FAST_RH
diff --git a/src/PHYEX/micro/mode_ice4_fast_rs.f90 b/src/PHYEX/micro/mode_ice4_fast_rs.f90
index 6655b2061604da1a8fc9f135b27728317ad0ba93..d79105d0c9f6cd0b2de3959b14a4bc558aa16288 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rs.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rs.f90
@@ -85,11 +85,11 @@ INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5,
& IFREEZ1=7, IFREEZ2=8
LOGICAL, DIMENSION(KPROMA) :: GRIM, GACC
INTEGER :: IGRIM, IGACC
-INTEGER, DIMENSION(KPROMA) :: I1
-REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
-REAL, DIMENSION(KPROMA) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
+INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2, IBUF3
+REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2, ZBUF3
+REAL, DIMENSION(KPROMA) :: ZZW, ZZW1, ZZW2, ZZW3, ZFREEZ_RATE
INTEGER :: JJ, JL
+REAL :: ZZW0D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -137,11 +137,13 @@ ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
-IGRIM = 0
DO JL=1, KSIZE
IF (PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
- IGRIM = IGRIM + 1
- I1(IGRIM) = JL
+#if defined(REPRO48) || defined(REPRO55)
+ ZZW(JL) = PLBDAS(JL)
+#else
+ ZZW(JL) = (PLBDAS(JL)**ICED%XALPHAS + ICED%XFVELOS**ICED%XALPHAS)**(1./ICED%XALPHAS)
+#endif
GRIM(JL) = .TRUE.
ELSE
GRIM(JL) = .FALSE.
@@ -153,77 +155,29 @@ ENDDO
!
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
IF(.NOT. LDSOFT) THEN
+ CALL INTERP_MICRO_1D(KPROMA, KSIZE, ZZW, ICEP%NGAMINC, ICEP%XRIMINTP1, ICEP%XRIMINTP2, &
+ PARAMI%LPACK_INTERP, GRIM(:), IBUF1, IBUF2, ZBUF1, ZBUF2, &
+ IGRIM, &
+ ICEP%XGAMINC_RIM1(:), ZZW1(:), ICEP%XGAMINC_RIM2(:), ZZW2(:), ICEP%XGAMINC_RIM4(:), ZZW3(:))
IF(IGRIM>0) THEN
- !
- ! 5.1.1 select the PLBDAS
- !
- DO JJ = 1, IGRIM
-#if defined(REPRO48) || defined(REPRO55)
- ZVEC1(JJ) = PLBDAS(I1(JJ))
-#else
- ZVEC1(JJ) = (PLBDAS(I1(JJ))**ICED%XALPHAS + ICED%XFVELOS**ICED%XALPHAS)**(1./ICED%XALPHAS)
-#endif
- END DO
- !
- ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
- ! set of Lbda_s used to tabulate some moments of the incomplete
- ! gamma function
- !
- !$mnh_expand_where(JJ=1:IGRIM)
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(ICEP%NGAMINC)-0.00001, &
- ICEP%XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + ICEP%XRIMINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
- !
- ! 5.1.3 perform the linear interpolation of the normalized
- ! "2+XDS"-moment of the incomplete gamma function
- !
- ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - ICEP%XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- !$mnh_end_expand_where(JJ=1:IGRIM)
- ZZW(:) = 0.
- DO JJ = 1, IGRIM
- ZZW(I1(JJ)) = ZVEC1(JJ)
- END DO
!
! 5.1.4 riming of the small sized aggregates
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE (GRIM(1:KSIZE))
- PRS_TEND(1:KSIZE, IRCRIMSS) = ICEP%XCRIMSS * ZZW(1:KSIZE) * PRCT(1:KSIZE) & ! RCRIMSS
+ PRS_TEND(1:KSIZE, IRCRIMSS) = ICEP%XCRIMSS * ZZW1(1:KSIZE) * PRCT(1:KSIZE) & ! RCRIMSS
#if defined(REPRO48) || defined(REPRO55)
- * PLBDAS(1:KSIZE)**ICEP%XEXCRIMSS &
+ * PLBDAS(1:KSIZE)**ICEP%XEXCRIMSS &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
#else
- * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXCRIMSS/ICED%XALPHAS) &
+ * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**ICED%XALPHAS) &
+ **(-ICED%XNUS+ICEP%XEXCRIMSS/ICED%XALPHAS) &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
- * (PLBDAS(1:KSIZE)) ** (ICEP%XEXCRIMSS+ICED%XBS)
+ * (PLBDAS(1:KSIZE)) ** (ICEP%XEXCRIMSS+ICED%XBS)
#endif
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
!
- ! 5.1.5 perform the linear interpolation of the normalized
- ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) and
- ! "XBG"-moment of the incomplete gamma function (XGAMINC_RIM4)
- !
- !$mnh_expand_where(JJ=1:IGRIM)
- ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- !$mnh_end_expand_where(JJ=1:IGRIM)
- ZZW(:) = 0.
- DO JJ = 1, IGRIM
- ZZW(I1(JJ)) = ZVEC1(JJ)
- END DO
-
- !$mnh_expand_where(JJ=1:IGRIM)
- ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - ICEP%XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- !$mnh_end_expand_where(JJ=1:IGRIM)
- ZZW2(:) = 0.
- DO JJ = 1, IGRIM
- ZZW2(I1(JJ)) = ZVEC1(JJ)
- END DO
- !
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
@@ -234,7 +188,8 @@ IF(.NOT. LDSOFT) THEN
* PLBDAS(1:KSIZE)**ICEP%XEXCRIMSG &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
#else
- * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**(ICED%XALPHAS))**(-ICED%XNUS+ICEP%XEXCRIMSG/ICED%XALPHAS) &
+ * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**(ICED%XALPHAS)) &
+ **(-ICED%XNUS+ICEP%XEXCRIMSG/ICED%XALPHAS) &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
* PLBDAS(1:KSIZE)**(ICED%XBS+ICEP%XEXCRIMSG)
#endif
@@ -245,18 +200,20 @@ IF(.NOT. LDSOFT) THEN
!Murakami 1990
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GRIM(1:KSIZE))
- ZZW6(1:KSIZE) = PRS_TEND(1:KSIZE, IRCRIMS) - PRS_TEND(1:KSIZE, IRCRIMSS) ! RCRIMSG
+ ZZW(1:KSIZE) = PRS_TEND(1:KSIZE, IRCRIMS) - PRS_TEND(1:KSIZE, IRCRIMSS) ! RCRIMSG
#if defined(REPRO48) || defined(REPRO55)
- PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG*(1.0-ZZW(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG*(1.0-ZZW2(1:KSIZE))
#else
- PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PRST(1:KSIZE)*PRHODREF(1:KSIZE)*PLBDAS(1:KSIZE)**(ICEP%XEXSRIMCG+ICED%XBS)*(1.0-ZZW(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PRST(1:KSIZE)*PRHODREF(1:KSIZE) &
+ * PLBDAS(1:KSIZE)**(ICEP%XEXSRIMCG+ICED%XBS)*(1.0-ZZW2(1:KSIZE))
#endif
- PRS_TEND(1:KSIZE, IRSRIMCG)=ZZW6(1:KSIZE)*PRS_TEND(1:KSIZE, IRSRIMCG)/ &
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ZZW(1:KSIZE)*PRS_TEND(1:KSIZE, IRSRIMCG)/ &
MAX(1.E-20, &
#if defined(REPRO48) || defined(REPRO55)
- ICEP%XSRIMCG3*ICEP%XSRIMCG2*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW2(1:KSIZE)) - &
+ ICEP%XSRIMCG3*ICEP%XSRIMCG2*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW3(1:KSIZE)) - &
#else
- ICEP%XSRIMCG3*ICEP%XSRIMCG2*PRST(1:KSIZE)*PRHODREF(1:KSIZE)*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW2(1:KSIZE)) - &
+ ICEP%XSRIMCG3*ICEP%XSRIMCG2*PRST(1:KSIZE)*PRHODREF(1:KSIZE) &
+ *PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW3(1:KSIZE)) - &
#endif
ICEP%XSRIMCG3*PRS_TEND(1:KSIZE, IRSRIMCG))
END WHERE
@@ -272,10 +229,10 @@ DO JL=1, KSIZE
IF(GRIM(JL) .AND. PT(JL)<CST%XTT) THEN
PRCRIMSS(JL)=MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
- ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
- PRCRIMSG(JL) = ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZZW0D = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZZW0D * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
- PRSRIMCG(JL) = ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
+ PRSRIMCG(JL) = ZZW0D * PRS_TEND(JL, IRSRIMCG)
PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
@@ -288,11 +245,8 @@ ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
-IGACC = 0
DO JL = 1, KSIZE
IF (PRRT(JL)>ICED%XRTMIN(3) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
- IGACC = IGACC + 1
- I1(IGACC) = JL
GACC(JL) = .TRUE.
ELSE
GACC(JL) = .FALSE.
@@ -305,53 +259,17 @@ IF(.NOT. LDSOFT) THEN
PRS_TEND(:, IRRACCS)=0.
PRS_TEND(:, IRRACCSS)=0.
PRS_TEND(:, IRSACCRG)=0.
+ CALL INTERP_MICRO_2D(KPROMA, KSIZE, PLBDAS, PLBDAR, ICEP%NACCLBDAS, ICEP%NACCLBDAR, &
+ &ICEP%XACCINTP1S, ICEP%XACCINTP2S, ICEP%XACCINTP1R, ICEP%XACCINTP2R,&
+ &PARAMI%LPACK_INTERP, GACC(:), IBUF1(:), IBUF2(:), IBUF3(:), ZBUF1(:), ZBUF2(:), ZBUF3(:), &
+ &IGACC, &
+ &ICEP%XKER_RACCSS(:,:), ZZW1(:), ICEP%XKER_RACCS(:,:), ZZW2(:), ICEP%XKER_SACCRG(:,:), ZZW3(:))
IF(IGACC>0)THEN
- !
- !
- ! 5.2.1 select the (PLBDAS,PLBDAR) couplet
- !
- DO JJ = 1, IGACC
- ZVEC1(JJ) = PLBDAS(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- ENDDO
- !
- ! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
- ! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
- ! tabulate the RACCSS-kernel
- !
- !$mnh_expand_where(JJ=1:IGACC)
- ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(ICEP%NACCLBDAS)-0.00001, &
- ICEP%XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + ICEP%XACCINTP2S ) )
- IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
- ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
- !
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(ICEP%NACCLBDAR)-0.00001, &
- ICEP%XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + ICEP%XACCINTP2R ) )
- IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
- ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
- !$mnh_end_expand_where(JJ=1:IGACC)
- !
- ! 5.2.3 perform the bilinear interpolation of the normalized
- ! RACCSS-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( ICEP%XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
! 5.2.4 raindrop accretion on the small sized aggregates
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GACC(1:KSIZE))
- ZZW6(1:KSIZE) = & !! coef of RRACCS
+ ZZW(1:KSIZE) = & !! coef of RRACCS
#if defined(REPRO48) || defined(REPRO55)
ICEP%XFRACCSS*( PLBDAS(1:KSIZE)**ICED%XCXS )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
#else
@@ -360,52 +278,22 @@ IF(.NOT. LDSOFT) THEN
*( ICEP%XLBRACCS1/((PLBDAS(1:KSIZE)**2) ) + &
ICEP%XLBRACCS2/( PLBDAS(1:KSIZE) * PLBDAR(1:KSIZE) ) + &
ICEP%XLBRACCS3/( (PLBDAR(1:KSIZE)**2)) )/PLBDAR(1:KSIZE)**4
- PRS_TEND(1:KSIZE, IRRACCSS) =ZZW(1:KSIZE)*ZZW6(1:KSIZE)
+ PRS_TEND(1:KSIZE, IRRACCSS) =ZZW1(1:KSIZE)*ZZW(1:KSIZE)
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
!
- ! 5.2.4b perform the bilinear interpolation of the normalized
- ! RACCS-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( ICEP%XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( ICEP%XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - ICEP%XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GACC(1:KSIZE))
- PRS_TEND(1:KSIZE, IRRACCS) = ZZW(1:KSIZE)*ZZW6(1:KSIZE)
+ PRS_TEND(1:KSIZE, IRRACCS) = ZZW2(1:KSIZE)*ZZW(1:KSIZE)
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
- ! 5.2.5 perform the bilinear interpolation of the normalized
- ! SACCRG-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( ICEP%XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - ICEP%XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( ICEP%XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - ICEP%XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
!
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GACC(1:KSIZE))
- PRS_TEND(1:KSIZE, IRSACCRG) = ICEP%XFSACCRG*ZZW(1:KSIZE)* & ! RSACCRG
+ PRS_TEND(1:KSIZE, IRSACCRG) = ICEP%XFSACCRG*ZZW3(1:KSIZE)* & ! RSACCRG
#if defined(REPRO48) || defined(REPRO55)
( PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS) )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
#else
@@ -484,5 +372,9 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 1, ZHOOK_HANDLE)
!
+CONTAINS
+!
+INCLUDE "interp_micro.func.h"
+!
END SUBROUTINE ICE4_FAST_RS
END MODULE MODE_ICE4_FAST_RS
diff --git a/src/PHYEX/micro/mode_ice4_pack.f90 b/src/PHYEX/micro/mode_ice4_pack.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e955a223d98f4629b532d6cdd68f71539e59fa05
--- /dev/null
+++ b/src/PHYEX/micro/mode_ice4_pack.f90
@@ -0,0 +1,407 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_ICE4_PACK
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ KPROMA, KSIZE, KSIZE2, &
+ HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
+ PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PEVAP3D, &
+ PRAINFR, PSIGS, &
+ PRVHENI, PLVFACT, PLSFACT, &
+ PWR, &
+ TBUDGETS, KBUDGETS, &
+ PRHS )
+! -----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+ & ITH, & ! Potential temperature
+ & IRV, & ! Water vapor
+ & IRC, & ! Cloud water
+ & IRR, & ! Rain water
+ & IRI, & ! Pristine ice
+ & IRS, & ! Snow/aggregate
+ & IRG, & ! Graupel
+ & IRH, & ! Hail
+ & IBUNUM, & ! Number of tendency terms
+ & IBUNUM_EXTRA ! Number of extra tendency terms
+
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+
+USE MODE_ICE4_STEPPING, ONLY: ICE4_STEPPING
+USE MODE_ICE4_BUDGETS, ONLY: ICE4_BUDGETS
+!
+IMPLICIT NONE
+
+!NOTES ON SIZES
+!If we pack:
+! - KSIZE is the number of relevant point (with mixing ratio different from 0)
+! - KPROMA is the size of bloc of points
+! - ZSIZE2 has the same value as KPROMA
+!If we do not pack:
+! - KSIZE is the total number of points
+! - KPROMA is null for memory saving
+! - KSIZE2 has the same value as KSIZE
+!
+!When we do not pack, we can transmit directly the 3D arrays to the ice4_stepping subroutine, we do not need
+!to copy the values. It is why KPROMA is null because we do not need these arrays.
+!But some arrays must me manipulated before being transmitted and we need temporary arrays for this.
+!KSIZE2 is used for those arrays that must be dimensioned KPROMA if we pack or with the total size if not.
+
+
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
+INTEGER, INTENT(IN) :: KSIZE
+INTEGER, INTENT(IN) :: KSIZE2
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HCF
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVHENI ! heterogeneous nucleation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(D%NIJT,D%NKT,0:7), INTENT(OUT) :: PWR
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IIJB, IIJE
+INTEGER :: ISTIJ, ISTK
+!
+LOGICAL :: GEXT_TEND
+!
+!Output packed total mixing ratio change (for budgets only)
+REAL, DIMENSION(KSIZE, IBUNUM-IBUNUM_EXTRA) :: ZBU_PACK
+!
+!For packing
+INTEGER :: IMICRO ! Case r_x>0 locations
+INTEGER :: JL, JV
+REAL, DIMENSION(KPROMA) :: &
+ & ZCIT, & ! Pristine ice conc. at t
+ & ZRHODREF, & ! RHO Dry REFerence
+ & ZPRES, & ! Pressure
+ & ZEXN, & ! EXNer Pressure
+ & ZCF, & ! Cloud fraction
+ & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ & ZHLI_HCF, &
+ & ZHLI_HRI, &
+ & ZRREVAV
+REAL, DIMENSION(KSIZE2) :: ZSIGMA_RC ! Standard deviation of rc at time t
+LOGICAL, DIMENSION(KPROMA) :: LLMICRO
+!
+!Output packed tendencies (for budgets only)
+REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA) :: ZBU_SUM
+!
+!For mixing-ratio-splitting
+REAL, DIMENSION(KPROMA,0:7) :: ZVART !Packed variables
+REAL, DIMENSION(KSIZE2,0:7) :: ZEXTPK !To take into acount external tendencies inside the splitting
+!
+INTEGER, DIMENSION(KPROMA) :: I1,I2 ! Used to replace the COUNT and PACK intrinsics on variables
+INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT ! Used to replace the COUNT and PACK intrinsics
+!
+INTEGER :: IC, JMICRO
+LOGICAL :: LLSIGMA_RC, LL_AUCV_ADJU
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_PACK', 0, ZHOOK_HANDLE)
+!
+!* 1. GENERALITIES
+! ------------
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIJB=D%NIJB
+IIJE=D%NIJE
+GEXT_TEND=.TRUE.
+LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
+LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
+!
+IF(PARAMI%LPACK_MICRO) THEN
+ IF(KPROMA /= KSIZE) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see comments in code for explanation')
+ ! Microphyscs was optimized by introducing chunks of KPROMA size
+ ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
+ ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
+ ! A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
+ ! Another solution would be to compute column by column?
+ ! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
+ ENDIF
+ !
+ IF(BUCONF%LBU_ENABLE) THEN
+ DO JV=1, IBUNUM-IBUNUM_EXTRA
+ ZBU_PACK(:, JV)=0.
+ ENDDO
+ ENDIF
+ !
+ !* 2. POINT SELECTION
+ ! ---------------
+ !
+ ! optimization by looking for locations where
+ ! the microphysical fields are larger than a minimal value only !!!
+ !
+ IF (KSIZE /= COUNT(ODMICRO(IIJB:IIJE,IKTB:IKTE))) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_PACK', 'ICE4_PACK : KSIZE /= COUNT(ODMICRO)')
+ ENDIF
+
+ IF (KSIZE > 0) THEN
+ !
+ !* 3. CACHE-BLOCKING LOOP
+ ! -------------------
+ !
+
+ ! starting indexes :
+ IC=0
+ ISTK=IKTB
+ ISTIJ=IIJB
+
+ DO JMICRO=1,KSIZE,KPROMA
+
+ IMICRO=MIN(KPROMA,KSIZE-JMICRO+1)
+ !
+ !* 4. PACKING
+ ! -------
+ !
+
+ ! Setup packing parameters
+ OUTER_LOOP: DO JK = ISTK, IKTE
+ IF (ANY(ODMICRO(:,JK))) THEN
+ DO JIJ = ISTIJ, IIJE
+ IF (ODMICRO(JIJ,JK)) THEN
+ IC=IC+1
+ LLMICRO(IC)=.TRUE.
+ ! Initialization of variables in packed format :
+ ZVART(IC, ITH)=PWR(JIJ, JK, ITH)
+ ZVART(IC, IRV)=PWR(JIJ, JK, IRV)
+ ZVART(IC, IRC)=PWR(JIJ, JK, IRC)
+ ZVART(IC, IRR)=PWR(JIJ, JK, IRR)
+ ZVART(IC, IRI)=PWR(JIJ, JK, IRI)
+ ZVART(IC, IRS)=PWR(JIJ, JK, IRS)
+ ZVART(IC, IRG)=PWR(JIJ, JK, IRG)
+ IF (KRR==7) THEN
+ ZVART(IC, IRH)=PWR(JIJ, JK, IRH)
+ ENDIF
+ IF (GEXT_TEND) THEN
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ZEXTPK(IC, ITH)=PTHS(JIJ, JK)
+ ZEXTPK(IC, IRV)=PRVS(JIJ, JK)
+ ZEXTPK(IC, IRC)=PRCS(JIJ, JK)
+ ZEXTPK(IC, IRR)=PRRS(JIJ, JK)
+ ZEXTPK(IC, IRI)=PRIS(JIJ, JK)
+ ZEXTPK(IC, IRS)=PRSS(JIJ, JK)
+ ZEXTPK(IC, IRG)=PRGS(JIJ, JK)
+ IF (KRR==7) THEN
+ ZEXTPK(IC, IRH)=PRHS(JIJ, JK)
+ ENDIF
+ ENDIF
+ ZCIT (IC)=PCIT (JIJ, JK)
+ ZCF (IC)=PCLDFR (JIJ, JK)
+ ZRHODREF (IC)=PRHODREF(JIJ, JK)
+ ZPRES (IC)=PPABST (JIJ, JK)
+ ZEXN (IC)=PEXN (JIJ, JK)
+ IF(LLSIGMA_RC) THEN
+ ZSIGMA_RC(IC)=PSIGS (JIJ, JK)
+ ENDIF
+ IF (LL_AUCV_ADJU) THEN
+ ZHLC_HCF(IC) = PHLC_HCF(JIJ, JK)
+ ZHLC_HRC(IC) = PHLC_HRC(JIJ, JK)
+ ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
+ ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
+ ENDIF
+ ! Save indices for later usages:
+ I1(IC) = JIJ
+ I2(IC) = JK
+ I1TOT(JMICRO+IC-1)=JIJ
+ I2TOT(JMICRO+IC-1)=JK
+ IF (IC==IMICRO) THEN
+ ! the end of the chunk has been reached, then reset the starting index :
+ ISTIJ=JIJ+1
+ IF (ISTIJ <= IIJE) THEN
+ ISTK=JK
+ ELSE
+ ! end of line, restart from 1 and increment upper loop
+ ISTK=JK+1
+ IF (ISTK > IKTE) THEN
+ ! end of line, restart from 1
+ ISTK=IKTB
+ ENDIF
+ ENDIF
+ IC=0
+ EXIT OUTER_LOOP
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ! restart inner loop on JIJ :
+ ISTIJ=IIJB
+ ENDDO OUTER_LOOP
+
+ !
+ !* 5. TENDENCIES COMPUTATION
+ ! ----------------------
+ !
+ CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ &LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
+ &KPROMA, IMICRO, LLMICRO, PTSTEP, &
+ &KRR, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &ZEXN, ZRHODREF, I1, I2, &
+ &ZPRES, ZCF, ZSIGMA_RC, &
+ &ZCIT, &
+ &ZVART, &
+ &ZHLC_HCF, ZHLC_HRC, &
+ &ZHLI_HCF, ZHLI_HRI, PRAINFR, &
+ &ZEXTPK, ZBU_SUM, ZRREVAV)
+ !
+ !* 6. UNPACKING
+ ! ---------
+ !
+ DO JL=1, IMICRO
+ PCIT (I1(JL),I2(JL))=ZCIT (JL)
+ IF(PARAMI%LWARM) THEN
+ PEVAP3D(I1(JL),I2(JL))=ZRREVAV(JL)
+ ENDIF
+ PWR(I1(JL),I2(JL),IRV)=ZVART(JL, IRV)
+ PWR(I1(JL),I2(JL),IRC)=ZVART(JL, IRC)
+ PWR(I1(JL),I2(JL),IRR)=ZVART(JL, IRR)
+ PWR(I1(JL),I2(JL),IRI)=ZVART(JL, IRI)
+ PWR(I1(JL),I2(JL),IRS)=ZVART(JL, IRS)
+ PWR(I1(JL),I2(JL),IRG)=ZVART(JL, IRG)
+ IF (KRR==7) THEN
+ PWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
+ ENDIF
+ ENDDO
+ IF(BUCONF%LBU_ENABLE) THEN
+ DO JV=1, IBUNUM-IBUNUM_EXTRA
+ DO JL=1, IMICRO
+ ZBU_PACK(JMICRO+JL-1, JV) = ZBU_SUM(JL, JV)
+ ENDDO
+ ENDDO
+ ENDIF
+
+
+ ENDDO ! JMICRO
+ ENDIF ! KSIZE > 0
+
+ELSE ! PARAMI%LPACK_MICRO
+ IF (KSIZE /= D%NIJT*D%NKT) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_PACK', 'ICE4_PACK : KSIZE /= NIJT*NKT')
+ ENDIF
+
+ IC=0
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ IC=IC+1
+ I1TOT(IC)=JIJ
+ I2TOT(IC)=JK
+ IF (GEXT_TEND) THEN
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ZEXTPK(IC, ITH)=PTHS(JIJ, JK)
+ ZEXTPK(IC, IRV)=PRVS(JIJ, JK)
+ ZEXTPK(IC, IRC)=PRCS(JIJ, JK)
+ ZEXTPK(IC, IRR)=PRRS(JIJ, JK)
+ ZEXTPK(IC, IRI)=PRIS(JIJ, JK)
+ ZEXTPK(IC, IRS)=PRSS(JIJ, JK)
+ ZEXTPK(IC, IRG)=PRGS(JIJ, JK)
+ IF (KRR==7) THEN
+ ZEXTPK(IC, IRH)=PRHS(JIJ, JK)
+ ENDIF
+ IF(LLSIGMA_RC) THEN
+ ZSIGMA_RC(IC)=PSIGS(JIJ, JK)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ !* 5bis. TENDENCIES COMPUTATION
+ ! ----------------------
+ !
+ CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ &LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
+ &KSIZE, KSIZE, ODMICRO, PTSTEP, &
+ &KRR, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &PEXN, PRHODREF, I1TOT, I2TOT, &
+ &PPABST, PCLDFR, ZSIGMA_RC, &
+ &PCIT, &
+ &PWR, &
+ &PHLC_HCF, PHLC_HRC, &
+ &PHLI_HCF, PHLI_HRI, PRAINFR, &
+ &ZEXTPK, ZBU_PACK, PEVAP3D)
+
+ENDIF ! PARAMI%LPACK_MICRO
+!
+!* 7. BUDGETS
+! -------
+!
+IF(BUCONF%LBU_ENABLE) THEN
+ !Budgets for the different processes
+ CALL ICE4_BUDGETS(D, PARAMI, BUCONF, KSIZE, PTSTEP, KRR, I1TOT, I2TOT, &
+ PLVFACT, PLSFACT, PRHODJ, PEXNREF, &
+ PRVHENI, ZBU_PACK, &
+ TBUDGETS, KBUDGETS)
+ENDIF
+IF (LHOOK) CALL DR_HOOK('ICE4_PACK', 1, ZHOOK_HANDLE)
+END SUBROUTINE ICE4_PACK
+END MODULE MODE_ICE4_PACK
diff --git a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90 b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
index 865ed74004ea51dcc1a28356f2046e03a0413705..970f214f322bc79eec5ad895d366595959e0974e 100644
--- a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
+++ b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_RSRIMCG_OLD
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RSRIMCG_OLD(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
&PRHODREF, &
&PLBDAS, &
&PT, PRCT, PRST, &
@@ -31,6 +31,7 @@ SUBROUTINE ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
! ------------
!
USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
USE PARKIND1, ONLY : JPRB
@@ -41,6 +42,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KPROMA, KSIZE
@@ -57,8 +59,8 @@ REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to c
!
LOGICAL, DIMENSION(KPROMA) :: GRIM
INTEGER :: IGRIM
-REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2
-INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2
+INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2
REAL, DIMENSION(KPROMA) :: ZZW
INTEGER :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -73,49 +75,15 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RSRIMCG_OLD', 0, ZHOOK_HANDLE)
PRSRIMCG_MR(:)=0.
!
IF(.NOT. LDSOFT) THEN
- IGRIM = 0
DO JL = 1, KSIZE
- IF(PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL) .AND. PT(JL)<CST%XTT) THEN
- IGRIM = IGRIM + 1
- IVEC1(IGRIM) = JL
- GRIM(JL) = .TRUE.
- ELSE
- GRIM(JL) = .FALSE.
- ENDIF
+ GRIM(JL)=PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL) .AND. PT(JL)<CST%XTT
ENDDO
+ CALL INTERP_MICRO_1D(KPROMA, KSIZE, PLBDAS(:), ICEP%NGAMINC, ICEP%XRIMINTP1, ICEP%XRIMINTP2, &
+ &PARAMI%LPACK_INTERP, GRIM(:), IBUF1, IBUF2, ZBUF1, ZBUF2, &
+ &IGRIM, &
+ &ICEP%XGAMINC_RIM2, ZZW)
!
IF(IGRIM>0) THEN
- !
- ! 5.1.1 select the PLBDAS
- !
- DO JL = 1, IGRIM
- ZVEC1(JL) = PLBDAS(IVEC1(JL))
- ENDDO
- !
- ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
- ! set of Lbda_s used to tabulate some moments of the incomplete
- ! gamma function
- !
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN(REAL(ICEP%NGAMINC)-0.00001, &
- ICEP%XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + ICEP%XRIMINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
-
- !
- ! 5.1.5 perform the linear interpolation of the normalized
- ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2)
- !
- ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = 0.
- DO JL = 1, IGRIM
- ZZW(IVEC1(JL)) = ZVEC1(JL)
- ENDDO
-
- !
- ! 5.1.6 riming-conversion of the large sized aggregates into graupeln
- !
- !
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GRIM(1:KSIZE))
PRSRIMCG_MR(1:KSIZE) = ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG & ! RSRIMCG
@@ -132,5 +100,9 @@ ENDIF
!
IF (LHOOK) CALL DR_HOOK('ICE4_RSRIMCG_OLD', 1, ZHOOK_HANDLE)
!
+CONTAINS
+!
+INCLUDE "interp_micro.func.h"
+!
END SUBROUTINE ICE4_RSRIMCG_OLD
END MODULE MODE_ICE4_RSRIMCG_OLD
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation.f90 b/src/PHYEX/micro/mode_ice4_sedimentation.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f6fc795edff66ad05a393e199992dfb0fb4955d5
--- /dev/null
+++ b/src/PHYEX/micro/mode_ice4_sedimentation.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 1994-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.
+!-----------------------------------------------------------------
+MODULE MODE_ICE4_SEDIMENTATION
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
+ &PTSTEP, KRR, PDZZ, &
+ &PLVFACT, PLSFACT, PRHODREF, PPABST, PTHT, PT, PRHODJ, &
+ &PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRS, PINPRG, &
+ &TBUDGETS, KBUDGETS, &
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
+!!
+!!** PURPOSE
+!! -------
+!! Computes the sedimentation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette code extracted from rain_ice
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+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
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+!
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!
+USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
+USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
+USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT
+REAL, DIMENSION(D%NIJT) :: ZINPRI
+INTEGER :: JK, JIJ, IKTB, IKTE, IIJB, IIJE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION', 0, ZHOOK_HANDLE)
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!
+!
+IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+
+IF(PARAMI%CSEDIM=='STAT') THEN
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
+ ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
+ ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
+ ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
+ ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
+ IF (KRR==7) ZRHT(JIJ,JK)=PRHS(JIJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
+ !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
+ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
+ !We correct negativities with conservation
+ !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
+ ! It is initialized with the m.r. at T and is modified by two tendencies:
+ ! sedimentation tendency and an external tendency which represents all other
+ ! processes (mainly advection and microphysical processes). If both tendencies
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
+ ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
+ ! will be still active and will lead to negative values.
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
+ ! a correction here.
+ CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, PLVFACT, PLSFACT, PRHS)
+ELSEIF(PARAMI%CSEDIM=='NONE') THEN
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
+END IF
+!
+!
+IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION', 1, ZHOOK_HANDLE)
+!
+END SUBROUTINE ICE4_SEDIMENTATION
+END MODULE MODE_ICE4_SEDIMENTATION
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
index e7b90b3d4ae6dd7f2c3b4ba22908543ab8e152e1..6534e7043ae2036c7e2d5eef53b5d0d94829f9fa 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
@@ -56,46 +56,46 @@ TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
!
-INTEGER :: JI, JJ, JK
-INTEGER :: IKTB, IKTE, IKB, IKL, IIE, IIB, IJB, IJE
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
REAL :: ZINVTSTEP
-REAL, DIMENSION(D%NIT, D%NJT) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(D%NIT,D%NJT,D%NKTB:D%NKTE) :: ZW ! work array
-REAL, DIMENSION(D%NIT, D%NJT, D%NKT) :: ZCONC3D, & ! droplet condensation
+REAL, DIMENSION(D%NIJT) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE) :: ZW ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D, & ! droplet condensation
& ZRAY, & ! Cloud Mean radius
& ZLBC, & ! XLBC weighted by sea fraction
& ZFSEDC, &
@@ -118,10 +118,8 @@ IRR = KRR
!
IKTB=D%NKTB
IKTE=D%NKTE
-IIB=D%NIB
-IIE=D%NIE
-IJB=D%NJB
-IJE=D%NJE
+IIJB=D%NIJB
+IIJE=D%NIJE
!
IF (PRESENT(PFPR)) THEN
GPRESENT_PFPR = .TRUE.
@@ -139,41 +137,41 @@ END IF
!
ZINVTSTEP=1./PTSTEP
IF (GPRESENT_PFPR) THEN
- PFPR(:,:,:,:) = 0.
+ PFPR(:,:,:) = 0.
END IF
!
!* 1. Parameters for cloud sedimentation
!
IF (GSEDIC) THEN
- ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = ICED%XLBC(1)
- ZFSEDC(:,:,:) = ICEP%XFSEDC(1)
- ZCONC3D(:,:,:)= ICED%XCONC_LAND
- ZCONC_TMP(:,:)= ICED%XCONC_LAND
+ ZRAY(:,:) = 0.
+ ZLBC(:,:) = ICED%XLBC(1)
+ ZFSEDC(:,:) = ICEP%XFSEDC(1)
+ ZCONC3D(:,:)= ICED%XCONC_LAND
+ ZCONC_TMP(:)= ICED%XCONC_LAND
IF (GPRESENT_PSEA) THEN
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZCONC_TMP(JI,JJ)=PSEA(JI,JJ)*ICED%XCONC_SEA+(1.-PSEA(JI,JJ))*ICED%XCONC_LAND
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ZCONC_TMP(JIJ)=PSEA(JIJ)*ICED%XCONC_SEA+(1.-PSEA(JIJ))*ICED%XCONC_LAND
ENDDO
DO JK=IKTB, IKTE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZLBC(JI,JJ,JK) = PSEA(JI,JJ)*ICED%XLBC(2)+(1.-PSEA(JI,JJ))*ICED%XLBC(1)
- ZFSEDC(JI,JJ,JK) = (PSEA(JI,JJ)*ICEP%XFSEDC(2)+(1.-PSEA(JI,JJ))*ICEP%XFSEDC(1))
- ZFSEDC(JI,JJ,JK) = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)),ZFSEDC(JI,JJ,JK))
- ZCONC3D(JI,JJ,JK)= (1.-PTOWN(JI,JJ))*ZCONC_TMP(JI,JJ)+PTOWN(JI,JJ)*ICED%XCONC_URBAN
- ZRAY(JI,JJ,JK) = 0.5*((1.-PSEA(JI,JJ))*GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)) + &
- & PSEA(JI,JJ)*GAMMA(ICED%XNUC2+1.0/ICED%XALPHAC2)/(GAMMA(ICED%XNUC2)))
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ZLBC(JIJ,JK) = PSEA(JIJ)*ICED%XLBC(2)+(1.-PSEA(JIJ))*ICED%XLBC(1)
+ ZFSEDC(JIJ,JK) = (PSEA(JIJ)*ICEP%XFSEDC(2)+(1.-PSEA(JIJ))*ICEP%XFSEDC(1))
+ ZFSEDC(JIJ,JK) = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)),ZFSEDC(JIJ,JK))
+ ZCONC3D(JIJ,JK)= (1.-PTOWN(JIJ))*ZCONC_TMP(JIJ)+PTOWN(JIJ)*ICED%XCONC_URBAN
+ ZRAY(JIJ,JK) = 0.5*((1.-PSEA(JIJ))*GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)) + &
+ & PSEA(JIJ)*GAMMA(ICED%XNUC2+1.0/ICED%XALPHAC2)/(GAMMA(ICED%XNUC2)))
ENDDO
END DO
ELSE
- ZCONC3D(:,:,:) = ICED%XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)))
+ ZCONC3D(:,:) = ICED%XCONC_LAND
+ ZRAY(:,:) = 0.5*(GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)))
END IF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),ZLBC(:,:,:))
+ DO JK=IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ZRAY(JIJ,JK) = MAX(1.,ZRAY(JIJ,JK))
+ ZLBC(JIJ,JK) = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),ZLBC(JIJ,JK))
+ ENDDO
+ ENDDO
ENDIF
!
!* 2. compute the fluxes
@@ -183,32 +181,30 @@ ENDIF
! For optimization we consider each variable separately
!
DO JK=IKTB, IKTE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ! External tendecies
- IF (GSEDIC) THEN
- ZPRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)-PRCT(JI,JJ,JK)*ZINVTSTEP
- ENDIF
- ZPRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)-PRRT(JI,JJ,JK)*ZINVTSTEP
- ZPRIS(JI,JJ,JK) = PRIS(JI,JJ,JK)-PRIT(JI,JJ,JK)*ZINVTSTEP
- ZPRSS(JI,JJ,JK) = PRSS(JI,JJ,JK)-PRST(JI,JJ,JK)*ZINVTSTEP
- ZPRGS(JI,JJ,JK) = PRGS(JI,JJ,JK)-PRGT(JI,JJ,JK)*ZINVTSTEP
- IF ( IRR == 7 ) THEN
- ZPRHS(JI,JJ,JK) = PRHS(JI,JJ,JK)-PRHT(JI,JJ,JK)*ZINVTSTEP
- END IF
- !
- ! mr values inside the time-splitting loop
- ZRCT(JI,JJ,JK) = PRCT(JI,JJ,JK)
- ZRRT(JI,JJ,JK) = PRRT(JI,JJ,JK)
- ZRIT(JI,JJ,JK) = PRIT(JI,JJ,JK)
- ZRST(JI,JJ,JK) = PRST(JI,JJ,JK)
- ZRGT(JI,JJ,JK) = PRGT(JI,JJ,JK)
- IF (IRR==7) THEN
- ZRHT(JI,JJ,JK) = PRHT(JI,JJ,JK)
- END IF
- !
- ZW(JI,JJ,JK) =1./(PRHODREF(JI,JJ,JK)* PDZZ(JI,JJ,JK))
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ! External tendecies
+ IF (GSEDIC) THEN
+ ZPRCS(JIJ,JK) = PRCS(JIJ,JK)-PRCT(JIJ,JK)*ZINVTSTEP
+ ENDIF
+ ZPRRS(JIJ,JK) = PRRS(JIJ,JK)-PRRT(JIJ,JK)*ZINVTSTEP
+ ZPRIS(JIJ,JK) = PRIS(JIJ,JK)-PRIT(JIJ,JK)*ZINVTSTEP
+ ZPRSS(JIJ,JK) = PRSS(JIJ,JK)-PRST(JIJ,JK)*ZINVTSTEP
+ ZPRGS(JIJ,JK) = PRGS(JIJ,JK)-PRGT(JIJ,JK)*ZINVTSTEP
+ IF ( IRR == 7 ) THEN
+ ZPRHS(JIJ,JK) = PRHS(JIJ,JK)-PRHT(JIJ,JK)*ZINVTSTEP
+ END IF
+ !
+ ! mr values inside the time-splitting loop
+ ZRCT(JIJ,JK) = PRCT(JIJ,JK)
+ ZRRT(JIJ,JK) = PRRT(JIJ,JK)
+ ZRIT(JIJ,JK) = PRIT(JIJ,JK)
+ ZRST(JIJ,JK) = PRST(JIJ,JK)
+ ZRGT(JIJ,JK) = PRGT(JIJ,JK)
+ IF (IRR==7) THEN
+ ZRHT(JIJ,JK) = PRHT(JIJ,JK)
+ END IF
+ !
+ ZW(JIJ,JK) =1./(PRHODREF(JIJ,JK)* PDZZ(JIJ,JK))
ENDDO
ENDDO
!
@@ -242,27 +238,27 @@ ENDIF
!* 2.4 for aggregates/snow
!
CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
- &5, &
- &ZRST, PRSS, PINPRS, ZPRSS, &
- &PFPR=PFPR)
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
+ &5, &
+ &ZRST, PRSS, PINPRS, ZPRSS, &
+ &PFPR=PFPR)
!
!* 2.5 for graupeln
!
CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
- &6, &
- &ZRGT, PRGS, PINPRG, ZPRGS, &
- &PFPR=PFPR)
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
+ &6, &
+ &ZRGT, PRGS, PINPRG, ZPRGS, &
+ &PFPR=PFPR)
!
!* 2.6 for hail
!
IF (IRR==7) THEN
CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
- &7, &
- &ZRHT, PRHS, PINPRH, ZPRHS, &
- &PFPR=PFPR)
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
+ &7, &
+ &ZRHT, PRHS, PINPRH, ZPRHS, &
+ &PFPR=PFPR)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 1, ZHOOK_HANDLE)
@@ -274,8 +270,9 @@ CONTAINS
!
!
SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
- &PRHODREF, POORHODZ, PDZZ, PPABST,PTHT,PT,PTSTEP, &
- &KSPE, PRXT, PRXS, PINPRX, PPRXS, &
+ &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PT, PTSTEP, &
+ &KSPE, &
+ &PRXT, PRXS, PINPRX, PPRXS, &
&PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
!
!* 0. DECLARATIONS
@@ -296,38 +293,36 @@ TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(D%NIT,D%NJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT
REAL, INTENT(IN) :: PTSTEP ! total timestep
INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRX ! instant precip
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRX ! instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
CHARACTER(LEN=10) :: YSPE ! String for error message
-INTEGER :: IDX, ISEDIM
-INTEGER :: JI, JJ, JK, JL
-INTEGER, DIMENSION(D%NIT*D%NJT*D%NKT) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JIJ, JK, JL
LOGICAL :: GPRESENT_PFPR
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
REAL :: ZLBDA
REAL :: ZFSED, ZEXSED
REAL :: ZMRCHANGE
-REAL, DIMENSION(D%NIT, D%NJT) :: ZMAX_TSTEP ! Maximum CFL in column
+REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
-REAL, DIMENSION(D%NIT, D%NJT) :: ZREMAINT ! Remaining time until the timestep end
-REAL, DIMENSION(D%NIT, D%NJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
-INTEGER :: IKTB, IKTE, IKB, IKL, IIE, IIB, IJB, IJE
+REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
+REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
+INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
!
@@ -335,10 +330,8 @@ IKTB=D%NKTB
IKTE=D%NKTE
IKB=D%NKB
IKL=D%NKL
-IIB=D%NIB
-IIE=D%NIE
-IJB=D%NJB
-IJE=D%NJE
+IIJB=D%NIJB
+IIJE=D%NIJE
!-------------------------------------------------------------------------------
IF (KSPE<2 .OR. KSPE>7) CALL PRINT_MSG(NVERB_FATAL,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
!
@@ -348,29 +341,13 @@ ELSE
GPRESENT_PFPR = .FALSE.
END IF
!
-PINPRX(:,:) = 0.
+PINPRX(:) = 0.
ZINVTSTEP=1./PTSTEP
ZRSMIN(:) = ICED%XRTMIN(:) * ZINVTSTEP
-ZREMAINT(:,:) = 0.
-ZREMAINT(IIB:IIE,IJB:IJE) = PTSTEP
+ZREMAINT(:) = 0.
+ZREMAINT(IIJB:IIJE) = PTSTEP
!
DO WHILE (ANY(ZREMAINT>0.))
- ISEDIM = 0
- DO JK = IKTB,IKTE
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- IF( (PRXT (JI,JJ,JK)>ICED%XRTMIN(KSPE) .OR. &
- PPRXS(JI,JJ,JK)>ZRSMIN(KSPE)) .AND. &
- ZREMAINT(JI,JJ)>0. ) THEN
- ISEDIM = ISEDIM + 1
- IDX = ISEDIM
- I1(IDX) = JI
- I2(IDX) = JJ
- I3(IDX) = JK
- END IF
- END DO
- END DO
- END DO
!
!
!* 1. Parameters for cloud sedimentation
@@ -381,62 +358,59 @@ DO WHILE (ANY(ZREMAINT>0.))
!
IF(KSPE==2) THEN
!******* for cloud
- ZWSED(:,:,:) = 0.
- DO JL=1, ISEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE)) THEN
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- &(PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**ICED%XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/CST%XP00)**(CST%XRD/CST%XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZRAY)
- ZWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT +1 ) * &
- &ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
- ENDIF
+ ZWSED(:,:) = 0.
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ ZZWLBDC = PLBC(JIJ,JK) * PCONC3D(JIJ,JK) / &
+ &(PRHODREF(JIJ,JK) * PRXT(JIJ,JK))
+ ZZWLBDC = ZZWLBDC**ICED%XLBEXC
+ ZRAY = PRAY(JIJ,JK) / ZZWLBDC
+ ZZT = PTHT(JIJ,JK) * (PPABST(JIJ,JK)/CST%XP00)**(CST%XRD/CST%XCPD)
+ ZZWLBDA = 6.6E-8*(101325./PPABST(JIJ,JK))*(ZZT/293.15)
+ ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ ZWSED(JIJ, JK) = PRHODREF(JIJ,JK)**(-ICED%XCEXVT +1 ) * &
+ &ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JIJ,JK) * PRXT(JIJ,JK)
+ ENDIF
+ ENDDO
ENDDO
ELSEIF(KSPE==4) THEN
! ******* for pristine ice
- ZWSED(:,:,:) = 0.
- DO JL=1, ISEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(ICED%XRTMIN(4), 1.0E-7)) THEN
- ZWSED(JI, JJ, JK) = ICEP%XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-ICED%XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**ICEP%XEXCSEDI
- ENDIF
+ ZWSED(:,:) = 0.
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ, JK) .GT. MAX(ICED%XRTMIN(4), 1.0E-7) .AND. ZREMAINT(JIJ)>0.) THEN
+ ZWSED(JIJ, JK) = ICEP%XFSEDI * PRXT(JIJ, JK) * &
+ & PRHODREF(JIJ,JK)**(1.-ICED%XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)) )**ICEP%XEXCSEDI
+ ENDIF
+ ENDDO
ENDDO
#if defined(REPRO48) || defined(REPRO55)
#else
- ELSEIF(KSPE==5) THEN
- ! ******* for snow
- ZWSED(:,:,:) = 0.
- DO JL=1, ISEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)> ICED%XRTMIN(KSPE)) THEN
- IF (PARAMI%LSNOW_T .AND. PT(JI,JJ,JK)>263.15) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSEIF(KSPE==5) THEN
+ ! ******* for snow
+ ZWSED(:,:) = 0.
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ,JK)> ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ IF (PARAMI%LSNOW_T .AND. PT(JIJ,JK)>263.15) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE IF (PARAMI%LSNOW_T) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JI,JJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE
- ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
+ ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JIJ,JK) * PRXT(JIJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
END IF
- ZWSED(JI, JJ, JK) = ICEP%XFSEDS * &
- & PRXT(JI,JJ,JK)* &
- & PRHODREF(JI,JJ,JK)**(1-ICED%XCEXVT) * &
+ ZWSED(JIJ, JK) = ICEP%XFSEDS * &
+ & PRXT(JIJ,JK)* &
+ & PRHODREF(JIJ,JK)**(1-ICED%XCEXVT) * &
& (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
& ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
ENDIF
ENDDO
+ ENDDO
#endif
ELSE
! ******* for other species
@@ -461,45 +435,39 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//TRIM(YSPE) )
END SELECT
!
- ZWSED(:,:,:) = 0.
- DO JL=1, ISEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE)) THEN
- ZWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED &
- & * PRHODREF(JI, JJ, JK)**(ZEXSED-ICED%XCEXVT)
- ENDIF
+ ZWSED(:,:) = 0.
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ ZWSED(JIJ, JK) = ZFSED * PRXT(JIJ, JK)**ZEXSED &
+ & * PRHODREF(JIJ, JK)**(ZEXSED-ICED%XCEXVT)
+ ENDIF
+ ENDDO
ENDDO
ENDIF
- ZMAX_TSTEP(:,:) = ZREMAINT(:,:)
- DO JL=1, ISEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE) .AND. ZWSED(JI, JJ, JK)>1.E-20) THEN
- ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PARAMI%XSPLIT_MAXCFL * PRHODREF(JI, JJ, JK) * &
- & PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
- ENDIF
+ ZMAX_TSTEP(:) = ZREMAINT(:)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZWSED(JIJ, JK)>1.E-20 .AND. ZREMAINT(JIJ)>0.) THEN
+ ZMAX_TSTEP(JIJ) = MIN(ZMAX_TSTEP(JIJ), PARAMI%XSPLIT_MAXCFL * PRHODREF(JIJ, JK) * &
+ & PRXT(JIJ, JK) * PDZZ(JIJ, JK) / ZWSED(JIJ, JK))
+ ENDIF
+ ENDDO
ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZREMAINT(JI,JJ) = ZREMAINT(JI,JJ) - ZMAX_TSTEP(JI,JJ)
- PINPRX(JI,JJ) = PINPRX(JI,JJ) + ZWSED(JI,JJ,IKB) / CST%XRHOLW * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP)
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ZREMAINT(JIJ) = ZREMAINT(JIJ) - ZMAX_TSTEP(JIJ)
+ PINPRX(JIJ) = PINPRX(JIJ) + ZWSED(JIJ,IKB) / CST%XRHOLW * (ZMAX_TSTEP(JIJ) * ZINVTSTEP)
ENDDO
DO JK = IKTB , IKTE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZMRCHANGE = ZMAX_TSTEP(JI,JJ) * POORHODZ(JI,JJ,JK)*(ZWSED(JI,JJ,JK+IKL)-ZWSED(JI,JJ,JK))
- PRXT(JI,JJ,JK) = PRXT(JI,JJ,JK) + ZMRCHANGE + PPRXS(JI,JJ,JK) * ZMAX_TSTEP(JI,JJ)
- PRXS(JI,JJ,JK) = PRXS(JI,JJ,JK) + ZMRCHANGE * ZINVTSTEP
- IF (GPRESENT_PFPR) THEN
- PFPR(JI,JJ,JK,KSPE) = PFPR(JI,JJ,JK,KSPE) + ZWSED(JI,JJ,JK) * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP)
- ENDIF
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ZMRCHANGE = ZMAX_TSTEP(JIJ) * POORHODZ(JIJ,JK)*(ZWSED(JIJ,JK+IKL)-ZWSED(JIJ,JK))
+ PRXT(JIJ,JK) = PRXT(JIJ,JK) + ZMRCHANGE + PPRXS(JIJ,JK) * ZMAX_TSTEP(JIJ)
+ PRXS(JIJ,JK) = PRXS(JIJ,JK) + ZMRCHANGE * ZINVTSTEP
+ IF (GPRESENT_PFPR) THEN
+ PFPR(JIJ,JK,KSPE) = PFPR(JIJ,JK,KSPE) + ZWSED(JIJ,JK) * (ZMAX_TSTEP(JIJ) * ZINVTSTEP)
+ ENDIF
ENDDO
ENDDO
!
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90
deleted file mode 100644
index 498375058494a79d840b508deb57b099087ccab4..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90
+++ /dev/null
@@ -1,549 +0,0 @@
-!MNH_LIC Copyright 1994-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.
-!-----------------------------------------------------------------
-MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-IMPLICIT NONE
-CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, OMOMENTUM, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the sedimentation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!! and modified to use momentum
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-
-USE MODE_MSG
-use mode_tools, only: Countjv
-
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GSEDIM ! Test where to compute the SED processes
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZW, & ! work array
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZMOMC, ZMOMR, ZMOMI, ZMOMS, ZMOMG, ZMOMH ! momentum
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZMOMC_EXT, ZMOMR_EXT, ZMOMI_EXT, &
- ZMOMS_EXT, ZMOMG_EXT, ZMOMH_EXT ! momentum tendencies
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZREMAINT ! Remaining time until the timestep end
-REAL :: ZINVTSTEP
-INTEGER :: ISEDIM ! ! Case number of sedimentation
-INTEGER :: JK
-LOGICAL :: FIRST
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-!
-! O. Initialization of for sedimentation
-!
-ZINVTSTEP=1./PTSTEP
-ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
-IF (OSEDIC) PINPRC (:,:) = 0.
-PINPRR (:,:) = 0.
-PINPRI (:,:) = 0.
-PINPRS (:,:) = 0.
-PINPRG (:,:) = 0.
-IF ( KRR == 7 ) PINPRH (:,:) = 0.
-IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
-!
-!* 1. Parameters for cloud sedimentation
-!
-IF (OSEDIC) THEN
- ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZCONC_TMP(:,:)= XCONC_LAND
- IF (PRESENT(PSEA)) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- & PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
-ENDIF
-!
-!* 2. compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-! For optimization we consider each variable separately
-!
-! External tendecies
-IF (OSEDIC) THEN
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
-ENDIF
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
-ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
-IF ( KRR == 7 ) THEN
- ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
-END IF
-!
-! mr values inside the time-splitting loop
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-IF (KRR==7) THEN
- ZRHT(:,:,:) = PRHT(:,:,:)
-END IF
-!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
-END DO
-!
-!
-!* 2.1 for cloud
-!
-IF (OSEDIC) THEN
- ZREMAINT(:,:) = PTSTEP
- FIRST = .TRUE.
- DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRCT(KIB:KIE,KJB:KJE,JK)>XRTMIN(2) .OR. &
- ZPRCS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(2)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &2, &
- &ZRCT, PRCS, ZWSED, PINPRC, ZPRCS, ZMOMC, ZMOMC_EXT, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
- FIRST = .FALSE.
- ENDDO
-ENDIF
-!
-!* 2.2 for rain
-!
-ZREMAINT(:,:) = PTSTEP
-FIRST = .TRUE.
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRRT(KIB:KIE,KJB:KJE,JK)>XRTMIN(3) .OR. &
- ZPRRS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(3)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &3, &
- &ZRRT, PRRS, ZWSED, PINPRR, ZPRRS, ZMOMR, ZMOMR_EXT, &
- &PFPR=PFPR)
- FIRST = .FALSE.
-ENDDO
-!
-!* 2.3 for pristine ice
-!
-ZREMAINT(:,:) = PTSTEP
-FIRST = .TRUE.
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRIT(KIB:KIE,KJB:KJE,JK)>XRTMIN(4) .OR. &
- ZPRIS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(4)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &4, &
- &ZRIT, PRIS, ZWSED, PINPRI, ZPRIS, ZMOMI, ZMOMI_EXT, PFPR=PFPR)
- FIRST = .FALSE.
-ENDDO
-!
-!* 2.4 for aggregates/snow
-!
-ZREMAINT(:,:) = PTSTEP
-FIRST = .TRUE.
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRST(KIB:KIE,KJB:KJE,JK)>XRTMIN(5) .OR. &
- ZPRSS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(5)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &5, &
- &ZRST, PRSS, ZWSED, PINPRS, ZPRSS, ZMOMS, ZMOMS_EXT, PFPR=PFPR)
- FIRST = .FALSE.
-ENDDO
-!
-!* 2.5 for graupeln
-!
-ZREMAINT(:,:) = PTSTEP
-FIRST = .TRUE.
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRGT(KIB:KIE,KJB:KJE,JK)>XRTMIN(6) .OR. &
- ZPRGS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(6)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &6, &
- &ZRGT, PRGS, ZWSED, PINPRG, ZPRGS, ZMOMG, ZMOMG_EXT, PFPR=PFPR)
- FIRST = .FALSE.
-ENDDO
-!
-!* 2.6 for hail
-!
-IF (KRR==7) THEN
- ZREMAINT(:,:) = PTSTEP
- FIRST = .TRUE.
- DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRHT(KIB:KIE,KJB:KJE,JK)>XRTMIN(7) .OR. &
- ZPRHS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(7)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, FIRST .AND. OMOMENTUM, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &7, &
- &ZRHT, PRHS, ZWSED, PINPRH, ZPRHS, ZMOMH, ZMOMH_EXT, PFPR=PFPR)
- FIRST = .FALSE.
- END DO
-ENDIF
-!
-!
-CONTAINS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &OMOMENTUM, OCOMPUTE_MOM, &
- &KSEDIM, LDSEDIM, I1, I2, I3, PMAXCFL, PREMAINT, &
- &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PTSTEP, &
- &KSPE, &
- &PRXT, PRXS, PWSED, PINPRX, PPRXS, PMOM, PMOM_EXT, &
- &PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
- LOGICAL, INTENT(IN) :: OMOMENTUM, OCOMPUTE_MOM
- INTEGER, INTENT(IN) :: KSEDIM
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM
- INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3
- REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
- REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PREMAINT ! Time remaining until the end of the timestep
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP ! total timestep
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PINPRX ! instant precip
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PMOM ! momentum associated to PRXT
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PMOM_EXT ! momentum tendency associated to PPRXS
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
- REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(INOUT) :: PFPR ! upper-air precipitation fluxes
- !
- !* 0.2 declaration of local variables
- !
- !
- character(len=10) :: yspe ! String for error message
- INTEGER :: JK, JL, JI, JJ
- REAL :: ZINVTSTEP
- REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
- REAL :: ZFSED, ZEXSED
- REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
- REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
- REAL, DIMENSION(KIT,KJT,0:KKT+1) :: ZWSED_MOM ! Momentum flux
- REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- !
- IF(OCOMPUTE_MOM .AND. .NOT. OMOMENTUM) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
- 'OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum' )
- ENDIF
- !* 2. compute the fluxes
- !
- !
- ZINVTSTEP = 1./PTSTEP
- ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
- IF(KSPE==2) THEN
- !******* for cloud
- IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
- PWSED(:,:,:) = 0.
- PMOM_EXT(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
- ENDIF
- IF(PPRXS(JI,JJ,JK)>ZRSMIN(KSPE) .AND. OCOMPUTE_MOM) THEN
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PPRXS(JI,JJ,JK) * PTSTEP)
- ZZWLBDC = ZZWLBDC**XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- PMOM_EXT(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 -1) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PPRXS(JI,JJ,JK)
- ENDIF
- ENDDO
- IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT)
- ENDIF
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
- PWSED(:,:,:) = 0.
- PMOM_EXT(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
- PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
- ENDIF
- IF(PPRXS(JI,JJ,JK)>MAX(ZRSMIN(4), 1.0E-7/PTSTEP) .AND. OCOMPUTE_MOM) THEN
- PMOM_EXT(JI, JJ, JK) = XFSEDI * PPRXS(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT-1) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PPRXS(JI,JJ,JK)*PTSTEP) )**XEXCSEDI
- ENDIF
- ENDDO
- IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT)
- ENDIF
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==5) THEN
- ZFSED=XFSEDS
- ZEXSED=XEXSEDS
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
- ELSE
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
- 'no sedimentation parameter for KSPE='//trim(yspe) )
- ENDIF
- IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
- !Momentum (per m3) and mass flux are given by the same formulae
- PWSED(:,:,:) = 0.
- PMOM_EXT(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * &
- PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
- ENDIF
- IF(PPRXS(JI,JJ,JK)>ZRSMIN(KSPE) .AND. OCOMPUTE_MOM) THEN
- PMOM_EXT(JI, JJ, JK) = ZFSED * (PPRXS(JI, JJ, JK)*PTSTEP)**ZEXSED * &
- PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT-1) * ZINVTSTEP
- ENDIF
- ENDDO
- IF(OCOMPUTE_MOM) PMOM(:, :, :)=PWSED(:, :, 1:KKT) / PRHODREF(:, :, :) ! momentum per kg of dry air
- ENDIF
- ENDIF
- IF(OMOMENTUM) THEN
- PWSED(:,:,:) = 0.
- ZWSED_MOM(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- ZWSED_MOM(JI, JJ, JK) = PMOM(JI, JJ, JK)**2 / PRXT(JI, JJ, JK) * PRHODREF(JI, JJ, JK) ! (kg*m/s)/(s*m**2)
- ENDIF
- ENDDO
- PWSED(:, :, 1:KKT) = PMOM(:, :, :)*PRHODREF(:, :, :) !PMOM divided by r to get speed and multiply by rho*r to get flux
- ENDIF
- ZMAX_TSTEP(:,:) = PREMAINT(:,:)
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
- PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / PWSED(JI, JJ, JK))
- ENDIF
- ENDDO
- ZMRCHANGE(:,:) = 0.
- PREMAINT(:,:) = PREMAINT(:,:) - ZMAX_TSTEP(:,:)
- DO JK = KKTB , KKTE
- ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))
- PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:)
- PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP
- ENDDO
- IF(OMOMENTUM) THEN
- DO JK = KKTB , KKTE
- PMOM(:,:,JK) = PMOM(:,:,JK) + ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK) * (ZWSED_MOM(:,:,JK+KKL)-ZWSED_MOM(:,:,JK))
- PMOM(:,:,JK) = PMOM(:,:,JK) + ZMAX_TSTEP(:,:) * PMOM_EXT(:,:,JK)
- PMOM(:,:,JK) = MAX(0., PMOM(:,:,JK))
- ENDDO
- ENDIF
- PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
- ENDDO
- ENDIF
- !
- END SUBROUTINE INTERNAL_SEDIM_SPLI
- !
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-!
-END MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
index 33e4e6e01e7ff5992ce919206038b62e0647a2e3..52183c8547782f2507b58d01a61d7428a6564822 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
@@ -6,10 +6,9 @@
MODULE MODE_ICE4_SEDIMENTATION_STAT
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
- &PTSTEP, KRR, OSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PLBDAS, &
+SUBROUTINE ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, &
&PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
@@ -45,6 +44,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
USE MODI_GAMMA, ONLY: GAMMA
!
IMPLICIT NONE
@@ -55,46 +55,46 @@ TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensio
TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
LOGICAL :: LLSEA_AND_TOWN
-INTEGER :: JRR, JI, JJ, JK, IKB, IKE,IKL, IIE, IIB, IJB, IJE, IKTB, IKTE
+INTEGER :: JRR, JIJ, JK, IKB, IKE,IKL, IIJB, IIJE, IKTB, IKTE
INTEGER :: ISHIFT, IK, IKPLUS
-REAL :: ZQP, ZP1, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO
-REAL, DIMENSION(D%NIT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
-REAL, DIMENSION(D%NIT,D%NJT) :: ZTSORHODZ ! TimeStep Over (Rhodref times delta Z)
-REAL, DIMENSION(D%NIT,D%NJT,0:1,2:KRR) :: ZSED ! sedimentation flux array for each species and for above and current levels
+REAL :: ZQP, ZP1, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO, ZLBDAS
+REAL, DIMENSION(D%NIJT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
+REAL, DIMENSION(D%NIJT) :: ZTSORHODZ ! TimeStep Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIJT,0:1,2:KRR) :: ZSED ! sedimentation flux array for each species and for above and current levels
REAL :: FWSED1, FWSED2, PWSEDW, PWSEDWSUP, PINVTSTEP, PTSTEP1, PDZZ1, PRHODREF1, PRXT1
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -115,17 +115,15 @@ IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE)
IKB=D%NKB
IKE=D%NKE
IKL=D%NKL
-IIB=D%NIB
-IIE=D%NIE
-IJB=D%NJB
-IJE=D%NJE
+IIJB=D%NIJB
+IIJE=D%NIJE
IKTB=D%NKTB
IKTE=D%NKTE
!
IF ( PRESENT( PFPR ) ) THEN
!Set to 0. to avoid undefined values (in files)
- PFPR(:, :, : IKTB, :) = 0.
- PFPR(:, :, IKTE :, :) = 0.
+ PFPR(:, : IKTB, :) = 0.
+ PFPR(:, IKTE :, :) = 0.
END IF
!-------------------------------------------------------------------------------
@@ -149,16 +147,14 @@ CALL SHIFT
! Initialize vertical loop
DO JRR=2,KRR
- ZSED(:,:,IKPLUS,JRR) = 0.
+ ZSED(:,IKPLUS,JRR) = 0.
ENDDO
! calculation sedimentation flux
DO JK = IKE , IKB, -1*IKL
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZTSORHODZ(JI,JJ) =PTSTEP/(PRHODREF(JI,JJ,JK)*PDZZ(JI,JJ,JK))
- ENDDO
+ DO JIJ = IIJB, IIJE
+ ZTSORHODZ(JIJ) =PTSTEP/(PRHODREF(JIJ,JK)*PDZZ(JIJ,JK))
ENDDO
!
DO JRR=2,KRR
@@ -166,40 +162,40 @@ DO JK = IKE , IKB, -1*IKL
IF (JRR==2) THEN
!******* for cloud
- IF (OSEDIC) THEN
- CALL CLOUD(PRCT(:,:,JK))
+ IF (PARAMI%LSEDIC) THEN
+ CALL CLOUD(PRCT(:,JK))
ELSE
- ZSED(:,:,IK,JRR)=0.
+ ZSED(:,IK,JRR)=0.
ENDIF
ELSEIF (JRR==3) THEN
!* 2.2 for rain
- CALL OTHER_SPECIES(ICEP%XFSEDR,ICEP%XEXSEDR,PRRT(:,:,JK))
+ CALL OTHER_SPECIES(ICEP%XFSEDR,ICEP%XEXSEDR,PRRT(:,JK))
ELSEIF (JRR==4) THEN
- CALL PRISTINE_ICE(PRIT(:,:,JK))
+ CALL PRISTINE_ICE(PRIT(:,JK))
ELSEIF (JRR==5) THEN
!* 2.4 for aggregates/snow
#ifdef REPRO48
- CALL OTHER_SPECIES(ICEP%XFSEDS,ICEP%XEXSEDS,PRST(:,:,JK))
+ CALL OTHER_SPECIES(ICEP%XFSEDS,ICEP%XEXSEDS,PRST(:,JK))
#else
- CALL SNOW(PRST(:,:,JK))
+ CALL SNOW(PRST(:,JK))
#endif
ELSEIF (JRR==6) THEN
!* 2.5 for graupeln
- CALL OTHER_SPECIES(ICEP%XFSEDG,ICEP%XEXSEDG,PRGT(:,:,JK))
+ CALL OTHER_SPECIES(ICEP%XFSEDG,ICEP%XEXSEDG,PRGT(:,JK))
ELSEIF (JRR==7) THEN
!* 2.6 for hail
IF (PRESENT(PRHT)) THEN
- CALL OTHER_SPECIES(ICEP%XFSEDH,ICEP%XEXSEDH,PRHT(:,:,JK))
+ CALL OTHER_SPECIES(ICEP%XFSEDH,ICEP%XEXSEDH,PRHT(:,JK))
ENDIF
ENDIF
@@ -210,35 +206,31 @@ DO JK = IKE , IKB, -1*IKL
IF(PRESENT(PFPR)) THEN
DO JRR=2,KRR
- PFPR(:,:,JK,JRR)=ZSED(:,:,IK,JRR)
+ PFPR(:,JK,JRR)=ZSED(:,IK,JRR)
ENDDO
ENDIF
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,2)-ZSED(JI,JJ,IK,2))*ZINVTSTEP
- PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,3)-ZSED(JI,JJ,IK,3))*ZINVTSTEP
- PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,4)-ZSED(JI,JJ,IK,4))*ZINVTSTEP
- PRSS(JI,JJ,JK) = PRSS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,5)-ZSED(JI,JJ,IK,5))*ZINVTSTEP
- PRGS(JI,JJ,JK) = PRGS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,6)-ZSED(JI,JJ,IK,6))*ZINVTSTEP
- IF (PRESENT(PRHS)) THEN
- PRHS(JI,JJ,JK) = PRHS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,7)-ZSED(JI,JJ,IK,7))*ZINVTSTEP
- ENDIF
- ENDDO
+ DO JIJ = IIJB, IIJE
+ PRCS(JIJ,JK) = PRCS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,2)-ZSED(JIJ,IK,2))*ZINVTSTEP
+ PRRS(JIJ,JK) = PRRS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,3)-ZSED(JIJ,IK,3))*ZINVTSTEP
+ PRIS(JIJ,JK) = PRIS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,4)-ZSED(JIJ,IK,4))*ZINVTSTEP
+ PRSS(JIJ,JK) = PRSS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,5)-ZSED(JIJ,IK,5))*ZINVTSTEP
+ PRGS(JIJ,JK) = PRGS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,6)-ZSED(JIJ,IK,6))*ZINVTSTEP
+ IF (PRESENT(PRHS) .AND. KRR==7) THEN
+ PRHS(JIJ,JK) = PRHS(JIJ,JK)+ZTSORHODZ(JIJ)*(ZSED(JIJ,IKPLUS,7)-ZSED(JIJ,IK,7))*ZINVTSTEP
+ ENDIF
ENDDO
IF (JK==IKB) THEN
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF(OSEDIC) PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/CST%XRHOLW
- PINPRR(JI,JJ) = ZSED(JI,JJ,IK,3)/CST%XRHOLW
- PINPRI(JI,JJ) = ZSED(JI,JJ,IK,4)/CST%XRHOLW
- PINPRS(JI,JJ) = ZSED(JI,JJ,IK,5)/CST%XRHOLW
- PINPRG(JI,JJ) = ZSED(JI,JJ,IK,6)/CST%XRHOLW
- IF (PRESENT(PINPRH)) THEN
- PINPRH(JI,JJ) = ZSED(JI,JJ,IK,7)/CST%XRHOLW
- ENDIF
- ENDDO
+ DO JIJ = IIJB, IIJE
+ IF(PARAMI%LSEDIC) PINPRC(JIJ) = ZSED(JIJ,IK,2)/CST%XRHOLW
+ PINPRR(JIJ) = ZSED(JIJ,IK,3)/CST%XRHOLW
+ PINPRI(JIJ) = ZSED(JIJ,IK,4)/CST%XRHOLW
+ PINPRS(JIJ) = ZSED(JIJ,IK,5)/CST%XRHOLW
+ PINPRG(JIJ) = ZSED(JIJ,IK,6)/CST%XRHOLW
+ IF (PRESENT(PINPRH) .AND. KRR==7) THEN
+ PINPRH(JIJ) = ZSED(JIJ,IK,7)/CST%XRHOLW
+ ENDIF
ENDDO
ENDIF
@@ -253,7 +245,7 @@ CONTAINS
SUBROUTINE CLOUD(PRXT)
- REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+ REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
REAL :: ZLBC ! XLBC weighted by sea fraction
REAL :: ZFSEDC
@@ -265,53 +257,51 @@ CONTAINS
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',0,ZHOOK_HANDLE)
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- !estimation of q' taking into account incoming ZWSED from previous vertical level
- ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
- IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
- IF (LLSEA_AND_TOWN) THEN
- ZRAY = MAX(1.,0.5*((1.-PSEA(JI,JJ))*ZGAC/ZGC+PSEA(JI,JJ)*ZGAC2/ZGC2))
- ZLBC = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),(PSEA(JI,JJ)*ICED%XLBC(2)+(1.-PSEA(JI,JJ))*ICED%XLBC(1)) )
- ZFSEDC = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)), (PSEA(JI,JJ)*ICEP%XFSEDC(2)+(1.-PSEA(JI,JJ))*ICEP%XFSEDC(1)) )
- ZCONC3D= (1.-PTOWN(JI,JJ))*(PSEA(JI,JJ)*ICED%XCONC_SEA+(1.-PSEA(JI,JJ))*ICED%XCONC_LAND) + &
- PTOWN(JI,JJ) *ICED%XCONC_URBAN
- ELSE
- ZRAY = ZRAYDEFO
- ZLBC = ICED%XLBC(1)
- ZFSEDC = ICEP%XFSEDC(1)
- ZCONC3D= ICED%XCONC_LAND
- ENDIF
- !calculation of w
- IF(PRXT(JI,JJ) > ICED%XRTMIN(JRR)) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ)))**ICED%XLBEXC
- ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
- ZWSEDW1(JI)=PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
- ELSE
- ZWSEDW1(JI)=0.
- ENDIF
- IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JI,JJ,JK)*ZQP))**ICED%XLBEXC
- ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
- ZWSEDW2(JI)=PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
- ELSE
- ZWSEDW2(JI)=0.
- ENDIF
+ DO JIJ = IIJB, IIJE
+ !estimation of q' taking into account incoming ZWSED from previous vertical level
+ ZQP=ZSED(JIJ,IKPLUS,JRR)*ZTSORHODZ(JIJ)
+ IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ IF (LLSEA_AND_TOWN) THEN
+ ZRAY = MAX(1.,0.5*((1.-PSEA(JIJ))*ZGAC/ZGC+PSEA(JIJ)*ZGAC2/ZGC2))
+ ZLBC = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),(PSEA(JIJ)*ICED%XLBC(2)+(1.-PSEA(JIJ))*ICED%XLBC(1)) )
+ ZFSEDC = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)), (PSEA(JIJ)*ICEP%XFSEDC(2)+(1.-PSEA(JIJ))*ICEP%XFSEDC(1)) )
+ ZCONC3D= (1.-PTOWN(JIJ))*(PSEA(JIJ)*ICED%XCONC_SEA+(1.-PSEA(JIJ))*ICED%XCONC_LAND) + &
+ PTOWN(JIJ) *ICED%XCONC_URBAN
ELSE
- ZWSEDW1(JI)=0.
- ZWSEDW2(JI)=0.
+ ZRAY = ZRAYDEFO
+ ZLBC = ICED%XLBC(1)
+ ZFSEDC = ICEP%XFSEDC(1)
+ ZCONC3D= ICED%XCONC_LAND
ENDIF
-!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JI) /= 0.) THEN
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ !calculation of w
+ IF(PRXT(JIJ) > ICED%XRTMIN(JRR)) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JIJ,JK))*(PTHT(JIJ,JK)/293.15)
+ ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JIJ,JK)*PRXT(JIJ)))**ICED%XLBEXC
+ ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
+ ZWSEDW1(JIJ)=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
+ ELSE
+ ZWSEDW1(JIJ)=0.
+ ENDIF
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JIJ,JK))*(PTHT(JIJ,JK)/293.15)
+ ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JIJ,JK)*ZQP))**ICED%XLBEXC
+ ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
+ ZWSEDW2(JIJ)=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
ELSE
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ZWSEDW2(JIJ)=0.
ENDIF
+ ELSE
+ ZWSEDW1(JIJ)=0.
+ ZWSEDW2(JIJ)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JIJ) /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ENDIF
!-------------------------------------------------------------------------------------------
- ENDDO
ENDDO
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',1,ZHOOK_HANDLE)
@@ -320,47 +310,45 @@ CONTAINS
SUBROUTINE PRISTINE_ICE(PRXT)
- REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+ REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',0,ZHOOK_HANDLE)
! ******* for pristine ice
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
- IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
- !calculation of w
- IF ( PRXT(JI,JJ) > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
- ZWSEDW1(JI)= ICEP%XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ)) )**ICEP%XEXCSEDI
- ELSE
- ZWSEDW1(JI)=0.
- ENDIF
- IF ( ZQP > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
- ZWSEDW2(JI)= ICEP%XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*ZQP) )**ICEP%XEXCSEDI
- ELSE
- ZWSEDW2(JI)=0.
- ENDIF
+ DO JIJ = IIJB, IIJE
+ ZQP=ZSED(JIJ,IKPLUS,JRR)*ZTSORHODZ(JIJ)
+ IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ !calculation of w
+ IF ( PRXT(JIJ) > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
+ ZWSEDW1(JIJ)= ICEP%XFSEDI * &
+ & PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ)) )**ICEP%XEXCSEDI
ELSE
- ZWSEDW1(JI)=0.
- ZWSEDW2(JI)=0.
+ ZWSEDW1(JIJ)=0.
ENDIF
-!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JI) /= 0.) THEN
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ IF ( ZQP > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
+ ZWSEDW2(JIJ)= ICEP%XFSEDI * &
+ & PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JIJ,JK)*ZQP) )**ICEP%XEXCSEDI
ELSE
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ZWSEDW2(JIJ)=0.
ENDIF
+ ELSE
+ ZWSEDW1(JIJ)=0.
+ ZWSEDW2(JIJ)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JIJ) /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ENDIF
!-------------------------------------------------------------------------------------------
- ENDDO
ENDDO
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',1,ZHOOK_HANDLE)
@@ -369,47 +357,55 @@ CONTAINS
SUBROUTINE SNOW(PRXT)
- REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+ REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',0,ZHOOK_HANDLE)
! ******* for snow
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
- IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
- !calculation of w
- IF ( PRXT(JI,JJ) > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW1(JI)= ICEP%XFSEDS * &
- & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * &
- & (1+(ICED%XFVELOS/PLBDAS(JI,JJ,JK))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
- & PLBDAS(JI,JJ,JK)**(ICED%XBS+ICEP%XEXSEDS)
- ELSE
- ZWSEDW1(JI)=0.
- ENDIF
- IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW2(JI)= ICEP%XFSEDS * &
- & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * &
- & (1+(ICED%XFVELOS/PLBDAS(JI,JJ,JK))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
- & PLBDAS(JI,JJ,JK)**(ICED%XBS+ICEP%XEXSEDS)
+ DO JIJ = IIJB, IIJE
+ ZQP=ZSED(JIJ,IKPLUS,JRR)*ZTSORHODZ(JIJ)
+ IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ !Compute lambda_snow parameter
+ IF (PARAMI%LSNOW_T) THEN
+ IF(PT(JIJ,JK)>CST%XTT-10.0) THEN
+ ZLBDAS = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE
- ZWSEDW2(JI)=0.
- ENDIF
+ ZLBDAS = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226-0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ END IF
ELSE
- ZWSEDW1(JI)=0.
- ZWSEDW2(JI)=0.
+ ZLBDAS = MAX(MIN(ICED%XLBDAS_MAX,ICED%XLBS*(PRHODREF(JIJ,JK)*PRXT(JIJ))**ICED%XLBEXS),ICED%XLBDAS_MIN)
+ END IF
+ !calculation of w
+ IF ( PRXT(JIJ) > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW1(JIJ)= ICEP%XFSEDS * &
+ & PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
+ & (1+(ICED%XFVELOS/ZLBDAS)**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
+ & ZLBDAS**(ICED%XBS+ICEP%XEXSEDS)
+ ELSE
+ ZWSEDW1(JIJ)=0.
ENDIF
-!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JI) /= 0.) THEN
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW2(JIJ)= ICEP%XFSEDS * &
+ & PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
+ & (1+(ICED%XFVELOS/ZLBDAS)**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
+ & ZLBDAS**(ICED%XBS+ICEP%XEXSEDS)
ELSE
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ZWSEDW2(JIJ)=0.
ENDIF
+ ELSE
+ ZWSEDW1(JIJ)=0.
+ ZWSEDW2(JIJ)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JIJ) /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ENDIF
!-------------------------------------------------------------------------------------------
- ENDDO
ENDDO
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',1,ZHOOK_HANDLE)
@@ -420,41 +416,39 @@ CONTAINS
REAL, INTENT(IN) :: PFSED
REAL, INTENT(IN) :: PEXSED
- REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+ REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',0,ZHOOK_HANDLE)
! for all but cloud and pristine ice :
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
- IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
- !calculation of w
- IF ( PRXT(JI,JJ) > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW1(JI)= PFSED *PRXT(JI,JJ)**(PEXSED-1)*PRHODREF(JI,JJ,JK)**(PEXSED-ICED%XCEXVT-1)
- ELSE
- ZWSEDW1(JI)=0.
- ENDIF
- IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW2(JI)= PFSED *ZQP**(PEXSED-1)*PRHODREF(JI,JJ,JK)**(PEXSED-ICED%XCEXVT-1)
- ELSE
- ZWSEDW2(JI)=0.
- ENDIF
+ DO JIJ = IIJB, IIJE
+ ZQP=ZSED(JIJ,IKPLUS,JRR)*ZTSORHODZ(JIJ)
+ IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ !calculation of w
+ IF ( PRXT(JIJ) > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW1(JIJ)= PFSED *PRXT(JIJ)**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
ELSE
- ZWSEDW1(JI)=0.
- ZWSEDW2(JI)=0.
+ ZWSEDW1(JIJ)=0.
ENDIF
-!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JI) /= 0.) THEN
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW2(JIJ)= PFSED *ZQP**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
ELSE
- ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ZWSEDW2(JIJ)=0.
ENDIF
+ ELSE
+ ZWSEDW1(JIJ)=0.
+ ZWSEDW2(JIJ)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JIJ) /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ENDIF
!-------------------------------------------------------------------------------------------
- ENDDO
ENDDO
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',1,ZHOOK_HANDLE)
diff --git a/src/PHYEX/micro/mode_ice4_stepping.f90 b/src/PHYEX/micro/mode_ice4_stepping.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8a438a79968778ffb2de9d0ea91bae7f98d31a24
--- /dev/null
+++ b/src/PHYEX/micro/mode_ice4_stepping.f90
@@ -0,0 +1,432 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_ICE4_STEPPING
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ &LDSIGMA_RC, LDAUCV_ADJU, LDEXT_TEND, &
+ &KPROMA, KMICRO, LDMICRO, PTSTEP, &
+ &KRR, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &PEXN, PRHODREF, K1, K2, &
+ &PPRES, PCF, PSIGMA_RC, &
+ &PCIT, &
+ &PVART, &
+ &PHLC_HCF, PHLC_HRC, &
+ &PHLI_HCF, PHLI_HRI, PRAINFR, &
+ &PEXTPK, PBU_SUM, PRREVAV)
+
+! -----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+ & ITH, & ! Potential temperature
+ & IRV, & ! Water vapor
+ & IRC, & ! Cloud water
+ & IRR, & ! Rain water
+ & IRI, & ! Pristine ice
+ & IBUNUM, & ! Number of tendency terms
+ & IBUNUM_MR, & ! Number of tendency terms expressed as mixing ratio changes
+ & IBUNUM_EXTRA, & ! Number of extra tendency terms
+ & IRREVAV, & ! Index for the evaporation tendency
+ & IBUEXTRAIND ! Index indirection
+
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+
+USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+LOGICAL, INTENT(IN) :: LDSIGMA_RC
+LOGICAL, INTENT(IN) :: LDAUCV_ADJU
+LOGICAL, INTENT(IN) :: LDEXT_TEND
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
+INTEGER, INTENT(IN) :: KMICRO ! Case r_x>0 locations
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMICRO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
+!
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF! Reference density
+INTEGER, DIMENSION(KPROMA), INTENT(IN) :: K1,K2 ! Used to replace the COUNT and PACK intrinsics on variables
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PSIGMA_RC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PCIT
+REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PVART !Packed variables
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
+REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRREVAV
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
+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
+REAL :: ZTIME_THRESHOLD ! Time to reach threshold
+!
+INTEGER :: JL, JV, JJV
+REAL, DIMENSION(KPROMA) :: &
+ & ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_LASTCALL, & ! Integration time when last tendecies call has been done
+ & ZSSI, &
+ & ZZT, & ! Temperature
+ & ZLSFACT, & ! L_s/(Pi*C_ph)
+ & ZLVFACT, & ! L_v/(Pi*C_ph)
+ & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that PCF = PHLC_HCF + ZHLC_LCF
+ & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = PHLC_HRC + ZHLC_LRC
+ & ZHLI_LCF, &
+ & ZHLI_LRI
+LOGICAL, DIMENSION(KPROMA) :: LLCOMPUTE ! .TRUE. or points where we must compute tendencies,
+!
+!Output packed tendencies (for budgets only)
+REAL, DIMENSION(KPROMA, IBUNUM) :: ZBU_INST
+!
+!For mixing-ratio-splitting
+LOGICAL :: LLCPZ0RT
+REAL :: ZTIME_THRESHOLD1D(KPROMA) ! Time to reach threshold
+REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
+!
+REAL, DIMENSION(KPROMA,0:7) :: ZA, ZB
+!
+REAL, DIMENSION(KPROMA, 8) :: ZRS_TEND, ZRG_TEND
+REAL, DIMENSION(KPROMA,10) :: ZRH_TEND
+
+INTEGER, DIMENSION(KPROMA) :: IITER ! Number of iterations done (with real tendencies computation)
+!
+REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB
+REAL :: ZDEVIDE, ZX
+!
+LOGICAL :: LL_ANY_ITER
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_STEPPING', 0, ZHOOK_HANDLE)
+!
+!* 1. GENERALITIES
+! ------------
+!
+ZINV_TSTEP=1./PTSTEP
+!
+IF(BUCONF%LBU_ENABLE) THEN
+ DO JV=1, IBUNUM-IBUNUM_EXTRA
+ PBU_SUM(:, JV)=0.
+ ENDDO
+ENDIF
+
+!Maximum number of iterations
+!We only count real iterations (those for which we *compute* tendencies)
+INB_ITER_MAX=PARAMI%NMAXITER
+IF(PARAMI%XTSTEP_TS/=0.)THEN
+ INB_ITER_MAX=MAX(1, INT(PTSTEP/PARAMI%XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
+ ZTSTEP=PTSTEP/INB_ITER_MAX
+ INB_ITER_MAX=MAX(PARAMI%NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
+ENDIF
+
+IF (LDEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, KMICRO
+ PEXTPK(JL, JV)=PEXTPK(JL, JV)-PVART(JL, JV)*ZINV_TSTEP
+ ENDDO
+ ENDDO
+ENDIF
+IF (LDSIGMA_RC) THEN
+ DO JL=1, KMICRO
+ PSIGMA_RC(JL)=PSIGMA_RC(JL)*2.
+ ENDDO
+ENDIF
+IF (LDAUCV_ADJU) THEN
+ DO JL=1, KMICRO
+ ZHLC_LRC(JL) = PVART(JL, IRC) - PHLC_HRC(JL)
+ ZHLI_LRI(JL) = PVART(JL, IRI) - PHLI_HRI(JL)
+ IF(PVART(JL, IRC)>0.) THEN
+ ZHLC_LCF(JL) = PCF(JL)- PHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(PVART(JL, IRI)>0.) THEN
+ ZHLI_LCF(JL) = PCF(JL)- PHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
+ ENDDO
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+!*** 4.4 temporal loop
+!
+!
+IITER(1:KMICRO)=0
+DO JL=1, KMICRO
+ IF(LDMICRO(JL)) THEN
+ ZTIME(JL)=0. ! Current integration time (all points may have a different integration time)
+ ELSE
+ ZTIME(JL)=PTSTEP ! Nothing to do on this point, it has already reached the end of the timestep
+ ENDIF
+ENDDO
+
+DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
+
+ IF(PARAMI%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 tendencies
+ ZTIME_LASTCALL(1:KMICRO)=ZTIME(1:KMICRO)
+ ENDIF
+ DO JL=1, KMICRO
+ IF (ZTIME(JL) < PTSTEP) THEN
+ LLCOMPUTE(JL)=.TRUE. ! Computation (.TRUE.) only for points for which integration time has not reached the timestep
+ IITER(JL)=IITER(JL)+1
+ ELSE
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ LL_ANY_ITER=ANY(IITER(1:KMICRO) < INB_ITER_MAX)
+ LLCPZ0RT=.TRUE.
+ LSOFT=.FALSE. ! We *really* compute the tendencies
+
+ DO WHILE(ANY(LLCOMPUTE(1:KMICRO))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
+!$OMP SIMD
+ DO JL=1, KMICRO
+ ZSUM2(JL)=SUM(PVART(JL,IRI:KRR))
+ ENDDO
+ DO JL=1, KMICRO
+ ZDEVIDE=(CST%XCPD + CST%XCPV*PVART(JL, IRV) + CST%XCL*(PVART(JL, IRC)+PVART(JL, IRR)) + CST%XCI*ZSUM2(JL)) * PEXN(JL)
+ ZZT(JL) = PVART(JL, ITH) * PEXN(JL)
+ ZLSFACT(JL)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
+ ZLVFACT(JL)=(CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
+ ENDDO
+ !-------------------------------------------------------------------------------
+ !
+ !*** 4.5 Effective tendencies computation
+ !
+ !
+ ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
+ CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ &KPROMA, KMICRO, &
+ &KRR, LSOFT, LLCOMPUTE, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &PEXN, PRHODREF, ZLVFACT, ZLSFACT, K1, K2, &
+ &PPRES, PCF, PSIGMA_RC, &
+ &PCIT, &
+ &ZZT, PVART, &
+ &ZBU_INST, &
+ &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
+ &ZA, ZB, &
+ &PHLC_HCF, ZHLC_LCF, PHLC_HRC, ZHLC_LRC, &
+ &PHLI_HCF, ZHLI_LCF, PHLI_HRI, ZHLI_LRI, PRAINFR)
+
+ ! External tendencies
+ IF(LDEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, KMICRO
+ ZA(JL, JV) = ZA(JL, JV) + PEXTPK(JL, JV)
+ ENDDO
+ ENDDO
+ ENDIF
+ !-------------------------------------------------------------------------------
+ !
+ !*** 4.6 Time integration
+ !
+ !
+ ! If we can, we shall use these tendencies until the end of the timestep
+ DO JL=1, KMICRO
+ IF(LLCOMPUTE(JL)) THEN
+ ZMAXTIME(JL)=(PTSTEP-ZTIME(JL)) ! Remaining time until the end of the timestep
+ ELSE
+ ZMAXTIME(JL)=0.
+ ENDIF
+ ENDDO
+
+ !We need to adjust tendencies when temperature reaches 0
+ IF(PARAMI%LFEEDBACKT) THEN
+ DO JL=1, KMICRO
+ !Is ZB(:, ITH) enough to change temperature sign?
+ ZX=CST%XTT/PEXN(JL)
+ IF ((PVART(JL, ITH) - ZX) * (PVART(JL, ITH) + ZB(JL, ITH) - ZX) < 0.) THEN
+ ZMAXTIME(JL)=0.
+ ENDIF
+ !Can ZA(:, ITH) make temperature change of sign?
+ IF (ABS(ZA(JL,ITH)) > 1.E-20 ) THEN
+ ZTIME_THRESHOLD=(ZX - ZB(JL, ITH) - PVART(JL, ITH))/ZA(JL, ITH)
+ IF (ZTIME_THRESHOLD > 0.) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
+ ENDIF
+ ENDIF
+ ENDDO
+ 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)
+ DO JV=1, KRR
+ DO JL=1, KMICRO
+ IF (ZA(JL, JV) < -1.E-20 .AND. PVART(JL, JV) > ICED%XRTMIN(JV)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+PVART(JL, JV))/ZA(JL, JV))
+ ENDIF
+ ENDDO
+ ENDDO
+
+ !We stop when the end of the timestep is reached
+ DO JL=1, KMICRO
+ IF (ZTIME(JL)+ZMAXTIME(JL) >= PTSTEP) THEN
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ !We must recompute tendencies when the end of the sub-timestep is reached
+ IF (PARAMI%XTSTEP_TS/=0.) THEN
+ DO JL=1, KMICRO
+ IF ((IITER(JL) < INB_ITER_MAX) .AND. (ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
+ ZMAXTIME(JL)=ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ 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 (PARAMI%XMRSTEP/=0.) THEN
+ IF (LL_ANY_ITER) THEN
+ ! In this case we need to remember the initial mixing ratios used to compute the tendencies
+ ! because when mixing ratio has evolved more than a threshold, we must re-compute tendencies
+ ! Thus, at first iteration (ie when LLCPZ0RT=.TRUE.) we copy PVART into Z0RT
+ DO JV=1,KRR
+ IF (LLCPZ0RT) Z0RT(1:KMICRO, JV)=PVART(1:KMICRO, JV)
+ DO JL=1, KMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
+ ZTIME_THRESHOLD1D(JL)=(SIGN(1., ZA(JL, JV))*PARAMI%XMRSTEP+ &
+ &Z0RT(JL, JV)-PVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
+ ELSE
+ ZTIME_THRESHOLD1D(JL)=-1.
+ ENDIF
+ ENDDO
+ DO JL=1, KMICRO
+ IF (ZTIME_THRESHOLD1D(JL)>=0 .AND. ZTIME_THRESHOLD1D(JL)<ZMAXTIME(JL) .AND. &
+ &(PVART(JL, JV)>ICED%XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD1D(JL))
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ ENDDO
+ LLCPZ0RT=.FALSE.
+!$OMP SIMD
+ DO JL=1,KMICRO
+ ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
+ ENDDO
+ DO JL=1, KMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>PARAMI%XMRSTEP) THEN
+ ZMAXTIME(JL)=0.
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ ENDIF ! LL_ANY_ITER
+ ENDIF ! XMRSTEP/=0.
+ !-------------------------------------------------------------------------------
+ !
+ !*** 4.7 New values of variables for next iteration
+ !
+ !
+ DO JV=0, KRR
+ DO JL=1, KMICRO
+ IF(LDMICRO(JL)) THEN
+ PVART(JL, JV)=PVART(JL, JV)+ZA(JL, JV)*ZMAXTIME(JL)+ZB(JL, JV)
+ ENDIF
+ ENDDO
+ ENDDO
+ DO JL=1, KMICRO
+#ifdef REPRO55
+ PCIT(JL)=PCIT(JL) * MAX(0., -SIGN(1., -PVART(JL,IRI)))
+#else
+ IF (PVART(JL,IRI)<=0. .AND. LDMICRO(JL)) PCIT(JL) = 0.
+#endif
+ ZTIME(JL)=ZTIME(JL)+ZMAXTIME(JL)
+ ENDDO
+ !-------------------------------------------------------------------------------
+ !
+ !*** 4.8 Mixing ratio change due to each process
+ !
+ IF(BUCONF%LBU_ENABLE) THEN
+ !Mixing ratio change due to a tendency
+ DO JV=1, IBUNUM-IBUNUM_MR-IBUNUM_EXTRA
+ DO JL=1, KMICRO
+ PBU_SUM(JL, JV) = PBU_SUM(JL, JV) + ZBU_INST(JL, JV)*ZMAXTIME(JL)
+ ENDDO
+ ENDDO
+
+ !Mixing ratio change due to a mixing ratio change
+ DO JV=IBUNUM-IBUNUM_MR-IBUNUM_EXTRA+1, IBUNUM-IBUNUM_EXTRA
+ DO JL=1, KMICRO
+ PBU_SUM(JL, JV) = PBU_SUM(JL, JV) + ZBU_INST(JL, JV)
+ ENDDO
+ ENDDO
+
+ !Extra contribution as a mixing ratio change
+ DO JV=IBUNUM-IBUNUM_EXTRA+1, IBUNUM
+ JJV=IBUEXTRAIND(JV)
+ DO JL=1, KMICRO
+ PBU_SUM(JL, JJV) = PBU_SUM(JL, JJV) + ZBU_INST(JL, JV)
+ ENDDO
+ ENDDO
+ ENDIF
+ !-------------------------------------------------------------------------------
+ !
+ !*** 4.9 Next loop
+ !
+ LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
+ ENDDO !Iterations on tendency computations (WHILE ANY(LLCOMPUTE))
+ENDDO !Temporal loop
+
+IF(LDEXT_TEND) THEN
+ !Z..T variables contain the external tendency, we substract it
+ DO JV=0, KRR
+ DO JL=1, KMICRO
+ IF(LDMICRO(JL)) THEN
+ PVART(JL, JV) = PVART(JL, JV) - PEXTPK(JL, JV) * PTSTEP
+ ENDIF
+ ENDDO
+ ENDDO
+ENDIF
+DO JL=1, KMICRO
+ PRREVAV(JL)=ZBU_INST(JL, IRREVAV)
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_STEPPING', 1, ZHOOK_HANDLE)
+END SUBROUTINE ICE4_STEPPING
+END MODULE MODE_ICE4_STEPPING
diff --git a/src/PHYEX/micro/mode_ice4_tendencies.f90 b/src/PHYEX/micro/mode_ice4_tendencies.f90
index d6eebfdf81ace36fcae6b31c221eedf33cadf132..b85db3a9861ddc67733f699a0042228b251f77a3 100644
--- a/src/PHYEX/micro/mode_ice4_tendencies.f90
+++ b/src/PHYEX/micro/mode_ice4_tendencies.f90
@@ -13,15 +13,7 @@ SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PVART, &
- &PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PRCAUTR, PRCACCR, PRREVAV, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRCBERI, &
+ &PBU_INST, &
&PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA, PB, &
&PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
@@ -54,16 +46,7 @@ USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
!
-USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
- & ITH, & ! Potential temperature
- & IRV, & ! Water vapor
- & IRC, & ! Cloud water
- & IRR, & ! Rain water
- & IRI, & ! Pristine ice
- & IRS, & ! Snow/aggregate
- & IRG, & ! Graupel
- & IRH ! Hail
-!
+USE MODD_FIELDS_ADDRESS
USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
USE MODE_ICE4_RIMLTC, ONLY: ICE4_RIMLTC
USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
@@ -108,57 +91,11 @@ REAL, DIMENSION(KPROMA), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PCIT
REAL, DIMENSION(KPROMA), INTENT(IN) :: PT
REAL, DIMENSION(KPROMA,0:KRR), INTENT(IN) :: PVART
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRVHENI_MR
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRHONG_MR
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIMLTC_MR
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG_MR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCHONI
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPS
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAGGS
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAUTS
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCAUTR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCACCR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSS
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSS
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSACCRG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRSMLTG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCMLTSR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRRG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRRCFRIG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRR
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYG
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH_MR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRGMLTR
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGWETH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGDRYH
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRDRYHG
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRHMLTR
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCBERI
+REAL, DIMENSION(KPROMA, IBUNUM),INTENT(INOUT):: PBU_INST
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRS_TEND
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND
REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PSSI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PSSI
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PA
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PB
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
@@ -198,10 +135,10 @@ DO JV=0,KRR
ENDDO
!
IF(ODSOFT) THEN
- PRVHENI_MR(:)=0.
- PRRHONG_MR(:)=0.
- PRIMLTC_MR(:)=0.
- PRSRIMCG_MR(:)=0.
+ PBU_INST(:, IRVHENI_MR)=0.
+ PBU_INST(:, IRRHONG_MR)=0.
+ PBU_INST(:, IRIMLTC_MR)=0.
+ PBU_INST(:, IRSRIMCG_MR)=0.
ELSE
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
@@ -209,12 +146,12 @@ ELSE
CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, KSIZE, LDCOMPUTE(:), &
ZVART(:,ITH), PPRES(:), PRHODREF(:), PEXN(:), PLSFACT(:), ZT(:), &
ZVART(:,IRV), &
- PCIT(:), PRVHENI_MR(:))
+ PCIT(:), PBU_INST(:, IRVHENI_MR))
DO JL=1, KSIZE
- ZVART(JL,ITH)=ZVART(JL,ITH) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZVART(JL,ITH)=ZVART(JL,ITH) + PBU_INST(JL, IRVHENI_MR)*PLSFACT(JL)
ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
- ZVART(JL,IRV)=ZVART(JL,IRV) - PRVHENI_MR(JL)
- ZVART(JL,IRI)=ZVART(JL,IRI) + PRVHENI_MR(JL)
+ ZVART(JL,IRV)=ZVART(JL,IRV) - PBU_INST(JL, IRVHENI_MR)
+ ZVART(JL,IRI)=ZVART(JL,IRI) + PBU_INST(JL, IRVHENI_MR)
ENDDO
!
!* 3.3 compute the spontaneous freezing source: RRHONG
@@ -223,12 +160,12 @@ ELSE
&PEXN, PLVFACT, PLSFACT, &
&ZT, ZVART(:,IRR), &
&ZVART(:,ITH), &
- &PRRHONG_MR)
+ &PBU_INST(:, IRRHONG_MR))
DO JL=1, KSIZE
- ZVART(JL,ITH) = ZVART(JL,ITH) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZVART(JL,ITH) = ZVART(JL,ITH) + PBU_INST(JL, IRRHONG_MR)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
- ZVART(JL,IRR) = ZVART(JL,IRR) - PRRHONG_MR(JL)
- ZVART(JL,IRG) = ZVART(JL,IRG) + PRRHONG_MR(JL)
+ ZVART(JL,IRR) = ZVART(JL,IRR) - PBU_INST(JL, IRRHONG_MR)
+ ZVART(JL,IRG) = ZVART(JL,IRG) + PBU_INST(JL, IRRHONG_MR)
ENDDO
!
!* 7.1 cloud ice melting
@@ -237,12 +174,12 @@ ELSE
&PEXN, PLVFACT, PLSFACT, &
&ZT, &
&ZVART(:,ITH), ZVART(:,IRI), &
- &PRIMLTC_MR)
+ &PBU_INST(:, IRIMLTC_MR))
DO JL=1, KSIZE
- ZVART(JL,ITH) = ZVART(JL,ITH) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZVART(JL,ITH) = ZVART(JL,ITH) - PBU_INST(JL, IRIMLTC_MR)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
- ZVART(JL,IRC) = ZVART(JL,IRC) + PRIMLTC_MR(JL)
- ZVART(JL,IRI) = ZVART(JL,IRI) - PRIMLTC_MR(JL)
+ ZVART(JL,IRC) = ZVART(JL,IRC) + PBU_INST(JL, IRIMLTC_MR)
+ ZVART(JL,IRI) = ZVART(JL,IRI) - PBU_INST(JL, IRIMLTC_MR)
ENDDO
!
! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
@@ -255,37 +192,37 @@ ELSE
ZLBDAS(1:KSIZE)=0.
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
- CALL ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
+ CALL ICE4_RSRIMCG_OLD(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
&PRHODREF, &
&ZLBDAS, &
&ZT, ZVART(:,IRC), ZVART(:,IRS), &
- &PRSRIMCG_MR)
+ &PBU_INST(:, IRSRIMCG_MR))
DO JL=1, KSIZE
- ZVART(JL,IRS) = ZVART(JL,IRS) - PRSRIMCG_MR(JL)
- ZVART(JL,IRG) = ZVART(JL,IRG) + PRSRIMCG_MR(JL)
+ ZVART(JL,IRS) = ZVART(JL,IRS) - PBU_INST(JL, IRSRIMCG_MR)
+ ZVART(JL,IRG) = ZVART(JL,IRG) + PBU_INST(JL, IRSRIMCG_MR)
ENDDO
ELSE
- PRSRIMCG_MR(:) = 0.
+ PBU_INST(:, IRSRIMCG_MR) = 0.
ENDIF
DO JL=1, KSIZE
- PB(JL, ITH)=PB(JL, ITH) + PRVHENI_MR(JL)*PLSFACT(JL)
- PB(JL, ITH)=PB(JL, ITH) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PB(JL, ITH)=PB(JL, ITH) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PB(JL, ITH)=PB(JL, ITH) + PBU_INST(JL, IRVHENI_MR)*PLSFACT(JL)
+ PB(JL, ITH)=PB(JL, ITH) + PBU_INST(JL, IRRHONG_MR)*(PLSFACT(JL)-PLVFACT(JL))
+ PB(JL, ITH)=PB(JL, ITH) - PBU_INST(JL, IRIMLTC_MR)*(PLSFACT(JL)-PLVFACT(JL))
- PB(JL, IRV)=PB(JL, IRV) - PRVHENI_MR(JL)
+ PB(JL, IRV)=PB(JL, IRV) - PBU_INST(JL, IRVHENI_MR)
- PB(JL, IRC)=PB(JL, IRC) + PRIMLTC_MR(JL)
+ PB(JL, IRC)=PB(JL, IRC) + PBU_INST(JL, IRIMLTC_MR)
- PB(JL, IRR)=PB(JL, IRR) - PRRHONG_MR(JL)
+ PB(JL, IRR)=PB(JL, IRR) - PBU_INST(JL, IRRHONG_MR)
- PB(JL, IRI)=PB(JL, IRI) + PRVHENI_MR(JL)
- PB(JL, IRI)=PB(JL, IRI) - PRIMLTC_MR(JL)
+ PB(JL, IRI)=PB(JL, IRI) + PBU_INST(JL, IRVHENI_MR)
+ PB(JL, IRI)=PB(JL, IRI) - PBU_INST(JL, IRIMLTC_MR)
- PB(JL, IRS)=PB(JL, IRS) - PRSRIMCG_MR(JL)
+ PB(JL, IRS)=PB(JL, IRS) - PBU_INST(JL, IRSRIMCG_MR)
- PB(JL, IRG)=PB(JL, IRG) + PRRHONG_MR(JL)
- PB(JL, IRG)=PB(JL, IRG) + PRSRIMCG_MR(JL)
+ PB(JL, IRG)=PB(JL, IRG) + PBU_INST(JL, IRRHONG_MR)
+ PB(JL, IRG)=PB(JL, IRG) + PBU_INST(JL, IRSRIMCG_MR)
ENDDO
!
!* Derived fields
@@ -385,7 +322,7 @@ CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, PRHODREF, ZT,
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZLBDAS, ZLBDAG, &
&ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG)
+ &PBU_INST(:, IRCHONI), PBU_INST(:, IRVDEPS), PBU_INST(:, IRIAGGS), PBU_INST(:, IRIAUTS), PBU_INST(:, IRVDEPG))
!
!-------------------------------------------------------------------------------
!
@@ -403,11 +340,11 @@ IF(PARAMI%LWARM) THEN ! Check if the formation of the raindrops by the slow
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
&PCF, ZRAINFR, &
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), &
- &PRCAUTR, PRCACCR, PRREVAV)
+ &PBU_INST(:, IRCAUTR), PBU_INST(:, IRCACCR), PBU_INST(:, IRREVAV))
ELSE
- PRCAUTR(:)=0.
- PRCACCR(:)=0.
- PRREVAV(:)=0.
+ PBU_INST(:, IRCAUTR)=0.
+ PBU_INST(:, IRCACCR)=0.
+ PBU_INST(:, IRREVAV)=0.
END IF
!
!-------------------------------------------------------------------------------
@@ -421,10 +358,10 @@ CALL ICE4_FAST_RS(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
&ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRS), &
- &PRIAGGS, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
- &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
- &PRCMLTSR, &
+ &PBU_INST(:, IRIAGGS), &
+ &PBU_INST(:, IRCRIMSS), PBU_INST(:, IRCRIMSG), PBU_INST(:, IRSRIMCG), &
+ &PBU_INST(:, IRRACCSS), PBU_INST(:, IRRACCSG), PBU_INST(:, IRSACCRG), PBU_INST(:, IRSMLTG), &
+ &PBU_INST(:, IRCMLTSR), &
&PRS_TEND)
!
!-------------------------------------------------------------------------------
@@ -434,9 +371,9 @@ CALL ICE4_FAST_RS(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
! ------------------------------------------------------
!
DO JL=1, KSIZE
- ZRGSI(JL) = PRVDEPG(JL) + PRSMLTG(JL) + PRRACCSG(JL) + &
- & PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
- ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
+ ZRGSI(JL) = PBU_INST(JL, IRVDEPG) + PBU_INST(JL, IRSMLTG) + PBU_INST(JL, IRRACCSG) + &
+ & PBU_INST(JL, IRSACCRG) + PBU_INST(JL, IRCRIMSG) + PBU_INST(JL, IRSRIMCG)
+ ZRGSI_MR(JL) = PBU_INST(JL, IRRHONG_MR) + PBU_INST(JL, IRSRIMCG_MR)
ENDDO
CALL ICE4_FAST_RG(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
@@ -445,8 +382,10 @@ CALL ICE4_FAST_RG(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, KRR
&ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZRGSI, ZRGSI_MR(:), &
&LLWETG, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
+ &PBU_INST(:, IRICFRRG), PBU_INST(:, IRRCFRIG), PBU_INST(:, IRICFRR), PBU_INST(:, IRCWETG), &
+ &PBU_INST(:, IRIWETG), PBU_INST(:, IRRWETG), PBU_INST(:, IRSWETG), &
+ &PBU_INST(:, IRCDRYG), PBU_INST(:, IRIDRYG), PBU_INST(:, IRRDRYG), PBU_INST(:, IRSDRYG), &
+ &PBU_INST(:, IRWETGH), PBU_INST(:, IRWETGH_MR), PBU_INST(:, IRGMLTR), &
&PRG_TEND)
!
!-------------------------------------------------------------------------------
@@ -461,22 +400,23 @@ IF (KRR==7) THEN
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
&ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), ZVART(:,IRH), &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
+ &PBU_INST(:, IRCWETH), PBU_INST(:, IRIWETH), PBU_INST(:, IRSWETH), PBU_INST(:, IRGWETH), PBU_INST(:, IRRWETH), &
+ &PBU_INST(:, IRCDRYH), PBU_INST(:, IRIDRYH), PBU_INST(:, IRSDRYH), PBU_INST(:, IRRDRYH), &
+ &PBU_INST(:, IRGDRYH), PBU_INST(:, IRDRYHG), PBU_INST(:, IRHMLTR), &
&PRH_TEND)
ELSEIF (BUCONF%LBU_ENABLE) THEN
- PRCWETH(:)=0.
- PRIWETH(:)=0.
- PRSWETH(:)=0.
- PRGWETH(:)=0.
- PRRWETH(:)=0.
- PRCDRYH(:)=0.
- PRIDRYH(:)=0.
- PRSDRYH(:)=0.
- PRRDRYH(:)=0.
- PRGDRYH(:)=0.
- PRDRYHG(:)=0.
- PRHMLTR(:)=0.
+ PBU_INST(:, IRCWETH)=0.
+ PBU_INST(:, IRIWETH)=0.
+ PBU_INST(:, IRSWETH)=0.
+ PBU_INST(:, IRGWETH)=0.
+ PBU_INST(:, IRRWETH)=0.
+ PBU_INST(:, IRCDRYH)=0.
+ PBU_INST(:, IRIDRYH)=0.
+ PBU_INST(:, IRSDRYH)=0.
+ PBU_INST(:, IRRDRYH)=0.
+ PBU_INST(:, IRGDRYH)=0.
+ PBU_INST(:, IRDRYHG)=0.
+ PBU_INST(:, IRHMLTR)=0.
END IF
!
!-------------------------------------------------------------------------------
@@ -490,7 +430,7 @@ CALL ICE4_FAST_RI(ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
&ZAI, ZCJ, PCIT, &
&PSSI, &
&ZVART(:,IRC), ZVART(:,IRI), &
- &PRCBERI)
+ &PBU_INST(:, IRCBERI))
!
!-------------------------------------------------------------------------------
!
@@ -499,108 +439,109 @@ CALL ICE4_FAST_RI(ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
! -------------------------
!
DO JL=1, KSIZE
- PA(JL, ITH) = PA(JL, ITH) + PRVDEPG(JL)*PLSFACT(JL)
- PA(JL, ITH) = PA(JL, ITH) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + PRVDEPS(JL)*PLSFACT(JL)
- PA(JL, ITH) = PA(JL, ITH) - PRREVAV(JL)*PLVFACT(JL)
- PA(JL, ITH) = PA(JL, ITH) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRVDEPG)*PLSFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRCHONI)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRVDEPS)*PLSFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) - PBU_INST(JL, IRREVAV)*PLVFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRCRIMSS)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRCRIMSG)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRRACCSS)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRRACCSG)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PBU_INST(JL, IRRCFRIG) - PBU_INST(JL, IRICFRR))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PBU_INST(JL, IRCWETG) + PBU_INST(JL, IRRWETG))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PBU_INST(JL, IRCDRYG)+PBU_INST(JL, IRRDRYG))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) - PBU_INST(JL, IRGMLTR)*(PLSFACT(JL)-PLVFACT(JL))
IF (KRR==7) THEN
- PA(JL, ITH) = PA(JL, ITH) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, ITH) = PA(JL, ITH) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PBU_INST(JL, IRRWETH)+PBU_INST(JL, IRCWETH))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PBU_INST(JL, IRCDRYH)+PBU_INST(JL, IRRDRYH))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) - PBU_INST(JL, IRHMLTR)*(PLSFACT(JL)-PLVFACT(JL))
ENDIF
- PA(JL, ITH) = PA(JL, ITH) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PBU_INST(JL, IRCBERI)*(PLSFACT(JL)-PLVFACT(JL))
- PA(JL, IRV) = PA(JL, IRV) - PRVDEPG(JL)
- PA(JL, IRV) = PA(JL, IRV) - PRVDEPS(JL)
- PA(JL, IRV) = PA(JL, IRV) + PRREVAV(JL)
+ PA(JL, IRV) = PA(JL, IRV) - PBU_INST(JL, IRVDEPG)
+ PA(JL, IRV) = PA(JL, IRV) - PBU_INST(JL, IRVDEPS)
+ PA(JL, IRV) = PA(JL, IRV) + PBU_INST(JL, IRREVAV)
- PA(JL, IRC) = PA(JL, IRC) - PRCHONI(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCAUTR(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCACCR(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCRIMSS(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCRIMSG(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCMLTSR(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCWETG(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCDRYG(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCHONI)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCAUTR)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCACCR)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCRIMSS)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCRIMSG)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCMLTSR)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCWETG)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCDRYG)
IF (KRR==7) THEN
- PA(JL, IRC) = PA(JL, IRC) - PRCWETH(JL)
- PA(JL, IRC) = PA(JL, IRC) - PRCDRYH(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCWETH)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCDRYH)
ENDIF
- PA(JL, IRC) = PA(JL, IRC) - PRCBERI(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PBU_INST(JL, IRCBERI)
- PA(JL, IRR) = PA(JL, IRR) + PRCAUTR(JL)
- PA(JL, IRR) = PA(JL, IRR) + PRCACCR(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRREVAV(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRACCSS(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRACCSG(JL)
- PA(JL, IRR) = PA(JL, IRR) + PRCMLTSR(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRCFRIG(JL) + PRICFRR(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRWETG(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRDRYG(JL)
- PA(JL, IRR) = PA(JL, IRR) + PRGMLTR(JL)
+ PA(JL, IRR) = PA(JL, IRR) + PBU_INST(JL, IRCAUTR)
+ PA(JL, IRR) = PA(JL, IRR) + PBU_INST(JL, IRCACCR)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRREVAV)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRACCSS)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRACCSG)
+ PA(JL, IRR) = PA(JL, IRR) + PBU_INST(JL, IRCMLTSR)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRCFRIG) + PBU_INST(JL, IRICFRR)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRWETG)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRDRYG)
+ PA(JL, IRR) = PA(JL, IRR) + PBU_INST(JL, IRGMLTR)
IF(KRR==7) THEN
- PA(JL, IRR) = PA(JL, IRR) - PRRWETH(JL)
- PA(JL, IRR) = PA(JL, IRR) - PRRDRYH(JL)
- PA(JL, IRR) = PA(JL, IRR) + PRHMLTR(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRWETH)
+ PA(JL, IRR) = PA(JL, IRR) - PBU_INST(JL, IRRDRYH)
+ PA(JL, IRR) = PA(JL, IRR) + PBU_INST(JL, IRHMLTR)
ENDIF
- PA(JL, IRI) = PA(JL, IRI) + PRCHONI(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRIAGGS(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRIAUTS(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRICFRRG(JL) - PRICFRR(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRIWETG(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRIDRYG(JL)
+ PA(JL, IRI) = PA(JL, IRI) + PBU_INST(JL, IRCHONI)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIAGGS)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIAUTS)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRICFRRG) - PBU_INST(JL, IRICFRR)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIWETG)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIDRYG)
IF (KRR==7) THEN
- PA(JL, IRI) = PA(JL, IRI) - PRIWETH(JL)
- PA(JL, IRI) = PA(JL, IRI) - PRIDRYH(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIWETH)
+ PA(JL, IRI) = PA(JL, IRI) - PBU_INST(JL, IRIDRYH)
ENDIF
- PA(JL, IRI) = PA(JL, IRI) + PRCBERI(JL)
+ PA(JL, IRI) = PA(JL, IRI) + PBU_INST(JL, IRCBERI)
- PA(JL, IRS) = PA(JL, IRS) + PRVDEPS(JL)
- PA(JL, IRS) = PA(JL, IRS) + PRIAGGS(JL)
- PA(JL, IRS) = PA(JL, IRS) + PRIAUTS(JL)
- PA(JL, IRS) = PA(JL, IRS) + PRCRIMSS(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSRIMCG(JL)
- PA(JL, IRS) = PA(JL, IRS) + PRRACCSS(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSACCRG(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSMLTG(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSWETG(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSDRYG(JL)
+ PA(JL, IRS) = PA(JL, IRS) + PBU_INST(JL, IRVDEPS)
+ PA(JL, IRS) = PA(JL, IRS) + PBU_INST(JL, IRIAGGS)
+ PA(JL, IRS) = PA(JL, IRS) + PBU_INST(JL, IRIAUTS)
+ PA(JL, IRS) = PA(JL, IRS) + PBU_INST(JL, IRCRIMSS)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSRIMCG)
+ PA(JL, IRS) = PA(JL, IRS) + PBU_INST(JL, IRRACCSS)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSACCRG)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSMLTG)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSWETG)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSDRYG)
IF (KRR==7) THEN
- PA(JL, IRS) = PA(JL, IRS) - PRSWETH(JL)
- PA(JL, IRS) = PA(JL, IRS) - PRSDRYH(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSWETH)
+ PA(JL, IRS) = PA(JL, IRS) - PBU_INST(JL, IRSDRYH)
ENDIF
- PA(JL, IRG) = PA(JL, IRG) + PRVDEPG(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRCRIMSG(JL)+PRSRIMCG(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRRACCSG(JL)+PRSACCRG(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRSMLTG(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRICFRRG(JL) + PRRCFRIG(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
- PA(JL, IRG) = PA(JL, IRG) - PRWETGH(JL)
- PB(JL, IRG) = PB(JL, IRG) - PRWETGH_MR(JL)
- PA(JL, IRG) = PA(JL, IRG) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
- PA(JL, IRG) = PA(JL, IRG) - PRGMLTR(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRVDEPG)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRCRIMSG)+PBU_INST(JL, IRSRIMCG)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRRACCSG)+PBU_INST(JL, IRSACCRG)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRSMLTG)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRICFRRG) + PBU_INST(JL, IRRCFRIG)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRCWETG) + PBU_INST(JL, IRIWETG) + PBU_INST(JL, IRSWETG) + PBU_INST(JL, IRRWETG)
+ PA(JL, IRG) = PA(JL, IRG) - PBU_INST(JL, IRWETGH)
+ PB(JL, IRG) = PB(JL, IRG) - PBU_INST(JL, IRWETGH_MR)
+ PA(JL, IRG) = PA(JL, IRG) + PBU_INST(JL, IRCDRYG) + PBU_INST(JL, IRIDRYG) + PBU_INST(JL, IRSDRYG) + PBU_INST(JL, IRRDRYG)
+ PA(JL, IRG) = PA(JL, IRG) - PBU_INST(JL, IRGMLTR)
IF (KRR==7) THEN
- PA(JL, IRG) = PA(JL, IRG) - PRGWETH(JL)
- PA(JL, IRG) = PA(JL, IRG) - PRGDRYH(JL) + PRDRYHG(JL)
+ PA(JL, IRG) = PA(JL, IRG) - PBU_INST(JL, IRGWETH)
+ PA(JL, IRG) = PA(JL, IRG) - PBU_INST(JL, IRGDRYH) + PBU_INST(JL, IRDRYHG)
ENDIF
IF (KRR==7) THEN
- PA(JL, IRH) = PA(JL, IRH) + PRWETGH(JL)
- PB(JL, IRH) = PB(JL, IRH) + PRWETGH_MR(JL)
- PA(JL, IRH) = PA(JL, IRH) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
- PA(JL, IRH) = PA(JL, IRH) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
- &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
- PA(JL, IRH) = PA(JL, IRH) - PRHMLTR(JL)
+ PA(JL, IRH) = PA(JL, IRH) + PBU_INST(JL, IRWETGH)
+ PB(JL, IRH) = PB(JL, IRH) + PBU_INST(JL, IRWETGH_MR)
+ PA(JL, IRH) = PA(JL, IRH) + PBU_INST(JL, IRCWETH)+PBU_INST(JL, IRIWETH)+PBU_INST(JL, IRSWETH)+&
+ & PBU_INST(JL, IRGWETH)+PBU_INST(JL, IRRWETH)
+ PA(JL, IRH) = PA(JL, IRH) + PBU_INST(JL, IRCDRYH)+PBU_INST(JL, IRIDRYH)+PBU_INST(JL, IRSDRYH)+&
+ & PBU_INST(JL, IRRDRYH)+PBU_INST(JL, IRGDRYH) - PBU_INST(JL, IRDRYHG)
+ PA(JL, IRH) = PA(JL, IRH) - PBU_INST(JL, IRHMLTR)
ENDIF
ENDDO
!
diff --git a/src/PHYEX/micro/modi_rain_ice.f90 b/src/PHYEX/micro/modi_rain_ice.f90
index 44988b26ccd07cc685a414d4c073471c676dc866..bf65a39d521a0b9ce389d053524d36f815a21f44 100644
--- a/src/PHYEX/micro/modi_rain_ice.f90
+++ b/src/PHYEX/micro/modi_rain_ice.f90
@@ -4,9 +4,8 @@
!
INTERFACE
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
- KPROMA, KSIZE, &
- OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ KPROMA, OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
@@ -33,16 +32,11 @@ TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
-INTEGER, INTENT(IN) :: KSIZE
LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
- ! Kind of Subgrid autoconversion method
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
- ! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -53,10 +47,10 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HRC
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HCF
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HRI
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HCF
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
diff --git a/src/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index aa9b05d272540471381ce91dd65f468fb73b6be2..2008e76f6b6552c424e91d78e78e8a310eed4a79 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -5,9 +5,8 @@
!-----------------------------------------------------------------
! ######spl
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
- KPROMA, KSIZE, &
- OCND2,HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ KPROMA, OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
@@ -202,11 +201,10 @@ USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDG
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
-USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
-USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
-USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
+USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
+USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
+USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
!
IMPLICIT NONE
!
@@ -221,13 +219,11 @@ TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
-INTEGER, INTENT(IN) :: KSIZE
LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -238,10 +234,11 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HRC
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HCF
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HRI
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PHLI_HCF
+!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
@@ -266,6 +263,7 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(MERGE(D%NIJT, 0, PARAMI%LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
@@ -282,153 +280,30 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK
INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
-INTEGER :: ISTIJ, ISTK
!
-!Arrays for nucleation call outisde of ODMICRO points
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZW ! work array
+LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLMICRO ! mask to limit computation
+!Arrays for nucleation call outisde of LLMICRO points
REAL, DIMENSION(D%NIJT, D%NKT) :: ZT ! Temperature
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZZ_RVHENI ! heterogeneous nucleation
-REAL, DIMENSION(MERGE(D%NIJT, 0, BUCONF%LBU_ENABLE), &
- &MERGE(D%NKT, 0, BUCONF%LBU_ENABLE)) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 !Work arrays
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_LVFACT, ZZ_LSFACT, ZZ_DIFF
-!
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRCT ! Cloud water m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRRT ! Rain water m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRIT ! Pristine ice m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRST ! Snow/aggregate m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRGT ! Graupel m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRHT ! Hail m.r. source at t
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZCITOUT ! Output value for CIT
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZLBDAS ! Modif !lbda parameter snow
-
-!Diagnostics
-REAL, DIMENSION(D%NIJT) :: ZINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_RVHENI ! heterogeneous nucleation
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_LVFACT, ZZ_LSFACT
!
-LOGICAL :: GEXT_TEND
-LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
-INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL :: ZW0D
-REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL :: ZTIME_THRESHOLD ! Time to reach threshold
!For total tendencies computation
REAL, DIMENSION(D%NIJT,D%NKT,0:7) :: ZWR
!
-!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
-!
-!For packing
-INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER :: JL, JV
-REAL, DIMENSION(KPROMA) :: ZTIME ! Current integration time (starts with 0 and ends with PTSTEP)
-REAL, DIMENSION(KPROMA) :: &
- & ZMAXTIME, & ! Time on which we can apply the current tendencies
- & ZTIME_LASTCALL, & ! Integration time when last tendecies call has been done
- & ZSSI, &
- & ZCIT, & ! Pristine ice conc. at t
- & ZRHODREF, & ! RHO Dry REFerence
- & ZZT, & ! Temperature
- & ZPRES, & ! Pressure
- & ZEXN, & ! EXNer Pressure
- & ZLSFACT, & ! L_s/(Pi*C_ph)
- & ZLVFACT, & ! L_v/(Pi*C_ph)
- & ZSIGMA_RC,& ! Standard deviation of rc at time t
- & ZCF, & ! Cloud fraction
- & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
- & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that ZCF = ZHLC_HCF + ZHLC_LCF
- & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that ZRC = ZHLC_HRC + ZHLC_LRC
- & ZHLI_HCF, &
- & ZHLI_LCF, &
- & ZHLI_HRI, &
- & ZHLI_LRI
-LOGICAL, DIMENSION(KPROMA) :: LLCOMPUTE ! .TRUE. or points where we must compute tendencies,
-!
-!Output packed tendencies (for budgets only)
-REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZRCHONI, & ! Homogeneous nucleation
- & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
- & ZRVDEPS, & ! Deposition on r_s,
- & ZRIAGGS, & ! Aggregation on r_s
- & ZRIAUTS, & ! Autoconversion of r_i for r_s production
- & ZRVDEPG, & ! Deposition on r_g
- & ZRCAUTR, & ! Autoconversion of r_c for r_r production
- & ZRCACCR, & ! Accretion of r_c for r_r production
- & ZRREVAV, & ! Evaporation of r_r
- & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
- & ZRCBERI, & ! Bergeron-Findeisen effect
- & ZRHMLTR, & ! Melting of the hailstones
- & ZRSMLTG, & ! Conversion-Melting of the aggregates
- & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
- & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
- & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
- & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
- & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
- & ZRWETGH, & ! Conversion of graupel into hail
- & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
- & ZRGMLTR, & ! Melting of the graupel
- & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
- & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
- & ZRDRYHG ! Conversion of hailstone into graupel
-!
-!For mixing-ratio-splitting
-LOGICAL :: LLCPZ0RT
-REAL :: ZTIME_THRESHOLD1D(KPROMA) ! Time to reach threshold
-REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
-!
-REAL, DIMENSION(KPROMA,0:7) :: &
- & ZVART, & !Packed variables
- & ZEXTPK, & !To take into acount external tendencies inside the splitting
- & ZA, ZB
-!
-REAL, DIMENSION(KPROMA, 8) :: ZRS_TEND, ZRG_TEND
-REAL, DIMENSION(KPROMA,10) :: ZRH_TEND
-
-INTEGER, DIMENSION(KPROMA) :: &
- & I1,I2, & ! Used to replace the COUNT and PACK intrinsics on variables
- & IITER ! Number of iterations done (with real tendencies computation)
-INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT ! Used to replace the COUNT and PACK intrinsics
-!
-REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB
-REAL :: ZDEVIDE, ZX, ZRICE
-!
-INTEGER :: IC, JMICRO
-LOGICAL :: LLSIGMA_RC, LL_ANY_ITER, LL_AUCV_ADJU
+REAL :: ZDEVIDE, ZRICE
!
REAL, DIMENSION(D%NIJT,D%NKT) :: ZW3D
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D
+REAL, DIMENSION(KRR) :: ZRSMIN
+INTEGER :: ISIZE, IPROMA, IGPBLKS, ISIZE2
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
!
+!* 1. GENERALITIES
+! ------------
+!
IKTB=D%NKTB
IKTE=D%NKTE
IKB=D%NKB
@@ -439,25 +314,15 @@ IIJE=D%NIJE
IF(OCND2) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
END IF
-IF(KPROMA /= KSIZE) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see code for explanation')
- ! Microphyscs was optimized by introducing chunks of KPROMA size
- ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
- ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
- ! A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
- ! Another solution would be to compute column by column?
- ! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
-ENDIF
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
ZINV_TSTEP=1./PTSTEP
-GEXT_TEND=.TRUE.
!
-! LSFACT and LVFACT without exner
+! LSFACT and LVFACT without exner, and LLMICRO
+! LLMICRO is a mask with a True value on points where microphysics is active
+ZRSMIN(1:KRR) = ICED%XRTMIN(1:KRR) * ZINV_TSTEP
+LLMICRO(:,:)=.FALSE.
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
+ !LSFACT and LVFACT
IF (KRR==7) THEN
ZRICE=PRIT(JIJ,JK)+PRST(JIJ,JK)+PRGT(JIJ,JK)+PRHT(JIJ,JK)
ELSE
@@ -467,36 +332,42 @@ DO JK = IKTB,IKTE
ZT(JIJ,JK) = PTHT(JIJ,JK) * PEXN(JIJ,JK)
ZZ_LSFACT(JIJ,JK)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(ZT(JIJ,JK)-CST%XTT)) / ZDEVIDE
ZZ_LVFACT(JIJ,JK)=(CST%XLVTT+(CST%XCPV-CST%XCL)*(ZT(JIJ,JK)-CST%XTT)) / ZDEVIDE
+
+ !LLMICRO
+ IF (KRR==7) THEN
+ LLMICRO(JIJ,JK)=PRCT(JIJ,JK)>ICED%XRTMIN(2) .OR. &
+ PRRT(JIJ,JK)>ICED%XRTMIN(3) .OR. &
+ PRIT(JIJ,JK)>ICED%XRTMIN(4) .OR. &
+ PRST(JIJ,JK)>ICED%XRTMIN(5) .OR. &
+ PRGT(JIJ,JK)>ICED%XRTMIN(6) .OR. &
+ PRHT(JIJ,JK)>ICED%XRTMIN(7)
+#ifdef REPRO55
+ LLMICRO(JIJ,JK)=LLMICRO(JIJ,JK) .OR. &
+ PRCS(JIJ,JK)>ZRSMIN(2) .OR. &
+ PRRS(JIJ,JK)>ZRSMIN(3) .OR. &
+ PRIS(JIJ,JK)>ZRSMIN(4) .OR. &
+ PRSS(JIJ,JK)>ZRSMIN(5) .OR. &
+ PRGS(JIJ,JK)>ZRSMIN(6) .OR. &
+ PRHS(JIJ,JK)>ZRSMIN(7)
+#endif
+ ELSE
+ LLMICRO(JIJ,JK)=PRCT(JIJ,JK)>ICED%XRTMIN(2) .OR. &
+ PRRT(JIJ,JK)>ICED%XRTMIN(3) .OR. &
+ PRIT(JIJ,JK)>ICED%XRTMIN(4) .OR. &
+ PRST(JIJ,JK)>ICED%XRTMIN(5) .OR. &
+ PRGT(JIJ,JK)>ICED%XRTMIN(6)
+#ifdef REPRO55
+ LLMICRO(JIJ,JK)=LLMICRO(JIJ,JK) .OR. &
+ PRCS(JIJ,JK)>ZRSMIN(2) .OR. &
+ PRRS(JIJ,JK)>ZRSMIN(3) .OR. &
+ PRIS(JIJ,JK)>ZRSMIN(4) .OR. &
+ PRSS(JIJ,JK)>ZRSMIN(5) .OR. &
+ PRGS(JIJ,JK)>ZRSMIN(6)
+#endif
+ ENDIF
ENDDO
ENDDO
!
-!Compute lambda_snow parameter
-!ZT en KELVIN
-DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- ZLBDAS(JIJ,JK)=1000.
- END DO
-END DO
-DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- IF (PARAMI%LSNOW_T) THEN
- IF (PRST(JIJ,JK)>ICED%XRTMIN(5)) THEN
- IF(ZT(JIJ,JK)>CST%XTT-10.0) THEN
- ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*ZT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- ELSE
- ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226-0.0106*ZT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- END IF
- END IF
-#if defined(REPRO48) || defined(REPRO55)
-#else
- ELSE
- IF (PRST(JIJ,JK).GT.ICED%XRTMIN(5)) THEN
- ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX,ICED%XLBS*(PRHODREF(JIJ,JK)*PRST(JIJ,JK))**ICED%XLBEXS),ICED%XLBDAS_MIN)
- END IF
-#endif
- END IF
- END DO
-END DO
!
!-------------------------------------------------------------------------------
!
@@ -504,130 +375,26 @@ END DO
! -------------------------------------
!
IF(.NOT. PARAMI%LSEDIM_AFTER) THEN
- !
- !* 2.1 sedimentation
- !
- IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
-
- IF(PARAMI%CSEDIM=='STAT') THEN
- IF(KRR==7) THEN
- DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
- ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
- ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
- ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
- ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
- ZRHT(JIJ,JK)=PRHS(JIJ,JK)*PTSTEP
- ENDDO
- ENDDO
- CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
- &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
- &PRSS, ZRST, PRGS, ZRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
- ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
- ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
- ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
- ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
- ENDDO
- ENDDO
- CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
- &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
- &PRSS, ZRST, PRGS, ZRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
- !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
- &PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
- &PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
- !We correct negativities with conservation
- !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
- ! It is initialized with the m.r. at T and is modified by two tendencies:
- ! sedimentation tendency and an external tendency which represents all other
- ! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a species at a given sub-timestep. From
- ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
- ! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a species, instead we apply
- ! a correction here.
- CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
- &PRIS, PRSS, PRGS, &
- &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
- ELSEIF(PARAMI%CSEDIM=='NONE') THEN
- ELSE
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
- END IF
-
-
-
-
-
-
-!!!!! ajouter momentum
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- !
- !* 2.2 budget storage
- !
- IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
+ &PTSTEP, KRR, PDZZ, &
+ &ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
+ &PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRS, PINPRG, &
+ &TBUDGETS, KBUDGETS, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ENDIF
!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIAL VALUES SAVING
+! ---------------------
+!
DO JK = IKTB,IKTE
- !Backup of T variables
+ !Copy of T variables to keep untouched the prognostic variables
+ ZWR(:,JK,ITH)=PTHT(:,JK)
ZWR(:,JK,IRV)=PRVT(:,JK)
ZWR(:,JK,IRC)=PRCT(:,JK)
ZWR(:,JK,IRR)=PRRT(:,JK)
@@ -645,489 +412,25 @@ DO JK = IKTB,IKTE
PEVAP3D(:,JK)=0.
ENDIF
PRAINFR(:,JK)=0.
-#ifdef REPRO55
- ZCITOUT(:,JK)=PCIT(:,JK)
-#else
- ZCITOUT(:,JK)=0. !We want 0 outside of IMICRO points
-#endif
ENDDO
-
-IF(BUCONF%LBU_ENABLE) THEN
- ZTOT_RVHENI(:)=0.
- ZTOT_RCHONI(:)=0.
- ZTOT_RRHONG(:)=0.
- ZTOT_RVDEPS(:)=0.
- ZTOT_RIAGGS(:)=0.
- ZTOT_RIAUTS(:)=0.
- ZTOT_RVDEPG(:)=0.
- ZTOT_RCAUTR(:)=0.
- ZTOT_RCACCR(:)=0.
- ZTOT_RREVAV(:)=0.
- ZTOT_RCRIMSS(:)=0.
- ZTOT_RCRIMSG(:)=0.
- ZTOT_RSRIMCG(:)=0.
- ZTOT_RIMLTC(:)=0.
- ZTOT_RCBERI(:)=0.
- ZTOT_RHMLTR(:)=0.
- ZTOT_RSMLTG(:)=0.
- ZTOT_RCMLTSR(:)=0.
- ZTOT_RRACCSS(:)=0.
- ZTOT_RRACCSG(:)=0.
- ZTOT_RSACCRG(:)=0.
- ZTOT_RICFRRG(:)=0.
- ZTOT_RRCFRIG(:)=0.
- ZTOT_RICFRR(:)=0.
- ZTOT_RCWETG(:)=0.
- ZTOT_RIWETG(:)=0.
- ZTOT_RRWETG(:)=0.
- ZTOT_RSWETG(:)=0.
- ZTOT_RCDRYG(:)=0.
- ZTOT_RIDRYG(:)=0.
- ZTOT_RRDRYG(:)=0.
- ZTOT_RSDRYG(:)=0.
- ZTOT_RWETGH(:)=0.
- ZTOT_RGMLTR(:)=0.
- ZTOT_RCWETH(:)=0.
- ZTOT_RIWETH(:)=0.
- ZTOT_RSWETH(:)=0.
- ZTOT_RGWETH(:)=0.
- ZTOT_RRWETH(:)=0.
- ZTOT_RCDRYH(:)=0.
- ZTOT_RIDRYH(:)=0.
- ZTOT_RSDRYH(:)=0.
- ZTOT_RRDRYH(:)=0.
- ZTOT_RGDRYH(:)=0.
- ZTOT_RDRYHG(:)=0.
-ENDIF
-
-!-------------------------------------------------------------------------------
-! optimization by looking for locations where
-! the microphysical fields are larger than a minimal value only !!!
!
-IF (KSIZE /= COUNT(ODMICRO(IIJB:IIJE,IKTB:IKTE))) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'RAIN_ICE : KSIZE /= COUNT(ODMICRO)')
-ENDIF
-
-IF (KSIZE > 0) THEN
-
- !Maximum number of iterations
- !We only count real iterations (those for which we *compute* tendencies)
- INB_ITER_MAX=PARAMI%NMAXITER
- IF(PARAMI%XTSTEP_TS/=0.)THEN
- INB_ITER_MAX=MAX(1, INT(PTSTEP/PARAMI%XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
- ZTSTEP=PTSTEP/INB_ITER_MAX
- INB_ITER_MAX=MAX(PARAMI%NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
- ENDIF
-
-!===============================================================================================================
-! Cache-blocking loop :
-
- LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
- LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
-
- ! starting indexes :
- IC=0
- ISTK=IKTB
- ISTIJ=IIJB
-
- DO JMICRO=1,KSIZE,KPROMA
-
- IMICRO=MIN(KPROMA,KSIZE-JMICRO+1)
!
-!* 3. PACKING
-! --------
-
- ! Setup packing parameters
- OUTER_LOOP: DO JK = ISTK, IKTE
- IF (ANY(ODMICRO(:,JK))) THEN
- DO JIJ = ISTIJ, IIJE
- IF (ODMICRO(JIJ,JK)) THEN
- IC=IC+1
- ! Initialization of variables in packed format :
- ZVART(IC, ITH)=PTHT(JIJ, JK)
- ZVART(IC, IRV)=PRVT(JIJ, JK)
- ZVART(IC, IRC)=PRCT(JIJ, JK)
- ZVART(IC, IRR)=PRRT(JIJ, JK)
- ZVART(IC, IRI)=PRIT(JIJ, JK)
- ZVART(IC, IRS)=PRST(JIJ, JK)
- ZVART(IC, IRG)=PRGT(JIJ, JK)
- IF (KRR==7) THEN
- ZVART(IC, IRH)=PRHT(JIJ, JK)
- ENDIF
- IF (GEXT_TEND) THEN
- !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
- ZEXTPK(IC, ITH)=PTHS(JIJ, JK)
- ZEXTPK(IC, IRV)=PRVS(JIJ, JK)
- ZEXTPK(IC, IRC)=PRCS(JIJ, JK)
- ZEXTPK(IC, IRR)=PRRS(JIJ, JK)
- ZEXTPK(IC, IRI)=PRIS(JIJ, JK)
- ZEXTPK(IC, IRS)=PRSS(JIJ, JK)
- ZEXTPK(IC, IRG)=PRGS(JIJ, JK)
- IF (KRR==7) THEN
- ZEXTPK(IC, IRH)=PRHS(JIJ, JK)
- ENDIF
- ENDIF
- ZCIT (IC)=PCIT (JIJ, JK)
- ZCF (IC)=PCLDFR (JIJ, JK)
- ZRHODREF (IC)=PRHODREF(JIJ, JK)
- ZPRES (IC)=PPABST (JIJ, JK)
- ZEXN (IC)=PEXN (JIJ, JK)
- IF(LLSIGMA_RC) THEN
- ZSIGMA_RC(IC)=PSIGS (JIJ, JK)
- ENDIF
- IF (LL_AUCV_ADJU) THEN
- ZHLC_HCF(IC) = PHLC_HCF(JIJ, JK)
- ZHLC_HRC(IC) = PHLC_HRC(JIJ, JK)
- ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
- ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
- ENDIF
- ! Save indices for later usages:
- I1(IC) = JIJ
- I2(IC) = JK
- I1TOT(JMICRO+IC-1)=JIJ
- I2TOT(JMICRO+IC-1)=JK
- IF (IC==IMICRO) THEN
- ! the end of the chunk has been reached, then reset the starting index :
- ISTIJ=JIJ+1
- IF (ISTIJ <= IIJE) THEN
- ISTK=JK
- ELSE
- ! end of line, restart from 1 and increment upper loop
- ISTK=JK+1
- IF (ISTK > IKTE) THEN
- ! end of line, restart from 1
- ISTK=IKTB
- ENDIF
- ENDIF
- IC=0
- EXIT OUTER_LOOP
- ENDIF
- ENDIF
- ENDDO
- ENDIF
- ! restart inner loop on JIJ :
- ISTIJ=IIJB
- ENDDO OUTER_LOOP
-
- IF (GEXT_TEND) THEN
- DO JV=0, KRR
- DO JL=1, IMICRO
- ZEXTPK(JL, JV)=ZEXTPK(JL, JV)-ZVART(JL, JV)*ZINV_TSTEP
- ENDDO
- ENDDO
- ENDIF
- IF (LLSIGMA_RC) THEN
- DO JL=1, IMICRO
- ZSIGMA_RC(JL)=ZSIGMA_RC(JL)*2.
- ENDDO
- ENDIF
- IF (LL_AUCV_ADJU) THEN
- DO JL=1, IMICRO
- ZHLC_LRC(JL) = ZVART(JL, IRC) - ZHLC_HRC(JL)
- ZHLI_LRI(JL) = ZVART(JL, IRI) - ZHLI_HRI(JL)
- IF(ZVART(JL, IRC)>0.) THEN
- ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
- ELSE
- ZHLC_LCF(JL)=0.
- ENDIF
- IF(ZVART(JL, IRI)>0.) THEN
- ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
- ELSE
- ZHLI_LCF(JL)=0.
- ENDIF
- ENDDO
- ENDIF
-
-!-------------------------------------------------------------------------------
-!
-!* 4. LOOP
-! ----
-!
- IITER(1:IMICRO)=0
- ZTIME(1:IMICRO)=0. ! Current integration time (all points may have a different integration time)
-
- DO WHILE(ANY(ZTIME(1:IMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
-
- IF(PARAMI%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 tendencies
- ZTIME_LASTCALL(1:IMICRO)=ZTIME(1:IMICRO)
- ENDIF
- DO JL=1, IMICRO
- IF (ZTIME(JL) < PTSTEP) THEN
- LLCOMPUTE(JL)=.TRUE. ! Computation (.TRUE.) only for points for which integration time has not reached the timestep
- IITER(JL)=IITER(JL)+1
- ELSE
- LLCOMPUTE(JL)=.FALSE.
- ENDIF
- ENDDO
- LL_ANY_ITER=ANY(IITER(1:IMICRO) < INB_ITER_MAX)
- LLCPZ0RT=.TRUE.
- LSOFT=.FALSE. ! We *really* compute the tendencies
-
- DO WHILE(ANY(LLCOMPUTE(1:IMICRO))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
-!$OMP SIMD
- DO JL=1, IMICRO
- ZSUM2(JL)=SUM(ZVART(JL,IRI:KRR))
- ENDDO
- DO JL=1, IMICRO
- ZDEVIDE=(CST%XCPD + CST%XCPV*ZVART(JL, IRV) + CST%XCL*(ZVART(JL, IRC)+ZVART(JL, IRR)) + CST%XCI*ZSUM2(JL)) * ZEXN(JL)
- ZZT(JL) = ZVART(JL, ITH) * ZEXN(JL)
- ZLSFACT(JL)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
- ZLVFACT(JL)=(CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
- ENDDO
- !
- !*** 4.1 Tendencies computation
- !
- ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
- &KPROMA, IMICRO, &
- &KRR, LSOFT, LLCOMPUTE, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, &
- &ZPRES, ZCF, ZSIGMA_RC, &
- &ZCIT, &
- &ZZT, ZVART, &
- &ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
- &ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
- &ZRCAUTR, ZRCACCR, ZRREVAV, &
- &ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRRACCSS, ZRRACCSG, ZRSACCRG, ZRSMLTG, ZRCMLTSR, &
- &ZRICFRRG, ZRRCFRIG, ZRICFRR, ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, &
- &ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, ZRWETGH, ZRWETGH_MR, ZRGMLTR, &
- &ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
- &ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
- &ZRCBERI, &
- &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
- &ZA, ZB, &
- &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
- &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
-
- ! External tendencies
- IF(GEXT_TEND) THEN
- DO JV=0, KRR
- DO JL=1, IMICRO
- ZA(JL, JV) = ZA(JL, JV) + ZEXTPK(JL, JV)
- ENDDO
- ENDDO
- ENDIF
- !
- !*** 4.2 Integration time
- !
- ! If we can, we shall use these tendencies until the end of the timestep
- DO JL=1, IMICRO
- IF(LLCOMPUTE(JL)) THEN
- ZMAXTIME(JL)=(PTSTEP-ZTIME(JL)) ! Remaining time until the end of the timestep
- ELSE
- ZMAXTIME(JL)=0.
- ENDIF
- ENDDO
-
- !We need to adjust tendencies when temperature reaches 0
- IF(PARAMI%LFEEDBACKT) THEN
- DO JL=1, IMICRO
- !Is ZB(:, ITH) enough to change temperature sign?
- ZX=CST%XTT/ZEXN(JL)
- IF ((ZVART(JL, ITH) - ZX) * (ZVART(JL, ITH) + ZB(JL, ITH) - ZX) < 0.) THEN
- ZMAXTIME(JL)=0.
- ENDIF
- !Can ZA(:, ITH) make temperature change of sign?
- IF (ABS(ZA(JL,ITH)) > 1.E-20 ) THEN
- ZTIME_THRESHOLD=(ZX - ZB(JL, ITH) - ZVART(JL, ITH))/ZA(JL, ITH)
- IF (ZTIME_THRESHOLD > 0.) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
- ENDIF
- ENDIF
- ENDDO
- 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)
- DO JV=1, KRR
- DO JL=1, IMICRO
- IF (ZA(JL, JV) < -1.E-20 .AND. ZVART(JL, JV) > ICED%XRTMIN(JV)) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+ZVART(JL, JV))/ZA(JL, JV))
- ENDIF
- ENDDO
- ENDDO
-
- !We stop when the end of the timestep is reached
- DO JL=1, IMICRO
- IF (ZTIME(JL)+ZMAXTIME(JL) >= PTSTEP) THEN
- LLCOMPUTE(JL)=.FALSE.
- ENDIF
- ENDDO
- !We must recompute tendencies when the end of the sub-timestep is reached
- IF (PARAMI%XTSTEP_TS/=0.) THEN
- DO JL=1, IMICRO
- IF ((IITER(JL) < INB_ITER_MAX) .AND. (ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
- ZMAXTIME(JL)=ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP
- LLCOMPUTE(JL)=.FALSE.
- ENDIF
- ENDDO
- 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 (PARAMI%XMRSTEP/=0.) THEN
- IF (LL_ANY_ITER) THEN
- ! In this case we need to remember the initial mixing ratios used to compute the tendencies
- ! because when mixing ratio has evolved more than a threshold, we must re-compute tendencies
- ! Thus, at first iteration (ie when LLCPZ0RT=.TRUE.) we copy ZVART into Z0RT
- DO JV=1,KRR
- IF (LLCPZ0RT) Z0RT(1:IMICRO, JV)=ZVART(1:IMICRO, JV)
- DO JL=1, IMICRO
- IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
- ZTIME_THRESHOLD1D(JL)=(SIGN(1., ZA(JL, JV))*PARAMI%XMRSTEP+ &
- &Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
- ELSE
- ZTIME_THRESHOLD1D(JL)=-1.
- ENDIF
- ENDDO
- DO JL=1, IMICRO
- IF (ZTIME_THRESHOLD1D(JL)>=0 .AND. ZTIME_THRESHOLD1D(JL)<ZMAXTIME(JL) .AND. &
- &(ZVART(JL, JV)>ICED%XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD1D(JL))
- LLCOMPUTE(JL)=.FALSE.
- ENDIF
- ENDDO
- ENDDO
- LLCPZ0RT=.FALSE.
-!$OMP SIMD
- DO JL=1,IMICRO
- ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
- ENDDO
- DO JL=1, IMICRO
- IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>PARAMI%XMRSTEP) THEN
- ZMAXTIME(JL)=0.
- LLCOMPUTE(JL)=.FALSE.
- ENDIF
- ENDDO
- ENDIF ! LL_ANY_ITER
- ENDIF ! XMRSTEP/=0.
- !
- !*** 4.3 New values of variables for next iteration
- !
- DO JV=0, KRR
- DO JL=1, IMICRO
- ZVART(JL, JV)=ZVART(JL, JV)+ZA(JL, JV)*ZMAXTIME(JL)+ZB(JL, JV)
- ENDDO
- ENDDO
- DO JL=1, IMICRO
-#ifdef REPRO55
- ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZVART(JL,IRI)))
-#else
- IF (ZVART(JL,IRI)<=0.) ZCIT(JL) = 0.
-#endif
- ZTIME(JL)=ZTIME(JL)+ZMAXTIME(JL)
- ENDDO
-
- !
- !*** 4.4 Mixing ratio change due to each process
- !
- IF(BUCONF%LBU_ENABLE) THEN
- DO JL=1, IMICRO
- ZTOT_RVHENI (JMICRO+JL-1)=ZTOT_RVHENI (JMICRO+JL-1)+ZRVHENI_MR(JL)
- ZTOT_RCHONI (JMICRO+JL-1)=ZTOT_RCHONI (JMICRO+JL-1)+ZRCHONI (JL)*ZMAXTIME(JL)
- ZTOT_RRHONG (JMICRO+JL-1)=ZTOT_RRHONG (JMICRO+JL-1)+ZRRHONG_MR(JL)
- ZTOT_RVDEPS (JMICRO+JL-1)=ZTOT_RVDEPS (JMICRO+JL-1)+ZRVDEPS (JL)*ZMAXTIME(JL)
- ZTOT_RIAGGS (JMICRO+JL-1)=ZTOT_RIAGGS (JMICRO+JL-1)+ZRIAGGS (JL)*ZMAXTIME(JL)
- ZTOT_RIAUTS (JMICRO+JL-1)=ZTOT_RIAUTS (JMICRO+JL-1)+ZRIAUTS (JL)*ZMAXTIME(JL)
- ZTOT_RVDEPG (JMICRO+JL-1)=ZTOT_RVDEPG (JMICRO+JL-1)+ZRVDEPG (JL)*ZMAXTIME(JL)
- ZTOT_RCAUTR (JMICRO+JL-1)=ZTOT_RCAUTR (JMICRO+JL-1)+ZRCAUTR (JL)*ZMAXTIME(JL)
- ZTOT_RCACCR (JMICRO+JL-1)=ZTOT_RCACCR (JMICRO+JL-1)+ZRCACCR (JL)*ZMAXTIME(JL)
- ZTOT_RREVAV (JMICRO+JL-1)=ZTOT_RREVAV (JMICRO+JL-1)+ZRREVAV (JL)*ZMAXTIME(JL)
- ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS (JL)*ZMAXTIME(JL)
- ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG (JL)*ZMAXTIME(JL)
- ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG (JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
- ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS (JL)*ZMAXTIME(JL)
- ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG (JL)*ZMAXTIME(JL)
- ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG (JL)*ZMAXTIME(JL)
- ZTOT_RSMLTG (JMICRO+JL-1)=ZTOT_RSMLTG (JMICRO+JL-1)+ZRSMLTG (JL)*ZMAXTIME(JL)
- ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR (JL)*ZMAXTIME(JL)
- ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG (JL)*ZMAXTIME(JL)
- ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG (JL)*ZMAXTIME(JL)
- ZTOT_RICFRR (JMICRO+JL-1)=ZTOT_RICFRR (JMICRO+JL-1)+ZRICFRR (JL)*ZMAXTIME(JL)
- ZTOT_RCWETG (JMICRO+JL-1)=ZTOT_RCWETG (JMICRO+JL-1)+ZRCWETG (JL)*ZMAXTIME(JL)
- ZTOT_RIWETG (JMICRO+JL-1)=ZTOT_RIWETG (JMICRO+JL-1)+ZRIWETG (JL)*ZMAXTIME(JL)
- ZTOT_RRWETG (JMICRO+JL-1)=ZTOT_RRWETG (JMICRO+JL-1)+ZRRWETG (JL)*ZMAXTIME(JL)
- ZTOT_RSWETG (JMICRO+JL-1)=ZTOT_RSWETG (JMICRO+JL-1)+ZRSWETG (JL)*ZMAXTIME(JL)
- ZTOT_RWETGH (JMICRO+JL-1)=ZTOT_RWETGH (JMICRO+JL-1)+ZRWETGH (JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
- ZTOT_RCDRYG (JMICRO+JL-1)=ZTOT_RCDRYG (JMICRO+JL-1)+ZRCDRYG (JL)*ZMAXTIME(JL)
- ZTOT_RIDRYG (JMICRO+JL-1)=ZTOT_RIDRYG (JMICRO+JL-1)+ZRIDRYG (JL)*ZMAXTIME(JL)
- ZTOT_RRDRYG (JMICRO+JL-1)=ZTOT_RRDRYG (JMICRO+JL-1)+ZRRDRYG (JL)*ZMAXTIME(JL)
- ZTOT_RSDRYG (JMICRO+JL-1)=ZTOT_RSDRYG (JMICRO+JL-1)+ZRSDRYG (JL)*ZMAXTIME(JL)
- ZTOT_RGMLTR (JMICRO+JL-1)=ZTOT_RGMLTR (JMICRO+JL-1)+ZRGMLTR (JL)*ZMAXTIME(JL)
- ZTOT_RCWETH (JMICRO+JL-1)=ZTOT_RCWETH (JMICRO+JL-1)+ZRCWETH (JL)*ZMAXTIME(JL)
- ZTOT_RIWETH (JMICRO+JL-1)=ZTOT_RIWETH (JMICRO+JL-1)+ZRIWETH (JL)*ZMAXTIME(JL)
- ZTOT_RSWETH (JMICRO+JL-1)=ZTOT_RSWETH (JMICRO+JL-1)+ZRSWETH (JL)*ZMAXTIME(JL)
- ZTOT_RGWETH (JMICRO+JL-1)=ZTOT_RGWETH (JMICRO+JL-1)+ZRGWETH (JL)*ZMAXTIME(JL)
- ZTOT_RRWETH (JMICRO+JL-1)=ZTOT_RRWETH (JMICRO+JL-1)+ZRRWETH (JL)*ZMAXTIME(JL)
- ZTOT_RCDRYH (JMICRO+JL-1)=ZTOT_RCDRYH (JMICRO+JL-1)+ZRCDRYH (JL)*ZMAXTIME(JL)
- ZTOT_RIDRYH (JMICRO+JL-1)=ZTOT_RIDRYH (JMICRO+JL-1)+ZRIDRYH (JL)*ZMAXTIME(JL)
- ZTOT_RSDRYH (JMICRO+JL-1)=ZTOT_RSDRYH (JMICRO+JL-1)+ZRSDRYH (JL)*ZMAXTIME(JL)
- ZTOT_RRDRYH (JMICRO+JL-1)=ZTOT_RRDRYH (JMICRO+JL-1)+ZRRDRYH (JL)*ZMAXTIME(JL)
- ZTOT_RGDRYH (JMICRO+JL-1)=ZTOT_RGDRYH (JMICRO+JL-1)+ZRGDRYH (JL)*ZMAXTIME(JL)
- ZTOT_RDRYHG (JMICRO+JL-1)=ZTOT_RDRYHG (JMICRO+JL-1)+ZRDRYHG (JL)*ZMAXTIME(JL)
- ZTOT_RHMLTR (JMICRO+JL-1)=ZTOT_RHMLTR (JMICRO+JL-1)+ZRHMLTR (JL)*ZMAXTIME(JL)
- ZTOT_RIMLTC (JMICRO+JL-1)=ZTOT_RIMLTC (JMICRO+JL-1)+ZRIMLTC_MR(JL)
- ZTOT_RCBERI (JMICRO+JL-1)=ZTOT_RCBERI (JMICRO+JL-1)+ZRCBERI (JL)*ZMAXTIME(JL)
- ENDDO
- ENDIF
- !
- !*** 4.5 Next loop
- !
- LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
- ENDDO
- ENDDO
-
- IF(GEXT_TEND) THEN
- !Z..T variables contain the external tendency, we substract it
- DO JV=0, KRR
- DO JL=1, IMICRO
- ZVART(JL, JV) = ZVART(JL, JV) - ZEXTPK(JL, JV) * PTSTEP
- ENDDO
- ENDDO
- ENDIF
-
-!-------------------------------------------------------------------------------
-!
-!* 5. UNPACKING DIAGNOSTICS
-! ---------------------
-!
- DO JL=1, IMICRO
- ZCITOUT (I1(JL),I2(JL))=ZCIT (JL)
- IF(PARAMI%LWARM) THEN
- PEVAP3D(I1(JL),I2(JL))=ZRREVAV(JL)
- ENDIF
- ZWR(I1(JL),I2(JL),IRV)=ZVART(JL, IRV)
- ZWR(I1(JL),I2(JL),IRC)=ZVART(JL, IRC)
- ZWR(I1(JL),I2(JL),IRR)=ZVART(JL, IRR)
- ZWR(I1(JL),I2(JL),IRI)=ZVART(JL, IRI)
- ZWR(I1(JL),I2(JL),IRS)=ZVART(JL, IRS)
- ZWR(I1(JL),I2(JL),IRG)=ZVART(JL, IRG)
- IF (KRR==7) THEN
- ZWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
- ENDIF
- ENDDO
-
- ENDDO ! JMICRO
-ENDIF ! KSIZE > 0
-PCIT(:,:)=ZCITOUT(:,:)
-
-!==========================================================================================================
-
-
-!
-!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
-! ----------------------------------------------------------------
+!* 4. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
+! -----------------------------------------------------------------
!
+!The nucelation must be call everywhere
+!This call is for points outside of the LLMICR mask, another call is coded in ice4_tendencies
LLW3D(:,:)=.FALSE.
DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
- IF (.NOT. ODMICRO(JIJ, JK)) THEN
+ IF (.NOT. LLMICRO(JIJ, JK)) THEN
LLW3D(JIJ, JK)=.TRUE.
ZW3D(JIJ, JK)=ZZ_LSFACT(JIJ, JK)/PEXN(JIJ, JK)
+#ifdef REPRO55
+#else
+ PCIT(JIJ,JK)=0. !ri=0 because where are in the not odmicro case
+#endif
+
ELSE
LLW3D(JIJ, JK)=.FALSE.
ENDIF
@@ -1137,15 +440,59 @@ CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, D%NIJT*D%NKT, LLW3D(:,:), &
PTHT(:, :), PPABST(:, :), PRHODREF(:, :), &
PEXN(:, :), ZW3D(:, :), ZT(:, :), &
PRVT(:, :), &
- PCIT(:, :), ZZ_RVHENI_MR(:, :))
+ PCIT(:, :), ZZ_RVHENI(:, :))
+DO JK = IKTB, IKTE
+ DO JIJ=IIJB, IIJE
+ ZZ_RVHENI(JIJ,JK) = MIN(PRVS(JIJ,JK), ZZ_RVHENI(JIJ,JK)/PTSTEP)
+ ENDDO
+ENDDO
+!
+!
+!* 5. TENDENCIES COMPUTATION
+! ----------------------
+!
+IF(PARAMI%LPACK_MICRO) THEN
+ ISIZE=COUNT(LLMICRO) ! Number of points with active microphysics
+ !KPROMA is the requested size for cache_blocking loop
+ !IPROMA is the effective size
+ !This parameter must be computed here because it is used for array dimensioning in ice4_pack
+ IF (KPROMA > 0 .AND. ISIZE > 0) THEN
+ ! Cache-blocking is active
+ ! number of chunks :
+ IGPBLKS = (ISIZE-1)/MIN(KPROMA,ISIZE)+1
+ ! Adjust IPROMA to limit the number of small chunks
+ IPROMA=(ISIZE-1)/IGPBLKS+1
+ ELSE
+ IPROMA=ISIZE ! no cache-blocking
+ ENDIF
+ ISIZE2=IPROMA
+ELSE
+ ISIZE=D%NIJT*D%NKT
+ IPROMA=0
+ ISIZE2=ISIZE
+ENDIF
+!This part is put in another routine to separate pack/unpack operations from computations
+CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ IPROMA, ISIZE, ISIZE2, &
+ HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ PTSTEP, KRR, LLMICRO, PEXN, &
+ PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PEVAP3D, &
+ PRAINFR, PSIGS, &
+ ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, &
+ ZWR, &
+ TBUDGETS, KBUDGETS, &
+ PRHS )
!
!-------------------------------------------------------------------------------
!
-!* 7. TOTAL TENDENCIES
+!* 6. TOTAL TENDENCIES
! ----------------
!
!
-!*** 7.1 total tendencies limited by available species
+!*** 6.1 total tendencies limited by available species
!
DO JK = IKTB, IKTE
DO CONCURRENT (JIJ=IIJB:IIJE)
@@ -1153,10 +500,7 @@ DO JK = IKTB, IKTE
ZZ_LSFACT(JIJ,JK)=ZZ_LSFACT(JIJ,JK)/PEXNREF(JIJ,JK)
ZZ_LVFACT(JIJ,JK)=ZZ_LVFACT(JIJ,JK)/PEXNREF(JIJ,JK)
- !Tendency dure to nucleation on non ODMICRO points
- ZZ_RVHENI(JIJ,JK) = MIN(PRVS(JIJ,JK), ZZ_RVHENI_MR(JIJ,JK)/PTSTEP)
-
- !Hydrometeor tendencies is the difference between old state and new state (can be negative)
+ !Hydrometeor tendencies is the difference between new state and old state (can be negative)
ZWR(JIJ,JK,IRV)=(ZWR(JIJ,JK,IRV)-PRVT(JIJ,JK))*ZINV_TSTEP
ZWR(JIJ,JK,IRC)=(ZWR(JIJ,JK,IRC)-PRCT(JIJ,JK))*ZINV_TSTEP
ZWR(JIJ,JK,IRR)=(ZWR(JIJ,JK,IRR)-PRRT(JIJ,JK))*ZINV_TSTEP
@@ -1186,371 +530,20 @@ DO JK = IKTB, IKTE
ENDIF
ENDDO
ENDDO
-
-!
-!*** 7.2 LBU_ENABLE case
+!-------------------------------------------------------------------------------
!
-IF(BUCONF%LBU_ENABLE) THEN
- IF (BUCONF%LBUDGET_TH) THEN
- ZZ_DIFF(:,:)=0.
- DO JK = IKTB, IKTE
- DO JIJ = IIJB, IIJE
- ZZ_DIFF(JIJ, JK) = ZZ_LSFACT(JIJ, JK) - ZZ_LVFACT(JIJ, JK)
- ENDDO
- ENDDO
- END IF
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
- END DO
- DO JK = IKTB, IKTE
- DO JIJ = IIJB, IIJE
- ZW(JIJ,JK)=ZW(JIJ,JK)+ZZ_RVHENI(JIJ,JK)
- ENDDO
- ENDDO
-#ifdef REPRO48
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HENU', ZW(:, :) *PRHODJ(:, :))
-#else
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIN', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIN', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIN', ZW(:, :) *PRHODJ(:, :))
-#endif
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HON', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HON', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HON', ZW(:, :) *PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'SFR', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'SFR', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'SFR', ZW(:, :) *PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ZW(:, :) *PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', ZW(:, :)*PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AUTS', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AUTS', ZW(:, :)*PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ZW(:, :) *PRHODJ(:, :))
-
- IF(PARAMI%LWARM) THEN
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', ZW(:, :)*PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', ZW(:, :)*PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', -ZW(:, :)*ZZ_LVFACT(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', -ZW(:, :) *PRHODJ(:, :))
- ENDIF
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', ZW(:, :)*PRHODJ(:, :))
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CMEL', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CMEL', ZW(:, :)*PRHODJ(:, :))
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :)+ZW2(:, :))*PRHODJ(:, :))
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
- END DO
- ZW4(:,:) = 0.
- DO JL=1, KSIZE
- ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', -ZW1(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', -ZW2(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', -ZW3(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', -ZW4(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
- & *PRHODJ(:, :))
-
- IF(KRR==7) THEN
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GHCV', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'GHCV', ZW(:, :)*PRHODJ(:, :))
- END IF
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
- END DO
- ZW4(:,:) = 0.
- DO JL=1, KSIZE
- ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', -ZW1(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', -ZW2(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', -ZW3(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', -ZW4(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
- & *PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ZW(:, :) *PRHODJ(:, :))
-
- IF(KRR==7) THEN
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
- END DO
- ZW4(:,:) = 0.
- DO JL=1, KSIZE
- ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
- END DO
- ZW5(:,:) = 0.
- DO JL=1, KSIZE
- ZW5(I1TOT(JL), I2TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :) *PRHODJ(:, :))
-#ifdef REPRO48
-#else
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :) *PRHODJ(:, :))
-#endif
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
- &ZW4(:, :)+ZW5(:, : )) *PRHODJ(:, :))
-
-#if defined(REPRO48) || defined(REPRO55)
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
- END DO
-#endif
-#ifdef REPRO48
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :)-ZW(:, :))*PRHODJ(:, :))
-#endif
-#ifdef REPRO55
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :)*PRHODJ(:, :))
-#endif
-#if defined(REPRO48) || defined(REPRO55)
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :)*PRHODJ(:, :))
-#endif
-
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
- END DO
- ZW2(:,:) = 0.
- DO JL=1, KSIZE
- ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
- END DO
- ZW3(:,:) = 0.
- DO JL=1, KSIZE
- ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
- END DO
- ZW4(:,:) = 0.
- DO JL=1, KSIZE
- ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
- END DO
- ZW5(:,:) = 0.
- DO JL=1, KSIZE
- ZW5(I1TOT(JL), I2TOT(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
- END DO
- ZW6(:,:) = 0.
-#if defined(REPRO48) || defined(REPRO55)
- !ZW6 must be removed when REPRO* will be suppressed
- DO JL=1, KSIZE
- ZW6(I1TOT(JL), I2TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
- END DO
-#endif
- IF (BUCONF%LBUDGET_TH) &
- CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :)+ZW6(:, :)) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
- &ZW4(:, :)+ZW5(:, :)-ZW6(:, :)) &
- & *PRHODJ(:, :))
-
-#if defined(REPRO48) || defined(REPRO55)
-#else
- !When REPRO48 will be suppressed, ZW6 must be removed
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :)*PRHODJ(:, :))
-#endif
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ZW(:, :) *PRHODJ(:, :))
- ENDIF
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ZW(:, :) *PRHODJ(:, :))
-
- ZW(:,:) = 0.
- DO JL=1, KSIZE
- ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
- END DO
- IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', -ZW(:, :) *PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', ZW(:, :) *PRHODJ(:, :))
-
-ENDIF
+!*** 6.2 Negative corrections
!
-!*** 7.3 Final tendencies
+!NOTE:
+! This call cannot be moved before the preeceding budget calls because,
+! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
+! once before the physics call and copies of the S variables evolve automatically
+! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
+! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
+! of the S variables and the S variables used in the folowing BUDGET_STORE_END
+! call must only be due to the correction of negativities.
!
-IF (BUCONF%LBU_ENABLE) THEN
+IF(BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :)*PRHODJ(:, :))
@@ -1561,19 +554,10 @@ IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :)*PRHODJ(:, :))
END IF
-!NOTE:
-! This call cannot be moved before the preeceding budget calls because,
-! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
-! once before the physics call and copies of the S variables evolve automatically
-! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
-! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
-! of the S variables and the S variables used in the folowing BUDGET_STORE_END
-! call must only be due to the correction of negativities.
-!
!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
- &PRIS, PRSS, PRGS, &
- &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
@@ -1588,122 +572,42 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
+!* 7. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
IF(PARAMI%LSEDIM_AFTER) THEN
- !
- !* 8.1 sedimentation
- !
- IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
-
- IF(PARAMI%CSEDIM=='STAT') THEN
- IF (KRR==7) THEN
- DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
- ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
- ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
- ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
- ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
- ZRHT(JIJ,JK)=PRHS(JIJ,JK)*PTSTEP
- ENDDO
- ENDDO
- CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
- &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
- &PRSS, ZRST, PRGS, ZRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- DO JK = IKTB,IKTE
- DO JIJ = IIJB,IIJE
- ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
- ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
- ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
- ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
- ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
- ENDDO
- ENDDO
- CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
- &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
- &PRSS, ZRST, PRGS, ZRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
- !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
- &PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
- &PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
- !We correct negativities with conservation
- !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
- ! It is initialized with the m.r. at T and is modified by two tendencies:
- ! sedimentation tendency and an external tendency which represents all other
- ! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a species at a given sub-timestep. From
- ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
- ! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a species, instead we apply
- ! a correction here.
- CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
- &PRIS, PRSS, PRGS, &
- &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
- ELSE
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
- END IF
- !
- !* 8.2 budget storage
- !
- IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
- IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
+ &PTSTEP, KRR, PDZZ, &
+ &ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
+ &PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRS, PINPRG, &
+ &TBUDGETS, KBUDGETS, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
!"sedimentation" of rain fraction
+ DO JK = IKTB, IKTE
+ DO JIJ=IIJB,IIJE
+ ZWR(JIJ,JK,IRR)=PRRS(JIJ,JK)*PTSTEP
+ ZWR(JIJ,JK,IRS)=PRSS(JIJ,JK)*PTSTEP
+ ZWR(JIJ,JK,IRG)=PRGS(JIJ,JK)*PTSTEP
+ IF(KRR==7) THEN
+ ZWR(JIJ,JK,IRH)=PRHS(JIJ,JK)*PTSTEP
+ ENDIF
+ ENDDO
+ ENDDO
IF (PRESENT(PRHS)) THEN
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:)*PTSTEP, &
- &PRSS(:,:)*PTSTEP, PRGS(:,:)*PTSTEP, PRHS(:,:)*PTSTEP)
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG), ZWR(:,:,IRH))
ELSE
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:)*PTSTEP, &
- &PRSS(:,:)*PTSTEP, PRGS(:,:)*PTSTEP)
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG))
ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 9. COMPUTE THE FOG DEPOSITION TERM
+!* 8. COMPUTE THE FOG DEPOSITION TERM
! -------------------------------------
!
IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation
@@ -1724,103 +628,4 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
-CONTAINS
- !
- SUBROUTINE CORRECT_NEGATIVITIES(D, KRR, PRV, PRC, PRR, &
- &PRI, PRS, PRG, &
- &PTH, PLVFACT, PLSFACT, PRH)
- !
- IMPLICIT NONE
- !
- TYPE(DIMPHYEX_t), INTENT(IN) :: D
- INTEGER, INTENT(IN) :: KRR
- REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
- !
- REAL :: ZW
- INTEGER :: JIJ, JK
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
- !
- !We correct negativities with conservation
- DO JK = IKTB, IKTE
- DO JIJ = IIJB, IIJE
- ! 1) deal with negative values for mixing ratio, except for vapor
- ZW =PRC(JIJ,JK)-MAX(PRC(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
- PRC(JIJ,JK)=PRC(JIJ,JK)-ZW
-
- ZW =PRR(JIJ,JK)-MAX(PRR(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
- PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
-
- ZW =PRI(JIJ,JK)-MAX(PRI(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- PRI(JIJ,JK)=PRI(JIJ,JK)-ZW
-
- ZW =PRS(JIJ,JK)-MAX(PRS(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
-
- ZW =PRG(JIJ,JK)-MAX(PRG(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
-
- IF(KRR==7) THEN
- ZW =PRH(JIJ,JK)-MAX(PRH(JIJ,JK), 0.)
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
- ENDIF
-
- ! 2) deal with negative vapor mixing ratio
-
- ! for rc and ri, we keep ice fraction constant
- ZW=MIN(1., MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.) / &
- &MAX(PRC(JIJ,JK)+PRI(JIJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW* &
- &(PRC(JIJ,JK)*PLVFACT(JIJ,JK)+PRI(JIJ,JK)*PLSFACT(JIJ,JK))
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW*(PRC(JIJ,JK)+PRI(JIJ,JK))
- PRC(JIJ,JK)=(1.-ZW)*PRC(JIJ,JK)
- PRI(JIJ,JK)=(1.-ZW)*PRI(JIJ,JK)
-
- ZW=MIN(MAX(PRR(JIJ,JK), 0.), &
- &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rr to convert into rv
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
-
- ZW=MIN(MAX(PRS(JIJ,JK), 0.), &
- &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rs to convert into rv
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
-
- ZW=MIN(MAX(PRG(JIJ,JK), 0.), &
- &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rg to convert into rv
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
-
- IF(KRR==7) THEN
- ZW=MIN(MAX(PRH(JIJ,JK), 0.), &
- &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rh to convert into rv
- PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
- PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
- PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- ENDIF
- ENDDO
- ENDDO
- !
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
- !
- END SUBROUTINE CORRECT_NEGATIVITIES
-!
END SUBROUTINE RAIN_ICE
diff --git a/src/PHYEX/turb/mode_turb_ver.f90 b/src/PHYEX/turb/mode_turb_ver.f90
index 9cc0ef405d29fc3304612ef0d308c516265045ef..b014aa191d35db68f45b60b86ade811c2159ec3e 100644
--- a/src/PHYEX/turb/mode_turb_ver.f90
+++ b/src/PHYEX/turb/mode_turb_ver.f90
@@ -10,7 +10,7 @@ SUBROUTINE TURB_VER(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,KGRADIENTS,&
OOCEAN,ODEEPOC,OCOMPUTE_SRC, &
KSV,KSV_LGBEG,KSV_LGEND, &
PEXPL, HPROGRAM, O2D, ONOMIXLG, OFLAT, &
- OCOUPLES,OBLOWSNOW,PRSNOW, &
+ OCOUPLES,OBLOWSNOW,OFLYER,PRSNOW, &
PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
@@ -253,6 +253,7 @@ INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of scalar variables
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLYER ! MesoNH flyer diagnostic
LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
@@ -503,7 +504,7 @@ ENDIF
!
CALL TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
KRR,KRRL,KRRI,KSV,KGRADIENTS, &
- OOCEAN,ODEEPOC, &
+ OOCEAN,ODEEPOC,OFLYER, &
OCOUPLES,OCOMPUTE_SRC, &
PEXPL,PTSTEP,HPROGRAM,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
@@ -576,7 +577,7 @@ IF (TURBN%LHARAT) ZLM(:,:)=PLENGTHH(:,:)
IF (KSV>0) &
CALL TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
KSV,KSV_LGBEG,KSV_LGEND, &
- OBLOWSNOW, &
+ OBLOWSNOW,OFLYER, &
PEXPL,PTSTEP,TPFILE,PRSNOW, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90 b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
index dc1ad272ad4b53b52f7f50c015527e05db19662c..09d51b09c9b107d184a2c192d057c3043afd55fe 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
@@ -8,7 +8,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
KSV,KSV_LGBEG,KSV_LGEND, &
- OBLOWSNOW, &
+ OBLOWSNOW,OFLYER, &
PEXPL,PTSTEP,TPFILE,PRSNOW, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
@@ -213,14 +213,12 @@ USE PARKIND1, ONLY: JPRB
USE SHUMAN_PHY, ONLY: DZM_PHY, MZM_PHY, MZF_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
-USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
-USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, NMNHNAMELGTMAX
USE MODD_TURB_n, ONLY: TURB_t
!
@@ -248,6 +246,7 @@ INTEGER, INTENT(IN) :: KSV, &
KSV_LGBEG, KSV_LGEND ! number of scalar variables
LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+LOGICAL, INTENT(IN) :: OFLYER ! MesoNH flyer diagnostic
REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! Double Time Step
@@ -433,7 +432,7 @@ DO JSV=1,KSV
ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- IF ( LFLYER ) THEN
+ IF ( OFLYER ) THEN
DO JK=IKTB+1,IKTE-1
!$mnh_expand_array(JIJ=IIJB:IIJE)
PWSV(IIJB:IIJE,JK,JSV)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL))
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
index 6e1935f3e560aeead72b1474e76b743e8e9d1694..618fb377a19214004ad7dcd906efc3e6fbad40b5 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
@@ -8,7 +8,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
KRR,KRRL,KRRI,KSV,KGRADIENTS, &
- OOCEAN,ODEEPOC, &
+ OOCEAN,ODEEPOC,OFLYER, &
OCOUPLES, OCOMPUTE_SRC, &
PEXPL,PTSTEP,HPROGRAM, &
TPFILE, &
@@ -233,7 +233,6 @@ USE PARKIND1, ONLY: JPRB
USE SHUMAN_PHY, ONLY: DZF_PHY, DZM_PHY, MXF_PHY, MYF_PHY, MZF_PHY, MZM_PHY
USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
-USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -270,6 +269,7 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar var.
INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLYER ! MesoNH flyer diagnostic
LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
@@ -663,7 +663,7 @@ ELSE
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
-IF ( LFLYER ) THEN
+IF ( OFLYER ) THEN
PWTH(:,:IKTB) = XUNDEF
PWTH(:,IKTE:) = XUNDEF
!
@@ -1058,7 +1058,7 @@ IF (KRR /= 0) THEN
ZFLXZ(IIJB:IIJE,IKU) = ZFLXZ(IIJB:IIJE,IKE)
END IF
!
- IF ( LFLYER ) THEN
+ IF ( OFLYER ) THEN
DO JK=IKTB+1,IKTE-1
!$mnh_expand_array(JIJ=IIJB:IIJE)
PWRC(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL))
diff --git a/src/PHYEX/turb/modi_turb.f90 b/src/PHYEX/turb/modi_turb.f90
index 3694890aeed0689c5cfd322fe6b39c9dfdb739b5..747f10538154c6456a3824f929eff22814de4330 100644
--- a/src/PHYEX/turb/modi_turb.f90
+++ b/src/PHYEX/turb/modi_turb.f90
@@ -8,7 +8,7 @@ INTERFACE
& KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
& KSPLIT,KMODEL_CL,KSV,KSV_LGBEG,KSV_LGEND,HPROGRAM, &
& KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
- & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM, &
+ & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
& HTURBLEN_CL,HCLOUD, &
@@ -61,6 +61,7 @@ INTEGER, INTENT(IN) :: KHALO ! Size of the halo for par
LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLYER ! MesoNH flyer diagnostic
LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 2a8a60e323301d8d5ffcdb501c46ef57fe56c552..58e0ba1847373e468597bdfa8ed1590f97281dc0 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -7,7 +7,7 @@
& KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
& KSPLIT,KMODEL_CL,KSV,KSV_LGBEG,KSV_LGEND,HPROGRAM, &
& KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
- & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM, &
+ & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
& HTURBLEN_CL,HCLOUD, &
@@ -272,7 +272,7 @@ USE MODE_SOURCES_NEG_CORRECT, ONLY: SOURCES_NEG_CORRECT_PHY
USE MODE_TM06, ONLY: TM06
USE MODE_TKE_EPS_SOURCES, ONLY: TKE_EPS_SOURCES
USE MODE_TURB_HOR_SPLT, ONLY: TURB_HOR_SPLT
-USE MODE_TURB_VER, ONLY : TURB_VER
+USE MODE_TURB_VER, ONLY: TURB_VER
USE MODE_UPDATE_LM, ONLY: UPDATE_LM
!
USE MODI_LES_MEAN_SUBGRID_PHY
@@ -304,6 +304,7 @@ INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud m
LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLYER ! MesoNH flyer diagnostic
LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
@@ -1007,7 +1008,7 @@ CALL TURB_VER(D,CST,CSTURB,TURBN,TLES, &
OOCEAN, ODEEPOC, OCOMPUTE_SRC, &
KSV,KSV_LGBEG,KSV_LGEND, &
ZEXPL,HPROGRAM, O2D, ONOMIXLG, OFLAT, &
- OCOUPLES,OBLOWSNOW, PRSNOW, &
+ OCOUPLES,OBLOWSNOW,OFLYER, PRSNOW, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &