From 970d36f29e223e219ce7a738e68e0fa1ef8a3b47 Mon Sep 17 00:00:00 2001 From: Gaelle DELAUTIER <gaelle.delautier@meteo.fr> Date: Tue, 15 May 2018 14:16:53 +0200 Subject: [PATCH] S.Riette 15/5/2018: splitting of the ICE3/ICE4 routines for LRED=T --- src/MNH/ice4_compute_pdf.f90 | 267 ++++++++ src/MNH/ice4_fast_rg.f90 | 499 ++++++++++++++ src/MNH/ice4_fast_rh.f90 | 505 +++++++++++++++ src/MNH/ice4_fast_ri.f90 | 124 ++++ src/MNH/ice4_fast_rs.f90 | 456 +++++++++++++ src/MNH/ice4_nucleation.f90 | 149 +++++ src/MNH/ice4_nucleation_wrapper.f90 | 135 ++++ src/MNH/ice4_rainfr_vert.f90 | 67 ++ src/MNH/ice4_rimltc.f90 | 101 +++ src/MNH/ice4_rrhong.f90 | 100 +++ src/MNH/ice4_rsrimcg_old.f90 | 129 ++++ src/MNH/ice4_sedimentation_split.f90 | 550 ++++++++++++++++ src/MNH/ice4_sedimentation_split_momentum.f90 | 609 ++++++++++++++++++ src/MNH/ice4_sedimentation_split_old.f90 | 493 ++++++++++++++ src/MNH/ice4_sedimentation_stat.f90 | 464 +++++++++++++ src/MNH/ice4_slow.f90 | 226 +++++++ src/MNH/ice4_tendencies.f90 | 555 ++++++++++++++++ src/MNH/ice4_warm.f90 | 288 +++++++++ 18 files changed, 5717 insertions(+) create mode 100644 src/MNH/ice4_compute_pdf.f90 create mode 100644 src/MNH/ice4_fast_rg.f90 create mode 100644 src/MNH/ice4_fast_rh.f90 create mode 100644 src/MNH/ice4_fast_ri.f90 create mode 100644 src/MNH/ice4_fast_rs.f90 create mode 100644 src/MNH/ice4_nucleation.f90 create mode 100644 src/MNH/ice4_nucleation_wrapper.f90 create mode 100644 src/MNH/ice4_rainfr_vert.f90 create mode 100644 src/MNH/ice4_rimltc.f90 create mode 100644 src/MNH/ice4_rrhong.f90 create mode 100644 src/MNH/ice4_rsrimcg_old.f90 create mode 100644 src/MNH/ice4_sedimentation_split.f90 create mode 100644 src/MNH/ice4_sedimentation_split_momentum.f90 create mode 100644 src/MNH/ice4_sedimentation_split_old.f90 create mode 100644 src/MNH/ice4_sedimentation_stat.f90 create mode 100644 src/MNH/ice4_slow.f90 create mode 100644 src/MNH/ice4_tendencies.f90 create mode 100644 src/MNH/ice4_warm.f90 diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90 new file mode 100644 index 000000000..6b6b836ab --- /dev/null +++ b/src/MNH/ice4_compute_pdf.f90 @@ -0,0 +1,267 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_COMPUTE_PDF +INTERFACE +SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, & + PRHODREF, PRCT, PCF, PSIGMA_RC,& + PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method +CHARACTER*80, INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid + ! note that PCF = PHLC_HCF + PHLC_LCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid + ! note that PRC = PHLC_HRC + PHLC_LRC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction +END SUBROUTINE ICE4_COMPUTE_PDF +END INTERFACE +END MODULE MODI_ICE4_COMPUTE_PDF +SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, & + PRHODREF, PRCT, PCF, PSIGMA_RC,& + PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF) +!! +!!** PURPOSE +!! ------- +!! Computes the pdf used to split cloud into high and low content parts +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +! +USE MODD_RAIN_ICE_DESCR +USE MODD_RAIN_ICE_PARAM +USE MODD_LUNIT_n, ONLY : TLUOUT +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method +CHARACTER*80, INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid + ! note that PCF = PHLC_HCF + PHLC_LCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid + ! note that PRC = PHLC_HRC + PHLC_LRC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(SIZE(PRHODREF)) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF + ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution + ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF + ZHLC_HRCLOCAL !HLCLOUDS : LWC that is High LWC local in HCF + ! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL + ! = PHLC_HRC/HCF+ PHLC_LRC/LCF +REAL :: ZCOEFFRCM +INTEGER :: ILUOUT ! logical unit +!------------------------------------------------------------------------------- +! +ILUOUT = TLUOUT%NLU +!Cloud water split between high and low content part is done according to autoconversion option +ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold +IF(HSUBG_AUCV=='NONE') THEN + !Cloud water is entirely in low or high part + WHERE(PRCT(:)>ZRCRAUTC(:)) + PHLC_HCF(:)=1. + PHLC_LCF(:)=0. + PHLC_HRC(:)=PRCT(:) + PHLC_LRC(:)=0. + PRF(:) =1. + ELSEWHERE(PRCT(:)>XRTMIN(2)) + PHLC_HCF(:)=0. + PHLC_LCF(:)=1. + PHLC_HRC(:)=0. + PHLC_LRC(:)=PRCT(:) + PRF(:) =0. + ELSEWHERE + PHLC_HCF(:)=0. + PHLC_LCF(:)=0. + PHLC_HRC(:)=0. + PHLC_LRC(:)=0. + PRF(:) =0. + END WHERE + +ELSEIF(HSUBG_AUCV=='CLFR') THEN + !Cloud water is only in the cloudy part and entirely in low or high part + WHERE(PCF(:)>0.) + WHERE(PRCT(:)/PCF(:)>ZRCRAUTC(:)) + PHLC_HCF(:)=PCF(:) + PHLC_LCF(:)=0. + PHLC_HRC(:)=PRCT(:) + PHLC_LRC(:)=0. + PRF(:) =PCF(:) + ELSEWHERE(PRCT(:)>XRTMIN(2)) + PHLC_HCF(:)=0. + PHLC_LCF(:)=PCF(:) + PHLC_HRC(:)=0.0 + PHLC_LRC(:)=PRCT(:) + PRF(:) =0. + ELSEWHERE + PHLC_HCF(:)=0. + PHLC_LCF(:)=0. + PHLC_HRC(:)=0. + PHLC_LRC(:)=0. + PRF(:) =0. + END WHERE + ELSEWHERE + PHLC_HCF(:)=0. + PHLC_LCF(:)=0. + PHLC_HRC(:)=0. + PHLC_LRC(:)=0. + PRF(:) =0. + END WHERE + +ELSEIF(HSUBG_AUCV=='PDF ') THEN + !Cloud water is split between high and low part according to a PDF + ! 'HLCRECTPDF' : rectangular PDF form + ! 'HLCTRIANGPDF' : triangular PDF form + ! 'HLCQUADRAPDF' : second order quadratic PDF form + ! 'HLCISOTRIPDF' : isocele triangular PDF + ! 'SIGM' : Redelsperger and Sommeria (1986) + IF(HSUBG_PR_PDF=='SIGM') THEN + ! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012) + WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:)) + PHLC_HCF(:)=1. + PHLC_LCF(:)=0. + PHLC_HRC(:)=PRCT(:) + PHLC_LRC(:)=0. + PRF(:) =1. + ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. & + & PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) ) + PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ & + &(2.*PSIGMA_RC(:)) + PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:)) + PHLC_HRC(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))* & + &(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ & + &(4.*PSIGMA_RC(:)) + PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:)) + PRF(:) =PHLC_HCF(:) + ELSEWHERE(PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.) + PHLC_HCF(:)=0. + PHLC_LCF(:)=PCF(:) + PHLC_HRC(:)=0. + PHLC_LRC(:)=PRCT(:) + PRF(:) =0. + ELSEWHERE + PHLC_HCF(:)=0. + PHLC_LCF(:)=0. + PHLC_HRC(:)=0. + PHLC_LRC(:)=0. + PRF(:) =0. + END WHERE + ! Turner (2011, 2012) + ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. & + &HSUBG_PR_PDF=='HLCTRIANGPDF' .OR. HSUBG_PR_PDF=='HLCQUADRAPDF') THEN + ! Calculate maximum value r_cM from PDF forms + IF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF') THEN + ZCOEFFRCM=2. + ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN + ZCOEFFRCM=3. + ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN + ZCOEFFRCM=4. + END IF + WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0.) + ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:) + END WHERE + ! Split available water and cloud fraction in two parts + ! Calculate local mean values int he low and high parts for the 3 PDF forms: + IF(HSUBG_PR_PDF=='HLCRECTPDF') THEN + WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:)) + ZHLC_LRCLOCAL(:)=0.5*ZRCRAUTC(:) + ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + ZRCRAUTC(:))/2.0 + END WHERE + ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN + WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:)) + ZHLC_LRCLOCAL(:)=( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) & + / (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) ) + ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0 + END WHERE + ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN + WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:)) + ZHLC_LRCLOCAL(:)=(3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) & + + 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) & + / & + (4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) & + + 12.0 * ZHLC_RCMAX(:)**2 ) + ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:))/4.0 + END WHERE + ELSE IF(HSUBG_PR_PDF=='HLCISOTRIPDF') THEN + WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:)) + WHERE((PRCT(:) / PCF(:)).LE.ZRCRAUTC(:)) + ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 & + -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) & + +(8.0 * ZRCRAUTC(:)**3) ) & + /( (6.0 * (ZHLC_RCMAX(:))**2) & + -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) & + +(12.0 * ZRCRAUTC(:)**2) ) + ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0 + ELSEWHERE + ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:) + ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) & + / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2) + END WHERE + END WHERE + END IF + ! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not + WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:)) + ! Calculate final values for LCF and HCF: + PHLC_LCF(:)=PCF(:) & + *(ZHLC_HRCLOCAL- & + (PRCT(:) / PCF(:))) & + / (ZHLC_HRCLOCAL-ZHLC_LRCLOCAL) + PHLC_HCF(:)=MAX(0., PCF(:)-PHLC_LCF(:)) + ! + ! Calculate final values for LRC and HRC: + PHLC_LRC(:)=ZHLC_LRCLOCAL*PHLC_LCF(:) + PHLC_HRC(:)=MAX(0., PRCT(:)-PHLC_LRC(:)) + ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:)) + ! Put all available cloud water and his fraction in the low part + PHLC_LCF(:)=PCF(:) + PHLC_HCF(:)=0. + PHLC_LRC(:)=PRCT(:) + PHLC_HRC(:)=0. + ELSEWHERE + PHLC_LCF(:)=0. + PHLC_HCF(:)=0. + PHLC_LRC(:)=0. + PHLC_HRC(:)=0. + END WHERE + PRF(:)=PHLC_HCF(:) !Precipitation fraction + ELSE + !wrong HSUBG_PR_PDF case + WRITE(ILUOUT,*) 'STOP : wrong HSUBG_PR_PDF case' + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','') + ENDIF +ELSE + !wrong HSUBG_AUCV case + WRITE(ILUOUT,*) 'STOP : wrong HSUBG_AUCV case' + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','') +ENDIF +! +END SUBROUTINE ICE4_COMPUTE_PDF diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90 new file mode 100644 index 000000000..df9d5db0b --- /dev/null +++ b/src/MNH/ice4_fast_rg.f90 @@ -0,0 +1,499 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_FAST_RG +INTERFACE +SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, PCIT, & + &PLBDAR, PLBDAS, PLBDAG, & + &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & + &PRGSI, PRGSI_MR, & + &LDWETG, & + &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, & + &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, & + &PRG_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes +LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH ! Conversion of graupel into hail +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH +END SUBROUTINE ICE4_FAST_RG +END INTERFACE +END MODULE MODI_ICE4_FAST_RG +SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, PCIT, & + &PLBDAR, PLBDAS, PLBDAG, & + &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & + &PRGSI, PRGSI_MR, & + &LDWETG, & + &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, & + &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, & + &PRG_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH) +!! +!!** PURPOSE +!! ------- +!! Computes the fast rg processes +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : LEVLIMIT, LNULLWETG, LWETGPOST, LCRFLIMIT +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes +LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETG ! Graupel wet growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYG ! Graupel dry growth +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH ! Conversion of graupel into hail +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GDRY, LLDRYG, GMASK +INTEGER :: IGDRY +REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3 +INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2 +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, & + ZRDRYG_INIT, & !Initial dry growth rate of the graupeln + ZRWETG_INIT !Initial wet growth rate of the graupeln +INTEGER :: JJ +INTEGER :: IRCDRYG, IRIDRYG, IRIWETG, IRSDRYG, IRSWETG, IRRDRYG +!------------------------------------------------------------------------------- +! +! +IRCDRYG=1 +IRIDRYG=2 +IRIWETG=3 +IRSDRYG=4 +IRSWETG=5 +IRRDRYG=6 +! +!------------------------------------------------------------------------------- +! +!* 6.1 rain contact freezing +! +GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRICFRRG(:)=0. + PRRCFRIG(:)=0. + PRICFRR(:)=0. + ENDWHERE +ELSE + PRICFRRG(:)=0. + PRRCFRIG(:)=0. + PRICFRR(:)=0. + WHERE(GMASK(:)) + PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG + *PLBDAR(:)**XEXICFRR & + *PRHODREF(:)**(-XCEXVT) + PRRCFRIG(:) = XRCFRI*PCIT(:) & ! RRCFRIG + * PLBDAR(:)**XEXRCFRI & + * PRHODREF(:)**(-XCEXVT-1.) + END WHERE + ZZW(:)=1. + IF(LCRFLIMIT) THEN + WHERE(GMASK(:)) + !Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change) + !ZZW is the proportion of process that can take place + ZZW(:) = MAX(0., MIN(1., (PRICFRRG(:)*XCI+PRRCFRIG(:)*XCL)*(XTT-PT(:)) / & + MAX(1.E-20, XLVTT*PRRCFRIG(:)))) + ENDWHERE + ENDIF + PRRCFRIG(:) = ZZW(:) * PRRCFRIG(:) !Part of rain that can be freezed + PRICFRR(:) = (1-ZZW(:)) * PRICFRRG(:) !Part of collected pristine ice converted to rain + PRICFRRG(:) = ZZW(:) * PRICFRRG(:) !Part of collected pristine ice that lead to graupel +ENDIF +PA_RI(:) = PA_RI(:) - PRICFRRG(:) - PRICFRR(:) +PA_RR(:) = PA_RR(:) - PRRCFRIG(:) + PRICFRR(:) +PA_RG(:) = PA_RG(:) + PRICFRRG(:) + PRRCFRIG(:) +PA_TH(:) = PA_TH(:) + (PRRCFRIG(:) - PRICFRR(:))*(PLSFACT(:)-PLVFACT(:)) +! +! +!* 6.3 compute the graupel growth +! +! Wet and dry collection of rc and ri on graupel +GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRG_TEND(:, IRCDRYG)=0. + END WHERE +ELSE + PRG_TEND(:, IRCDRYG)=0. + WHERE(GMASK(:)) + ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT) + PRG_TEND(:, IRCDRYG)=XFCDRYG * PRCT(:) * ZZW(:) + END WHERE +ENDIF +GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRG_TEND(:, IRIDRYG)=0. + PRG_TEND(:, IRIWETG)=0. + END WHERE +ELSE + PRG_TEND(:, IRIDRYG)=0. + PRG_TEND(:, IRIWETG)=0. + WHERE(GMASK(:)) + ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT) + PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:) + PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT))) + END WHERE +ENDIF + +! Wet and dry collection of rs on graupel (6.2.1) +GDRY(:)=PRST(:)>XRTMIN(5) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GDRY(:)) + PRG_TEND(:, IRSDRYG)=0. + PRG_TEND(:, IRSWETG)=0. + END WHERE +ELSE + PRG_TEND(:, IRSDRYG)=0. + PRG_TEND(:, IRSWETG)=0. + IGDRY=COUNT(GDRY(:)) + IF(IGDRY>0)THEN + ! + !* 6.2.3 select the (PLBDAG,PLBDAS) couplet + ! + ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:)) + ZVEC2(1:IGDRY)=PACK(PLBDAS(:), MASK=GDRY(:)) + ! + !* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS + ! in the geometrical set of (Lbda_g,Lbda_s) couplet use to + ! tabulate the SDRYG-kernel + ! + ZVEC1(1:IGDRY)=MAX(1.00001, MIN(FLOAT(NDRYLBDAG)-0.00001, & + XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G)) + IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) ) + ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY)) + ! + ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, & + XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+XDRYINTP2S)) + IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY)) + ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-FLOAT(IVEC2(1:IGDRY)) + ! + !* 6.2.5 perform the bilinear interpolation of the normalized + ! SDRYG-kernel + ! + DO JJ=1, IGDRY + ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + *(ZVEC1(JJ) - 1.0) + END DO + ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY(:), FIELD=0.0) + ! + WHERE(GDRY(:)) + PRG_TEND(:, IRSWETG)=XFSDRYG*ZZW(:) & ! RSDRYG + / XCOLSG & + *(PLBDAS(:)**(XCXS-XBS))*( PLBDAG(:)**XCXG ) & + *(PRHODREF(:)**(-XCEXVT-1.)) & + *( XLBSDRYG1/( PLBDAG(:)**2 ) + & + XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & + XLBSDRYG3/( PLBDAS(:)**2)) + PRG_TEND(:, IRSDRYG)=PRG_TEND(:, IRSWETG)*XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT)) + END WHERE + ENDIF +ENDIF +! +!* 6.2.6 accretion of raindrops on the graupeln +! +GDRY(:)=PRRT(:)>XRTMIN(3) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GDRY(:)) + PRG_TEND(:, IRRDRYG)=0. + END WHERE +ELSE + PRG_TEND(:, IRRDRYG)=0. + IGDRY=COUNT(GDRY(:)) + ! + IF(IGDRY>0) THEN + ! + !* 6.2.8 select the (PLBDAG,PLBDAR) couplet + ! + ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:)) + ZVEC2(1:IGDRY)=PACK(PLBDAR(:), MASK=GDRY(:)) + ! + !* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR + ! in the geometrical set of (Lbda_g,Lbda_r) couplet use to + ! tabulate the RDRYG-kernel + ! + ZVEC1(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, & + XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G)) + IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY)) + ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY)) + ! + ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, & + XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+XDRYINTP2R)) + IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY)) + ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-FLOAT(IVEC2(1:IGDRY)) + ! + !* 6.2.10 perform the bilinear interpolation of the normalized + ! RDRYG-kernel + ! + DO JJ=1, IGDRY + ZVEC3(JJ)= ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + *(ZVEC1(JJ) - 1.0) + END DO + ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY, FIELD=0.) + ! + WHERE(GDRY(:)) + PRG_TEND(:, IRRDRYG) = XFRDRYG*ZZW(:) & ! RRDRYG + *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBRDRYG1/( PLBDAG(:)**2 ) + & + XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + & + XLBRDRYG3/( PLBDAR(:)**2) ) + END WHERE + ENDIF +ENDIF + +ZRDRYG_INIT(:)=PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRIDRYG)+PRG_TEND(:, IRSDRYG)+PRG_TEND(:, IRRDRYG) + +!Freezing rate +ZRWETG_INIT(:)=0. +GMASK(:)=PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) +WHERE(GMASK(:)) + ZRWETG_INIT(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure +END WHERE +IF(LEVLIMIT) THEN + WHERE(GMASK(:)) + ZRWETG_INIT(:)=MIN(ZRWETG_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T)) + END WHERE +ENDIF +WHERE(GMASK(:)) + ZRWETG_INIT(:)=PKA(:)*(XTT-PT(:)) + & + (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) & + *(XESTT-ZRWETG_INIT(:))/(XRV*PT(:)) ) + ZRWETG_INIT(:)=MAX(0., & + (ZRWETG_INIT(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + & + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + & + (PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG) ) * & + (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) ) + !We must agregate, at least, the cold species + ZRWETG_INIT(:)=MAX(ZRWETG_INIT(:), PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG)) +END WHERE + +!Growth mode +LDWETG(:)=GMASK(:) .AND. & + &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))>= & + &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG)) +IF(LNULLWETG) THEN + LDWETG(:)=LDWETG(:) .AND. ZRDRYG_INIT(:)>0. +ELSE + LDWETG(:)=LDWETG(:) .AND. ZRWETG_INIT(:)>0. +ENDIF +IF(.NOT. LWETGPOST) LDWETG(:)=LDWETG(:) .AND. PT(:)<XTT + +LLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. & + &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))<& + &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG)) + +! Part of ZRWETG to be converted into hail +! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or +! as a tendency (PRWETGH) +PRWETGH(:)=0. +PRWETGH_MR(:)=0. +IF(KRR==7) THEN + WHERE(LDWETG(:)) + !assume a linear percent of conversion of produced graupel into hail + PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:)) + PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:)) + END WHERE +ENDIF + +PRCWETG(:)=0. +PRIWETG(:)=0. +PRSWETG(:)=0. +PRRWETG(:)=0. +WHERE(LDWETG(:)) + !Aggregated minus collected + PRRWETG(:)=-(PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG)+PRG_TEND(:, IRCDRYG)-ZRWETG_INIT(:)) + PRCWETG(:)=PRG_TEND(:, IRCDRYG) + PRIWETG(:)=PRG_TEND(:, IRIWETG) + PRSWETG(:)=PRG_TEND(:, IRSWETG) +END WHERE +PRCDRYG(:)=0. +PRIDRYG(:)=0. +PRRDRYG(:)=0. +PRSDRYG(:)=0. +WHERE(LLDRYG(:)) + PRCDRYG(:)=PRG_TEND(:, IRCDRYG) + PRRDRYG(:)=PRG_TEND(:, IRRDRYG) + PRIDRYG(:)=PRG_TEND(:, IRIDRYG) + PRSDRYG(:)=PRG_TEND(:, IRSDRYG) +END WHERE +PA_RC(:) = PA_RC(:) - PRCWETG(:) +PA_RI(:) = PA_RI(:) - PRIWETG(:) +PA_RS(:) = PA_RS(:) - PRSWETG(:) +PA_RG(:) = PA_RG(:) + PRCWETG(:) + PRIWETG(:) + PRSWETG(:) + PRRWETG(:) +PA_RR(:) = PA_RR(:) - PRRWETG(:) +PA_TH(:) = PA_TH(:) + (PRCWETG(:) + PRRWETG(:))*(PLSFACT(:)-PLVFACT(:)) +PA_RG(:) = PA_RG(:) - PRWETGH(:) +PA_RH(:) = PA_RH(:) + PRWETGH(:) +PB_RG(:) = PB_RG(:) - PRWETGH_MR(:) +PB_RH(:) = PB_RH(:) + PRWETGH_MR(:) +PA_RC(:) = PA_RC(:) - PRCDRYG(:) +PA_RI(:) = PA_RI(:) - PRIDRYG(:) +PA_RS(:) = PA_RS(:) - PRSDRYG(:) +PA_RR(:) = PA_RR(:) - PRRDRYG(:) +PA_RG(:) = PA_RG(:) + PRCDRYG(:) + PRIDRYG(:) + PRSDRYG(:) + PRRDRYG(:) +PA_TH(:) = PA_TH(:) + (PRCDRYG(:)+PRRDRYG(:))*(PLSFACT(:)-PLVFACT(:)) + +! +!* 6.5 Melting of the graupeln +! +GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PT(:)>XTT .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRGMLTR(:) = 0. + END WHERE +ELSE + PRGMLTR(:) = 0. + WHERE(GMASK(:)) + PRGMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure + END WHERE + IF(LEVLIMIT) THEN + WHERE(GMASK(:)) + PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T)) + END WHERE + ENDIF + WHERE(GMASK(:)) + PRGMLTR(:) = PKA(:)*(XTT-PT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) & + *(XESTT-PRGMLTR(:))/(XRV*PT(:)) ) + END WHERE + WHERE(GMASK(:)) + ! + ! compute RGMLTR + ! + PRGMLTR(:) = MAX( 0.0,( -PRGMLTR(:) * & + ( X0DEPG* PLBDAG(:)**XEX0DEPG + & + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - & + ( PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRRDRYG) ) * & + ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) + END WHERE +ENDIF +PA_RR(:) = PA_RR(:) + PRGMLTR(:) +PA_RG(:) = PA_RG(:) - PRGMLTR(:) +PA_TH(:) = PA_TH(:) - PRGMLTR(:)*(PLSFACT(:)-PLVFACT(:)) + +! +END SUBROUTINE ICE4_FAST_RG diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90 new file mode 100644 index 000000000..8320cd345 --- /dev/null +++ b/src/MNH/ice4_fast_rh.f90 @@ -0,0 +1,505 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_FAST_RH +INTERFACE +SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, & + &PLBDAS, PLBDAG, PLBDAR, PLBDAH, & + &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, & + &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & + &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, & + &PRH_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones +REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH +END SUBROUTINE ICE4_FAST_RH +END INTERFACE +END MODULE MODI_ICE4_FAST_RH +SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, & + &PLBDAS, PLBDAG, PLBDAR, PLBDAH, & + &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, & + &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & + &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, & + &PRH_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH) +!! +!!** PURPOSE +!! ------- +!! Computes the fast rh process +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : LEVLIMIT, LNULLWETH, LWETHPOST, LCONVHG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones +REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GHAIL, GWET, GMASK, LLWETH, LLDRYH +INTEGER :: IHAIL, IGWET +REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3 +INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2 +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, & + ZRDRYH_INIT, ZRWETH_INIT, & + ZRDRYHG +INTEGER :: JJ +INTEGER :: IRCWETH, IRRWETH, IRIDRYH, IRIWETH, IRSDRYH, IRSWETH, IRGDRYH, IRGWETH +! +!------------------------------------------------------------------------------- +! +IRCWETH=1 +IRRWETH=2 +IRIDRYH=3 +IRIWETH=4 +IRSDRYH=5 +IRSWETH=6 +IRGDRYH=7 +IRGWETH=8 +! +! +! +!* 7.2 compute the Wet and Dry growth of hail +! +GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRH_TEND(:, IRCWETH)=0. + END WHERE +ELSE + PRH_TEND(:, IRCWETH)=0. + WHERE(GMASK(:)) + ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT) + PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH + END WHERE +ENDIF +GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRH_TEND(:, IRIWETH)=0. + PRH_TEND(:, IRIDRYH)=0. + END WHERE +ELSE + PRH_TEND(:, IRIWETH)=0. + PRH_TEND(:, IRIDRYH)=0. + WHERE(GMASK(:)) + ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT) + PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH + PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH + END WHERE +ENDIF + +! +!* 7.2.1 accretion of aggregates on the hailstones +! +GWET(:) = PRHT(:)>XRTMIN(7) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GWET(:)) + PRH_TEND(:, IRSWETH)=0. + PRH_TEND(:, IRSDRYH)=0. + END WHERE +ELSE + PRH_TEND(:, IRSWETH)=0. + PRH_TEND(:, IRSDRYH)=0. + IGWET=COUNT(GWET(:)) + IF(IGWET>0)THEN + ! + !* 7.2.3 select the (PLBDAH,PLBDAS) couplet + ! + ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) ) + ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) ) + ! + !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS + ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to + ! tabulate the SWETH-kernel + ! + ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, & + XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) + IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) ) + ! + ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, & + XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) ) + IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) ) + ! + !* 7.2.5 perform the bilinear interpolation of the normalized + ! SWETH-kernel + ! + DO JJ = 1,IGWET + ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 ) + ! + WHERE(GWET(:)) + PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH + *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBSWETH1/( PLBDAH(:)**2 ) + & + XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & + XLBSWETH3/( PLBDAS(:)**2) ) + PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT))) + END WHERE + ENDIF +ENDIF +! +!* 7.2.6 accretion of graupeln on the hailstones +! +GWET(:) = PRHT(:)>XRTMIN(7) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GWET(:)) + PRH_TEND(:, IRGWETH)=0. + PRH_TEND(:, IRGDRYH)=0. + END WHERE +ELSE + PRH_TEND(:, IRGWETH)=0. + PRH_TEND(:, IRGDRYH)=0. + IGWET=COUNT(GWET(:)) + IF(IGWET>0)THEN + ! + !* 7.2.8 select the (PLBDAH,PLBDAG) couplet + ! + ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) ) + ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) ) + ! + !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG + ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to + ! tabulate the GWETH-kernel + ! + ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, & + XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) + IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) ) + ! + ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, & + XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) ) + IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) ) + ! + !* 7.2.10 perform the bilinear interpolation of the normalized + ! GWETH-kernel + ! + DO JJ = 1,IGWET + ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 ) + ! + WHERE(GWET(:)) + PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH + *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBGWETH1/( PLBDAH(:)**2 ) + & + XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + & + XLBGWETH3/( PLBDAG(:)**2) ) + PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH) + END WHERE + !When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same + WHERE(GWET(:) .AND. .NOT. LDWETG(:)) + PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT))) + END WHERE + END IF +ENDIF +! +!* 7.2.11 accretion of raindrops on the hailstones +! +GWET(:) = PRHT(:)>XRTMIN(7) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GWET(:)) + PRH_TEND(:, IRRWETH)=0. + END WHERE +ELSE + PRH_TEND(:, IRRWETH)=0. + IGWET=COUNT(GWET(:)) + IF(IGWET>0)THEN + ! + !* 7.2.12 select the (PLBDAH,PLBDAR) couplet + ! + ZVEC1(1:IGWET)=PACK(PLBDAH(:), MASK=GWET(:)) + ZVEC2(1:IGWET)=PACK(PLBDAR(:), MASK=GWET(:)) + ! + !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR + ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to + ! tabulate the RWETH-kernel + ! + ZVEC1(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, & + XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H)) + IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET)) + ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-FLOAT(IVEC1(1:IGWET)) + ! + ZVEC2(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAR)-0.00001, & + XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R)) + IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET)) + ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-FLOAT(IVEC2(1:IGWET)) + ! + !* 7.2.14 perform the bilinear interpolation of the normalized + ! RWETH-kernel + ! + DO JJ=1, IGWET + ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + *(ZVEC1(JJ) - 1.0) + END DO + ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGWET), MASK=GWET, FIELD=0.) + ! + WHERE(GWET(:)) + PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH + *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBRWETH1/( PLBDAH(:)**2 ) + & + XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + & + XLBRWETH3/( PLBDAR(:)**2) ) + END WHERE + ENDIF +ENDIF +! +ZRDRYH_INIT(:)=PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRIDRYH)+PRH_TEND(:, IRSDRYH)+PRH_TEND(:, IRRWETH)+PRH_TEND(:, IRGDRYH) +! +!* 7.3 compute the Wet growth of hail +! +GHAIL(:) = PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:) +ZRWETH_INIT(:)=0. +WHERE(GHAIL(:)) + ZRWETH_INIT(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure +END WHERE +IF(LEVLIMIT) THEN + WHERE(GHAIL(:)) + ZRWETH_INIT(:) = MIN(ZRWETH_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T)) + END WHERE +ENDIF +WHERE(GHAIL(:)) + ZRWETH_INIT(:) = PKA(:)*(XTT-PT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) & + *(XESTT-ZRWETH_INIT(:))/(XRV*PT(:)) ) + ! + ! compute RWETH + ! + ZRWETH_INIT(:) = MAX(0., ( ZRWETH_INIT(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + & + X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + & + ( PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH) ) * & + ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) ) + ZRWETH_INIT(:)=MAX(ZRWETH_INIT(:), PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH)) +END WHERE +! +!* 7.4 Select Wet or Dry case +! +!Wet case +LLWETH(:)=GHAIL(:) .AND. MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH)-PRH_TEND(:, IRGDRYH))>= & + & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH)-PRH_TEND(:, IRGWETH)) +IF(LNULLWETH) THEN + LLWETH(:)=LLWETH(:) .AND. ZRDRYH_INIT(:)>0. +ELSE + LLWETH(:)=LLWETH(:) .AND. ZRWETH_INIT(:)>0. +ENDIF +IF(.NOT. LWETHPOST) LLWETH(:)=LLWETH(:) .AND. PT(:)<XTT +LLDRYH(:)=GHAIL(:) .AND. PT(:)<XTT .AND. ZRDRYH_INIT(:)>0. .AND. & + & MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH))< & + & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH)) +! +PRCWETH(:)=0. +PRIWETH(:)=0. +PRSWETH(:)=0. +PRGWETH(:)=0. +PRRWETH(:)=0. +WHERE (LLWETH(:)) + PRCWETH(:) = PRH_TEND(:, IRCWETH) + PRIWETH(:) = PRH_TEND(:, IRIWETH) + PRSWETH(:) = PRH_TEND(:, IRSWETH) + PRGWETH(:) = PRH_TEND(:, IRGWETH) + !Collected minus aggregated + PRRWETH(:) = ZRWETH_INIT(:) - PRH_TEND(:, IRIWETH) - PRH_TEND(:, IRSWETH) - PRH_TEND(:, IRGWETH) - PRH_TEND(:, IRCWETH) +END WHERE + +PRCDRYH(:) = 0. +PRIDRYH(:) = 0. +PRSDRYH(:) = 0. +PRRDRYH(:) = 0. +PRGDRYH(:) = 0. +PRDRYHG(:) = 0. +ZRDRYHG(:)=0. +IF(LCONVHG)THEN + WHERE(LLDRYH(:)) + ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:)) + END WHERE +ENDIF +WHERE(LLDRYH(:)) ! Dry + PRCDRYH(:) = PRH_TEND(:, IRCWETH) + PRIDRYH(:) = PRH_TEND(:, IRIDRYH) + PRSDRYH(:) = PRH_TEND(:, IRSDRYH) + PRRDRYH(:) = PRH_TEND(:, IRRWETH) + PRGDRYH(:) = PRH_TEND(:, IRGDRYH) + PRDRYHG(:) = ZRDRYHG(:) +END WHERE +PA_RC(:) = PA_RC(:) - PRCWETH(:) +PA_RI(:) = PA_RI(:) - PRIWETH(:) +PA_RS(:) = PA_RS(:) - PRSWETH(:) +PA_RG(:) = PA_RG(:) - PRGWETH(:) +PA_RH(:) = PA_RH(:) + PRCWETH(:)+PRIWETH(:)+PRSWETH(:)+PRGWETH(:)+PRRWETH +PA_RR(:) = PA_RR(:) - PRRWETH(:) +PA_TH(:) = PA_TH(:) + (PRRWETH(:)+PRCWETH(:))*(PLSFACT(:)-PLVFACT(:)) +PA_RC(:) = PA_RC(:) - PRCDRYH(:) +PA_RI(:) = PA_RI(:) - PRIDRYH(:) +PA_RS(:) = PA_RS(:) - PRSDRYH(:) +PA_RR(:) = PA_RR(:) - PRRDRYH(:) +PA_RG(:) = PA_RG(:) - PRGDRYH(:) + PRDRYHG(:) +PA_RH(:) = PA_RH(:) + PRCDRYH(:)+PRIDRYH(:)+PRSDRYH(:)+PRRDRYH(:)+PRGDRYH(:) - PRDRYHG(:) +PA_TH(:) = PA_TH(:) + (PRCDRYH(:)+PRRDRYH(:))*(PLSFACT(:)-PLVFACT(:)) +! +!* 7.5 Melting of the hailstones +! +GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PT(:)>XTT .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRHMLTR(:) = 0. + END WHERE +ELSE + PRHMLTR(:) = 0.0 + WHERE(GMASK(:)) + PRHMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure + END WHERE + IF(LEVLIMIT) THEN + WHERE(GMASK(:)) + PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T)) + END WHERE + ENDIF + WHERE(GMASK(:)) + PRHMLTR(:) = PKA(:)*(XTT-PT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) & + *(XESTT-PRHMLTR(:))/(XRV*PT(:)) ) + END WHERE + WHERE(GMASK(:)) + ! + ! compute RHMLTR + ! + PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * & + ( X0DEPH* PLBDAH(:)**XEX0DEPH + & + X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - & + ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* & + ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) + END WHERE +END IF +PA_RR(:) = PA_RR(:) + PRHMLTR(:) +PA_RH(:) = PA_RH(:) - PRHMLTR(:) +PA_TH(:) = PA_TH(:) - PRHMLTR(:)*(PLSFACT(:)-PLVFACT(:)) +! +! +END SUBROUTINE ICE4_FAST_RH diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90 new file mode 100644 index 000000000..7e9814e6b --- /dev/null +++ b/src/MNH/ice4_fast_ri.f90 @@ -0,0 +1,124 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_FAST_RI +INTERFACE +SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, & + &PAI, PCJ, PCIT, & + &PSSI, & + &PRCT, PRIT, & + &PRCBERI, PA_TH, PA_RC, PA_RI) +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODI_BUDGET +USE MODD_BUDGET +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +END SUBROUTINE ICE4_FAST_RI +END INTERFACE +END MODULE MODI_ICE4_FAST_RI +SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, & + &PAI, PCJ, PCIT, & + &PSSI, & + &PRCT, PRIT, & + &PRCBERI, PA_TH, PA_RC, PA_RI) +!! +!!** PURPOSE +!! ------- +!! Computes the fast ri process +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK +! +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- +! +!* 7.2 Bergeron-Findeisen effect: RCBERI +! +GMASK(:)=PSSI(:)>0. .AND. PRCT(:)>XRTMIN(2) .AND. PRIT(:)>XRTMIN(4) .AND. & + &PCIT(:)>0. .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRCBERI(:) = 0. + END WHERE +ELSE + PRCBERI(:) = 0. + WHERE(GMASK(:)) + PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i + PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * & + ( X0DEPI/PRCBERI(:) + X2DEPI*PCJ(:)*PCJ(:)/PRCBERI(:)**(XDI+2.0) ) + END WHERE +ENDIF +PA_RC(:) = PA_RC(:) - PRCBERI(:) +PA_RI(:) = PA_RI(:) + PRCBERI(:) +PA_TH(:) = PA_TH(:) + PRCBERI(:)*(PLSFACT(:)-PLVFACT(:)) +! +! +END SUBROUTINE ICE4_FAST_RI diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90 new file mode 100644 index 000000000..3acf8a4a8 --- /dev/null +++ b/src/MNH/ice4_fast_rs.f90 @@ -0,0 +1,456 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_FAST_RS +INTERFACE +SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, & + &PLBDAR, PLBDAS, & + &PT, PRVT, PRCT, PRRT, PRST, & + &PRIAGGS, & + &PRCRIMSS, PRCRIMSG, PRSRIMCG, & + &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, & + &PRCMLTSR, & + &PRS_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSACCRG ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +END SUBROUTINE ICE4_FAST_RS +END INTERFACE +END MODULE MODI_ICE4_FAST_RS +SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &PDV, PKA, PCJ, & + &PLBDAR, PLBDAS, & + &PT, PRVT, PRCT, PRRT, PRST, & + &PRIAGGS, & + &PRCRIMSS, PRCRIMSG, PRSRIMCG, & + &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, & + &PRCMLTSR, & + &PRS_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG) +!! +!!** PURPOSE +!! ------- +!! Computes the fast rs processes +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : LEVLIMIT, CSNOWRIMING +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSACCRG ! Rain accretion onto the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK +INTEGER :: IGRIM, IGACC +REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3 +INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2 +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE +INTEGER :: JJ +INTEGER :: IRCRIMS, IRCRIMSS, IRSRIMCG, IRRACCS, IRRACCSS, IRSACCRG +!------------------------------------------------------------------------------- +! +! +IRCRIMS=1 +IRCRIMSS=2 +IRSRIMCG=3 +IRRACCS=4 +IRRACCSS=5 +IRSACCRG=6 +! +!------------------------------------------------------------------------------- +! +! +!* 5.0 maximum freezing rate +! +ZFREEZ_RATE(:)=0. +GMASK(:)=PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +WHERE(GMASK(:)) + ZFREEZ_RATE(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure +END WHERE +IF(LEVLIMIT) THEN + WHERE(GMASK(:)) + ZFREEZ_RATE(:)=MIN(ZFREEZ_RATE(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T)) + END WHERE +ENDIF +WHERE(GMASK(:)) + ZFREEZ_RATE(:)=PKA(:)*(XTT-PT(:)) + & + (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) & + *(XESTT-ZFREEZ_RATE(:))/(XRV*PT(:)) ) + ZFREEZ_RATE(:)=MAX(0., & + (ZFREEZ_RATE(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + & + PRIAGGS(:) * & + (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) ) + !We must agregate, at least, the cold species + !And we are only interested by the freezing rate of liquid species + ZFREEZ_RATE(:)=MAX(ZFREEZ_RATE(:)-PRIAGGS(:), 0.) +END WHERE +! +!* 5.1 cloud droplet riming of the aggregates +! +GRIM(:) = PRCT(:)>XRTMIN(2) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +! +! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0) +IF(LDSOFT) THEN + WHERE(.NOT. GRIM(:)) + PRS_TEND(:, IRCRIMS)=0. + PRS_TEND(:, IRCRIMSS)=0. + PRS_TEND(:, IRSRIMCG)=0. + END WHERE +ELSE + PRS_TEND(:, IRCRIMS)=0. + PRS_TEND(:, IRCRIMSS)=0. + PRS_TEND(:, IRSRIMCG)=0. + IGRIM = COUNT(GRIM(:)) + ! + IF(IGRIM>0) THEN + ! + ! 5.1.1 select the PLBDAS + ! + ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) ) + ! + ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical + ! set of Lbda_s used to tabulate some moments of the incomplete + ! gamma function + ! + ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, & + XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) ) + IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) + ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) ) + ! + ! 5.1.3 perform the linear interpolation of the normalized + ! "2+XDS"-moment of the incomplete gamma function + ! + ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 ) + ! + ! 5.1.4 riming of the small sized aggregates + ! + WHERE (GRIM(:)) + PRS_TEND(:, IRCRIMSS) = XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS + * PLBDAS(:)**XEXCRIMSS & + * PRHODREF(:)**(-XCEXVT) + END WHERE + ! + ! 5.1.5 perform the linear interpolation of the normalized + ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) and + ! "XBG"-moment of the incomplete gamma function (XGAMINC_RIM4) + ! + ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 ) + + ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW2(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0) + ! + ! 5.1.6 riming-conversion of the large sized aggregates into graupeln + ! + ! + WHERE(GRIM(:)) + PRS_TEND(:, IRCRIMS)=XCRIMSG * PRCT(:) & ! RCRIMS + * PLBDAS(:)**XEXCRIMSG & + * PRHODREF(:)**(-XCEXVT) + ZZW6(:) = PRS_TEND(:, IRCRIMS) - PRS_TEND(:, IRCRIMSS) ! RCRIMSG + END WHERE + + IF(CSNOWRIMING=='M90 ')THEN + !Murakami 1990 + WHERE(GRIM(:)) + PRS_TEND(:, IRSRIMCG)=XSRIMCG * PLBDAS(:)**XEXSRIMCG*(1.0-ZZW(:)) + PRS_TEND(:, IRSRIMCG)=ZZW6(:)*PRS_TEND(:, IRSRIMCG)/ & + MAX(1.E-20, & + XSRIMCG3*XSRIMCG2*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - & + XSRIMCG3*PRS_TEND(:, IRSRIMCG)) + END WHERE + ELSE + PRS_TEND(:, IRSRIMCG)=0. + END IF + ENDIF +ENDIF +! +GRIM(:) = GRIM(:) .AND. PT(:)<XTT ! More restrictive GRIM mask to be used for riming by negative temperature only +PRCRIMSS(:)=0. +PRCRIMSG(:)=0. +PRSRIMCG(:)=0. +WHERE(GRIM(:)) + PRCRIMSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRCRIMSS)) + ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSS(:)) + ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRCRIMS) - PRCRIMSS(:))) ! proportion we are able to freeze + PRCRIMSG(:) = ZZW(:) * MAX(0., PRS_TEND(:, IRCRIMS) - PRCRIMSS(:)) ! RCRIMSG + ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSG(:)) + PRSRIMCG(:) = ZZW(:) * PRS_TEND(:, IRSRIMCG) +END WHERE +WHERE(PRCRIMSG(:)<=0.) + PRCRIMSG(:)=0. + PRSRIMCG(:)=0. +END WHERE +PA_RC(:) = PA_RC(:) - PRCRIMSS(:) +PA_RS(:) = PA_RS(:) + PRCRIMSS(:) +PA_TH(:) = PA_TH(:) + PRCRIMSS(:)*(PLSFACT(:)-PLVFACT(:)) +PA_RC(:) = PA_RC(:) - PRCRIMSG(:) +PA_RS(:) = PA_RS(:) - PRSRIMCG(:) +PA_RG(:) = PA_RG(:) + PRCRIMSG(:)+PRSRIMCG(:) +PA_TH(:) = PA_TH(:) + PRCRIMSG(:)*(PLSFACT(:)-PLVFACT(:)) +! +!* 5.2 rain accretion onto the aggregates +! +GACC(:) = PRRT(:)>XRTMIN(3) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GACC(:)) + PRS_TEND(:, IRRACCS)=0. + PRS_TEND(:, IRRACCSS)=0. + PRS_TEND(:, IRSACCRG)=0. + END WHERE +ELSE + PRS_TEND(:, IRRACCS)=0. + PRS_TEND(:, IRRACCSS)=0. + PRS_TEND(:, IRSACCRG)=0. + IGACC = COUNT(GACC(:)) + IF(IGACC>0)THEN + ! + ! + ! 5.2.1 select the (PLBDAS,PLBDAR) couplet + ! + ZVEC1(1:IGACC) = PACK( PLBDAS(:),MASK=GACC(:) ) + ZVEC2(1:IGACC) = PACK( PLBDAR(:),MASK=GACC(:) ) + ! + ! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR + ! in the geometrical set of (Lbda_s,Lbda_r) couplet use to + ! tabulate the RACCSS-kernel + ! + ZVEC1(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, & + XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) ) + IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) ) + ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - FLOAT( IVEC1(1:IGACC) ) + ! + ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, & + XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) ) + IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) ) + ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - FLOAT( IVEC2(1:IGACC) ) + ! + ! 5.2.3 perform the bilinear interpolation of the normalized + ! RACCSS-kernel + ! + DO JJ = 1, IGACC + ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 ) + ! + ! 5.2.4 raindrop accretion on the small sized aggregates + ! + WHERE(GACC(:)) + ZZW6(:) = & !! coef of RRACCS + XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBRACCS1/((PLBDAS(:)**2) ) + & + XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & + XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4 + PRS_TEND(:, IRRACCSS) =ZZW(:)*ZZW6(:) + END WHERE + ! + ! 5.2.4b perform the bilinear interpolation of the normalized + ! RACCS-kernel + ! + DO JJ = 1, IGACC + ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & + - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC(:),FIELD=0.0 ) + WHERE(GACC(:)) + PRS_TEND(:, IRRACCS) = ZZW(:)*ZZW6(:) + END WHERE + ! 5.2.5 perform the bilinear interpolation of the normalized + ! SACCRG-kernel + ! + DO JJ = 1, IGACC + ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) & + - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) & + * ZVEC2(JJ) & + - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) & + - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) & + * (ZVEC2(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 ) + ! + ! 5.2.6 raindrop accretion-conversion of the large sized aggregates + ! into graupeln + ! + WHERE(GACC(:)) + PRS_TEND(:, IRSACCRG) = XFSACCRG*ZZW(:)* & ! RSACCRG + ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBSACCR1/((PLBDAR(:)**2) ) + & + XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & + XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:) + END WHERE + ENDIF +ENDIF +! +GACC(:) = GACC(:) .AND. PT(:)<XTT ! More restrictive GACC mask to be used for accretion by negative temperature only +PRRACCSS(:)=0. +PRRACCSG(:)=0. +PRSACCRG(:)=0. +WHERE(GACC(:)) + PRRACCSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRRACCSS)) + ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSS(:)) + ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRRACCS)-PRRACCSS(:))) ! proportion we are able to freeze + PRRACCSG(:)=ZZW(:) * MAX(0., PRS_TEND(:, IRRACCS)-PRRACCSS(:)) + ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSG(:)) + PRSACCRG(:)=ZZW(:) * PRS_TEND(:, IRSACCRG) +END WHERE +WHERE(PRRACCSG(:)<=0.) + PRRACCSG(:)=0. + PRSACCRG(:)=0. +END WHERE +PA_RR(:) = PA_RR(:) - PRRACCSS(:) +PA_RS(:) = PA_RS(:) + PRRACCSS(:) +PA_TH(:) = PA_TH(:) + PRRACCSS(:)*(PLSFACT(:)-PLVFACT(:)) +PA_RR(:) = PA_RR(:) - PRRACCSG(:) +PA_RS(:) = PA_RS(:) - PRSACCRG(:) +PA_RG(:) = PA_RG(:) + PRRACCSG(:)+PRSACCRG(:) +PA_TH(:) = PA_TH(:) + PRRACCSG(:)*(PLSFACT(:)-PLVFACT(:)) +! +! +!* 5.3 Conversion-Melting of the aggregates +! +GMASK(:)=PRST(:)>XRTMIN(5) .AND. PT(:)>XTT .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRSMLTG(:) = 0. + PRCMLTSR(:) = 0. + END WHERE +ELSE + PRSMLTG(:) = 0. + PRCMLTSR(:) = 0. + WHERE(GMASK(:)) + PRSMLTG(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure + END WHERE + IF(LEVLIMIT) THEN + WHERE(GMASK(:)) + PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T)) + END WHERE + ENDIF + WHERE(GMASK(:)) + PRSMLTG(:) = PKA(:)*(XTT-PT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) & + *(XESTT-PRSMLTG(:))/(XRV*PT(:)) ) + ! + ! compute RSMLT + ! + PRSMLTG(:) = XFSCVMG*MAX( 0.0,( -PRSMLTG(:) * & + ( X0DEPS* PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - & + ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * & + ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) + ! + ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) + ! because the graupeln produced by this process are still icy!!! + ! + ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel + ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting) + ! To insure consistency when crossint T=XTT, rc collected with T>XTT must be transformed in rain. + ! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow + PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged + END WHERE +ENDIF +PA_RS(:) = PA_RS(:) - PRSMLTG(:) +PA_RG(:) = PA_RG(:) + PRSMLTG(:) +PA_RC(:) = PA_RC(:) - PRCMLTSR(:) +PA_RR(:) = PA_RR(:) + PRCMLTSR(:) + +! +END SUBROUTINE ICE4_FAST_RS diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90 new file mode 100644 index 000000000..27636438c --- /dev/null +++ b/src/MNH/ice4_nucleation.f90 @@ -0,0 +1,149 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_NUCLEATION +INTERFACE +SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, & + PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, & + PRVT, & + PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI +END SUBROUTINE ICE4_NUCLEATION +END INTERFACE +END MODULE MODI_ICE4_NUCLEATION +SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, & + PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, & + PRVT, & + PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI) +!! +!!** PURPOSE +!! ------- +!! Computes the nucleation +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN +USE MODD_PARAM_ICE, ONLY : LFEEDBACKT +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(KSIZE) :: ZW ! work array +LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process +REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array + ZUSW, & ! Undersaturation over water + ZSSI ! Supersaturation over ice +!------------------------------------------------------------------------------- +! +! +PRVHENI_MR(:)=0. +IF(.NOT. LDSOFT) THEN + GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. LDCOMPUTE(:) + PRVHENI_MR(:)=0. + ZSSI(:)=0. + ZUSW(:)=0. + ZZW(:)=0. + WHERE(GNEGT(:)) + ZZW(:)=ALOG(PT(:)) + ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w + ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i + END WHERE + WHERE(GNEGT(:)) + ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation + ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / ((XMV/XMD)*ZZW(:)) - 1.0 + ! Supersaturation over ice + ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation + ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0 + ! Supersaturation of saturated water vapor over ice + ! + !* 3.1 compute the heterogeneous nucleation source RVHENI + ! + !* 3.1.1 compute the cloud ice concentration + ! + ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0 + END WHERE + ZZW(:)=0. + WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 ) + ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2) + ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0) + ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), & + XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1) + END WHERE + WHERE(GNEGT(:)) + ZZW(:)=ZZW(:)-PCIT(:) + ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1 + END WHERE + WHERE(GNEGT(:)) + ! + !* 3.1.2 update the r_i and r_v mixing ratios + ! + PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:) + PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:)) + END WHERE + !Limitation due to 0 crossing of temperature + IF(LFEEDBACKT) THEN + ZW(:)=0. + WHERE(GNEGT(:)) + ZW(:)=MIN(PRVHENI_MR(:), & + MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / & + MAX(PRVHENI_MR(:), 1.E-20) + END WHERE + ELSE + ZW(:)=1. + ENDIF + PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:) + PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:)) + ! + PB_RI(:)=PB_RI(:) + PRVHENI_MR(:) + PB_RV(:)=PB_RV(:) - PRVHENI_MR(:) + PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:) +ENDIF +! +END SUBROUTINE ICE4_NUCLEATION diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90 new file mode 100644 index 000000000..0fbbd032a --- /dev/null +++ b/src/MNH/ice4_nucleation_wrapper.f90 @@ -0,0 +1,135 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_NUCLEATION_WRAPPER +INTERFACE +SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT,KKT, LDMASK, & + PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, & + PRVT, & + PCIT, PRVHENI_MR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIT, KJT, KKT +LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation +END SUBROUTINE ICE4_NUCLEATION_WRAPPER +END INTERFACE +END MODULE MODI_ICE4_NUCLEATION_WRAPPER +SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, & + PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, & + PRVT, & + PCIT, PRVHENI_MR) +!! +!!** PURPOSE +!! ------- +!! Computes the nucleation +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST, ONLY : XTT +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIT, KJT, KKT +LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation +! +!* 0.2 declaration of local variables +! +INTEGER :: JL ! and PACK intrinsics +LOGICAL, DIMENSION(SIZE(PRVT,1),SIZE(PRVT,2),SIZE(PRVT,3)) :: GNEGT ! Test where to compute the HEN process +INTEGER :: INEGT +INTEGER, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: I1,I2,I3 ! Used to replace the COUNT +REAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: ZZT, & ! Temperature + ZPRES, & ! Pressure + ZRVT, & ! Water vapor m.r. at t + ZCIT, & ! Pristine ice conc. at t + ZTHT, & ! Theta at t + ZRHODREF, & + ZEXN, & + ZLSFACT, & + ZRVHENI_MR, & + ZB_TH, ZB_RV, ZB_RI +!------------------------------------------------------------------------------- +! +! +! +! optimization by looking for locations where +! the temperature is negative only !!! +! +GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK +INEGT=0 +IF(COUNT(GNEGT)/=0) INEGT=ICE4_NUCLEATION_COUNTJV(GNEGT(:,:,:), KIT, KJT, KKT, SIZE(I1), I1(:), I2(:), I3(:)) +PRVHENI_MR(:,:,:)=0. +IF(INEGT>=1) THEN + DO JL=1, INEGT + ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL)) + ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL)) + ZZT(JL)=PT(I1(JL), I2(JL), I3(JL)) + ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL)) + ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL)) + ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL)) + ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL)) + ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL)) + ENDDO + CALL ICE4_NUCLEATION(INEGT, .FALSE., ZZT(:)<XTT, & + ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, & + ZRVT, & + ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI) + PRVHENI_MR(:,:,:)=UNPACK(ZRVHENI_MR(:), MASK=GNEGT(:,:,:), FIELD=0.0) + PCIT(:,:,:)=UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:)) +END IF +! + +CONTAINS + FUNCTION ICE4_NUCLEATION_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC) + IMPLICIT NONE + INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask + INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1, I2, I3 ! Used to replace the COUNT and PACK + INTEGER :: IC + INTEGER :: JI, JJ, JK + IC=0 + DO JK=1, SIZE(LTAB,3) + DO JJ=1, SIZE(LTAB,2) + DO JI=1, SIZE(LTAB,1) + IF(LTAB(JI,JJ,JK)) THEN + IC=IC+1 + I1(IC)=JI + I2(IC)=JJ + I3(IC)=JK + END IF + END DO + END DO + END DO + END FUNCTION ICE4_NUCLEATION_COUNTJV + ! +END SUBROUTINE ICE4_NUCLEATION_WRAPPER diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90 new file mode 100644 index 000000000..0448e36b0 --- /dev/null +++ b/src/MNH/ice4_rainfr_vert.f90 @@ -0,0 +1,67 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_RAINFR_VERT +INTERFACE +SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PPRFR !Precipitation fraction +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field +END SUBROUTINE ICE4_RAINFR_VERT +END INTERFACE +END MODULE MODI_ICE4_RAINFR_VERT +SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR) +!! +!!** PURPOSE +!! ------- +!! Computes the rain fraction +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PPRFR !Precipitation fraction +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field +! +!* 0.2 declaration of local variables +! +INTEGER :: JI, JJ, JK +! +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- +DO JI = KIB,KIE + DO JJ = KJB, KJE + PPRFR(JI,JJ,KKE)=0. + DO JK=KKE-KKL, KKB, -KKL + IF (PRR(JI,JJ,JK) .GT. XRTMIN(3)) THEN + PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL)) + IF (PPRFR(JI,JJ,JK)==0) THEN + PPRFR(JI,JJ,JK)=1. + END IF + ELSE + PPRFR(JI,JJ,JK)=0. + END IF + END DO + END DO +END DO +! +! +END SUBROUTINE ICE4_RAINFR_VERT diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90 new file mode 100644 index 000000000..50398fb6f --- /dev/null +++ b/src/MNH/ice4_rimltc.f90 @@ -0,0 +1,101 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_RIMLTC +INTERFACE +SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &PT, & + &PTHT, PRIT, & + &PRIMLTC_MR, PB_TH, PB_RC, PB_RI) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI +END SUBROUTINE ICE4_RIMLTC +END INTERFACE +END MODULE MODI_ICE4_RIMLTC +SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &PT, & + &PTHT, PRIT, & + &PRIMLTC_MR, PB_TH, PB_RC, PB_RI) +!! +!!** PURPOSE +!! ------- +!! Computes the RIMLTC process +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : LFEEDBACKT +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(KSIZE) :: GMASK +! +!------------------------------------------------------------------------------- +! +!* 7.1 cloud ice melting +! +PRIMLTC_MR(:)=0. +IF(.NOT. LDSOFT) THEN + GMASK(:)=PRIT(:)>0. .AND. PT(:)>XTT .AND. LDCOMPUTE(:) + WHERE(GMASK(:)) + PRIMLTC_MR(:)=PRIT(:) + END WHERE + + IF(LFEEDBACKT) THEN + !Limitation due to 0 crossing of temperature + WHERE(GMASK(:)) + PRIMLTC_MR(:)=MIN(PRIMLTC_MR(:), MAX(0., (PTHT(:)-XTT/PEXN(:)) / (PLSFACT(:)-PLVFACT(:)))) + END WHERE + ENDIF +ENDIF +PB_RC(:) = PB_RC(:) + PRIMLTC_MR(:) +PB_RI(:) = PB_RI(:) - PRIMLTC_MR(:) +PB_TH(:) = PB_TH(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:)) +! +! +END SUBROUTINE ICE4_RIMLTC diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90 new file mode 100644 index 000000000..b2e402137 --- /dev/null +++ b/src/MNH/ice4_rrhong.f90 @@ -0,0 +1,100 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_RRHONG +INTERFACE +SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &PT, PRRT, & + &PTHT, & + &PRRHONG_MR, PB_TH, PB_RR, PB_RG) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +END SUBROUTINE ICE4_RRHONG +END INTERFACE +END MODULE MODI_ICE4_RRHONG +SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &PT, PRRT, & + &PTHT, & + &PRRHONG_MR, PB_TH, PB_RR, PB_RG) +!! +!!** PURPOSE +!! ------- +!! Computes the RRHONG process +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : LFEEDBACKT +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK +! +!------------------------------------------------------------------------------- +! +!* 3.3 compute the spontaneous freezing source: RRHONG +! +PRRHONG_MR(:) = 0. +IF(.NOT. LDSOFT) THEN + GMASK(:)=PT(:)<XTT-35.0 .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:) + WHERE(GMASK(:)) + PRRHONG_MR(:) = PRRT(:) + ENDWHERE + IF(LFEEDBACKT) THEN + !Limitation due to -35 crossing of temperature + WHERE(GMASK(:)) + PRRHONG_MR(:)=MIN(PRRHONG_MR(:), MAX(0., ((XTT-35.)/PEXN(:)-PTHT)/(PLSFACT(:)-PLVFACT(:)))) + ENDWHERE + ENDIF +ENDIF +PB_RG(:) = PB_RG(:) + PRRHONG_MR(:) +PB_RR(:) = PB_RR(:) - PRRHONG_MR(:) +PB_TH(:) = PB_TH(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:)) +! +! +END SUBROUTINE ICE4_RRHONG diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90 new file mode 100644 index 000000000..bd3068a5e --- /dev/null +++ b/src/MNH/ice4_rsrimcg_old.f90 @@ -0,0 +1,129 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_RSRIMCG_OLD +INTERFACE +SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, & + &PLBDAS, & + &PT, PRCT, PRST, & + &PRSRIMCG_MR, PB_RS, PB_RG) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +END SUBROUTINE ICE4_RSRIMCG_OLD +END INTERFACE +END MODULE MODI_ICE4_RSRIMCG_OLD +SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, & + &PLBDAS, & + &PT, PRCT, PRST, & + &PRSRIMCG_MR, PB_RS, PB_RG) +!! +!!** PURPOSE +!! ------- +!! Computes the riming-conversion of the large sized aggregates into graupel +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODD_PARAM_ICE, ONLY : CSNOWRIMING +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG +! +!* 0.2 declaration of local variables +! +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK +INTEGER :: IGRIM, IGACC +REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3 +INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2 +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6 +INTEGER :: JJ +!------------------------------------------------------------------------------- +! +! +!------------------------------------------------------------------------------- +! +!* 5.1 cloud droplet riming of the aggregates +! +PRSRIMCG_MR(:)=0. +! +IF(.NOT. LDSOFT) THEN + GRIM(:) = PRCT(:)>XRTMIN(2) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) .AND. PT(:)<XTT + IGRIM = COUNT(GRIM(:)) + ! + IF(IGRIM>0 .AND. CSNOWRIMING=='OLD ') THEN + ! + ! 5.1.1 select the PLBDAS + ! + ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) ) + ! + ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical + ! set of Lbda_s used to tabulate some moments of the incomplete + ! gamma function + ! + ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, & + XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) ) + IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) + ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) ) + + ! + ! 5.1.5 perform the linear interpolation of the normalized + ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) + ! + ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 ) + + ! + ! 5.1.6 riming-conversion of the large sized aggregates into graupeln + ! + ! + WHERE(GRIM(:)) + PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG + * (1.0 - ZZW(:) )/PRHODREF(:) + END WHERE + PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:)) + END IF +ENDIF +PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:) +PB_RG(:) = PB_RG(:) + PRSRIMCG_MR(:) +! +! +END SUBROUTINE ICE4_RSRIMCG_OLD diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90 new file mode 100644 index 000000000..8efa25925 --- /dev/null +++ b/src/MNH/ice4_sedimentation_split.f90 @@ -0,0 +1,550 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_SEDIMENTATION_SPLIT +INTERFACE +SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & + &PINPRH, PRHT, PRHS, PFPR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos. +REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT +END INTERFACE +END MODULE MODI_ICE4_SEDIMENTATION_SPLIT +SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & + &PINPRH, PRHT, PRHS, PFPR) +!! +!!** PURPOSE +!! ------- +!! Computes the sedimentation +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! and modified for optimisation +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_DESCR +USE MODD_RAIN_ICE_PARAM +USE MODD_PARAM_ICE +USE MODI_GAMMA +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos. +REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +! +!* 0.2 declaration of local variables +! +! +LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) & + :: GSEDIM ! Test where to compute the SED processes +LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP +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),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 +REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- +! +! +! O. Initialization of for sedimentation +! +ZINVTSTEP=1./PTSTEP +ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP +IF (OSEDIC) PINPRC (:,:) = 0. +IF (ODEPOSC) PINDEP (:,:) = 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) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP +ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP +ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP +ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP +ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP +IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP +! +! mr values inside the time-splitting loop +ZRCT(:,:,:) = PRCT(:,:,:) +ZRRT(:,:,:) = PRRT(:,:,:) +ZRIT(:,:,:) = PRIT(:,:,:) +ZRST(:,:,:) = PRST(:,:,:) +ZRGT(:,:,:) = PRGT(:,:,:) +IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:) +! +DO JK = KKTB , KKTE + ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK)) +END DO +! +! +!* 2.1 for cloud +! +IF (OSEDIC) THEN + ZREMAINT(:,:) = PTSTEP + DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRCT(KIB:KIE,KJB:KJE,JK)>XRTMIN(2) .OR. & + ZPRCS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(2)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &2, & + &ZRCT, PRCS, ZWSED, PINPRC, ZPRCS, & + &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PSEA, PTOWN, PFPR=PFPR) + ENDDO +ENDIF +! +! +!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND +! +IF (ODEPOSC) THEN + GDEP(:,:) = .FALSE. + GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0 + WHERE (GDEP) + PRCS(:,:,KKB) = PRCS(:,:,KKB) - PVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB) + PINPRC(:,:) = PINPRC(:,:) + PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW + PINDEP(:,:) = PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW + END WHERE +END IF +! +!* 2.2 for rain +! +ZREMAINT(:,:) = PTSTEP +DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRRT(KIB:KIE,KJB:KJE,JK)>XRTMIN(3) .OR. & + ZPRRS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(3)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &3, & + &ZRRT, PRRS, ZWSED, PINPRR, ZPRRS, & + &PFPR=PFPR) +ENDDO +! +!* 2.3 for pristine ice +! +ZREMAINT(:,:) = PTSTEP +DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRIT(KIB:KIE,KJB:KJE,JK)>XRTMIN(4) .OR. & + ZPRIS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(4)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &4, & + &ZRIT, PRIS, ZWSED, PINPRI, ZPRIS, PFPR=PFPR) +ENDDO +! +!* 2.4 for aggregates/snow +! +ZREMAINT(:,:) = PTSTEP +DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRST(KIB:KIE,KJB:KJE,JK)>XRTMIN(5) .OR. & + ZPRSS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(5)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &5, & + &ZRST, PRSS, ZWSED, PINPRS, ZPRSS, PFPR=PFPR) +ENDDO +! +!* 2.5 for graupeln +! +ZREMAINT(:,:) = PTSTEP +DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRGT(KIB:KIE,KJB:KJE,JK)>XRTMIN(6) .OR. & + ZPRGS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(6)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &6, & + &ZRGT, PRGS, ZWSED, PINPRG, ZPRGS, PFPR=PFPR) +ENDDO +! +!* 2.6 for hail +! +IF (KRR==7) THEN + ZREMAINT(:,:) = PTSTEP + DO WHILE (ANY(ZREMAINT>0.)) + GSEDIM(:,:,:)=.FALSE. + DO JK = KKTB , KKTE + GSEDIM(KIB:KIE,KJB:KJE,JK) = & + (ZRHT(KIB:KIE,KJB:KJE,JK)>XRTMIN(7) .OR. & + ZPRHS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(7)) .AND. & + ZREMAINT(KIB:KIE,KJB:KJE)>0. + ENDDO + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, & + &7, & + &ZRHT, PRHS, ZWSED, PINPRH, ZPRHS, PFPR=PFPR) + END DO +ENDIF +! +! +CONTAINS +! +! +!------------------------------------------------------------------------------- +! +! + SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &KSEDIM, LDSEDIM, I1, I2, I3, PMAXCFL, PREMAINT, & + &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PTSTEP, & + &KSPE, & + &PRXT, PRXS, PWSED, PINPRX, PPRXS, & + &PRAY, PLBC, PFSEDC, PCONC3D, PSEA, PTOWN, PFPR) + ! + !* 0. DECLARATIONS + ! ------------ + ! + USE MODD_RAIN_ICE_DESCR + USE MODD_RAIN_ICE_PARAM + ! + IMPLICIT NONE + ! + !* 0.1 Declarations of dummy arguments : + ! + INTEGER, INTENT(IN) :: KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR + INTEGER, INTENT(IN) :: KSEDIM + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM + INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3 + REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed + REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PREMAINT ! Time remaining until the end of the timestep + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z) + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m) + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT + REAL, INTENT(IN) :: PTSTEP ! total timestep + INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr... + REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X + REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE + REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux + REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PINPRX ! instant precip + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie + REAL, DIMENSION(KIT,KJT), INTENT(IN), OPTIONAL :: PSEA ! Sea Mask + REAL, DIMENSION(KIT,KJT), INTENT(IN), OPTIONAL :: PTOWN ! Fraction that is town + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D + REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(INOUT) :: PFPR ! upper-air precipitation fluxes + ! + !* 0.2 declaration of local variables + ! + ! + INTEGER :: JK, JL, JI, JJ + REAL :: ZINVTSTEP + REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC + REAL :: ZFSED, ZEXSED + REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE + REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column + REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN + ! + !------------------------------------------------------------------------------- + ! + ! + !* 1. Parameters for cloud sedimentation + ! + ! + !* 2. compute the fluxes + ! + ! + ZINVTSTEP = 1./PTSTEP + ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP + IF(KSPE==2) THEN + !******* for cloud + PWSED(:,:,:) = 0. + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN + ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / & + (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK)) + ZZWLBDC = ZZWLBDC**XLBEXC + ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC + ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD) + ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15) + ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY) + PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * & + ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK) + ENDIF + ENDDO + ELSEIF(KSPE==4) THEN + ! ******* for pristine ice + PWSED(:,:,:) = 0. + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN + PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * & + & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H + & MAX( 0.05E6,-0.15319E6-0.021454E6* & + & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI + ENDIF + ENDDO + ELSE + ! ******* for other species + IF(KSPE==3) THEN + ZFSED=XFSEDR + ZEXSED=XEXSEDR + ELSEIF(KSPE==5) THEN + ZFSED=XFSEDS + ZEXSED=XEXSEDS + ELSEIF(KSPE==6) THEN + ZFSED=XFSEDG + ZEXSED=XEXSEDG + ELSEIF(KSPE==7) THEN + ZFSED=XFSEDH + ZEXSED=XEXSEDH + ELSE + WRITE(*,*) ' STOP' + WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT','') + ENDIF + PWSED(:,:,:) = 0. + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN + PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * & + PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT) + ENDIF + ENDDO + ENDIF + ZMAX_TSTEP(:,:) = PREMAINT(:,:) + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE) .AND. PWSED(JI, JJ, JK)>1.E-20) THEN + ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * & + PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / PWSED(JI, JJ, JK)) + ENDIF + ENDDO + ZMRCHANGE(:,:) = 0. + PREMAINT(:,:) = PREMAINT(:,:) - ZMAX_TSTEP(:,:) + DO JK = KKTB , KKTE + ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK)) + PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:) + PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP + ENDDO + PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP) + ENDDO + ENDIF + ! + END SUBROUTINE INTERNAL_SEDIM_SPLI + ! + FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC) + ! + !* 0. DECLARATIONS + ! ------------ + ! + IMPLICIT NONE + ! + !* 0.2 declaration of local variables + ! + INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask + INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK + INTEGER :: JI,JJ,JK,IC + ! + !------------------------------------------------------------------------------- + ! + IC = 0 + DO JK = 1,SIZE(LTAB,3) + DO JJ = 1,SIZE(LTAB,2) + DO JI = 1,SIZE(LTAB,1) + IF( LTAB(JI,JJ,JK) ) THEN + IC = IC +1 + I1(IC) = JI + I2(IC) = JJ + I3(IC) = JK + END IF + END DO + END DO + END DO + ! + END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV + ! +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT diff --git a/src/MNH/ice4_sedimentation_split_momentum.f90 b/src/MNH/ice4_sedimentation_split_momentum.f90 new file mode 100644 index 000000000..34436a5a3 --- /dev/null +++ b/src/MNH/ice4_sedimentation_split_momentum.f90 @@ -0,0 +1,609 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM +INTERFACE +SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, OMOMENTUM, & + &PSEA, PTOWN, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, & + &PINPRH, PRHT, PRHS, PFPR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM +END INTERFACE +END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM +SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, OMOMENTUM, & + &PSEA, PTOWN, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, & + &PINPRH, PRHT, PRHS, PFPR) +!! +!!** PURPOSE +!! ------- +!! Computes the sedimentation +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! and modified to use momentum +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_DESCR +USE MODD_RAIN_ICE_PARAM +USE MODD_PARAM_ICE +USE MODI_GAMMA +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +! +!* 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. + 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 + ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:)) + ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:)) +ENDIF +! +!* 2. compute the fluxes +! +! optimization by looking for locations where +! the precipitating fields are larger than a minimal value only !!! +! For optimization we consider each variable separately +! +! External tendecies +IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP +ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP +ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP +ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP +ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP +IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP +! +! mr values inside the time-splitting loop +ZRCT(:,:,:) = PRCT(:,:,:) +ZRRT(:,:,:) = PRRT(:,:,:) +ZRIT(:,:,:) = PRIT(:,:,:) +ZRST(:,:,:) = PRST(:,:,:) +ZRGT(:,:,:) = PRGT(:,:,:) +IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:) +! +DO JK = KKTB , KKTE + ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK)) +END DO +! +! +!* 2.1 for cloud +! +IF (OSEDIC) THEN + ZREMAINT(:,:) = PTSTEP + 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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 = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, & + &OMOMENTUM, FIRST .AND. OMOMENTUM, & + &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, & + &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, 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, PSEA, PTOWN, 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), INTENT(IN) :: PSEA ! Sea Mask + REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town + 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 + ! + ! + 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 + WRITE(*,*) ' STOP' + WRITE(*,*) ' OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum' + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_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(*,*) ' STOP' + WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_MOMENTUM','') + 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 + ! + FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC) + ! + !* 0. DECLARATIONS + ! ------------ + ! + IMPLICIT NONE + ! + !* 0.2 declaration of local variables + ! + INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask + INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK + INTEGER :: JI,JJ,JK,IC + ! + !------------------------------------------------------------------------------- + ! + IC = 0 + DO JK = 1,SIZE(LTAB,3) + DO JJ = 1,SIZE(LTAB,2) + DO JI = 1,SIZE(LTAB,1) + IF( LTAB(JI,JJ,JK) ) THEN + IC = IC +1 + I1(IC) = JI + I2(IC) = JJ + I3(IC) = JK + END IF + END DO + END DO + END DO + ! + END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV + ! +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90 new file mode 100644 index 000000000..12c1f4e5d --- /dev/null +++ b/src/MNH/ice4_sedimentation_split_old.f90 @@ -0,0 +1,493 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD +INTERFACE +SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, KSPLITR, & + &PSEA, PTOWN, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, & + &PINPRH, PRHT, PRHS, PFPR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD +END INTERFACE +END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD +SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, KSPLITR, & + &PSEA, PTOWN, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, & + &PINPRH, PRHT, PRHS, PFPR) +!! +!!** PURPOSE +!! ------- +!! Computes the sedimentation +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_DESCR +USE MODD_RAIN_ICE_PARAM +USE MODI_BUDGET +USE MODD_BUDGET +USE MODI_GAMMA +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +! +!* 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),0:SIZE(PRHODREF,3)+1) :: ZWSED ! sedimentation fluxes +REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration +REAL :: ZINVTSTEP +INTEGER :: ISEDIM ! ! Case number of sedimentation +REAL :: ZTSPLITR ! Small time step for rain sedimentation +INTEGER :: JJ, JK, JN, JL +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- +! +! +! O. Initialization of for sedimentation +! +ZINVTSTEP=1./PTSTEP +ZTSPLITR=PTSTEP/FLOAT(KSPLITR) +IF (OSEDIC) PINPRC (:,:) = 0. +PINPRR (:,:) = 0. +PINPRI (:,:) = 0. +PINPRS (:,:) = 0. +PINPRG (:,:) = 0. +IF ( KRR == 7 ) PINPRH (:,:) = 0. +! +!* 1. Parameters for cloud sedimentation +! +IF (OSEDIC) THEN + ZRAY(:,:,:) = 0. + ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND + + DO JK=KKTB, KKTE + ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1) + ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1)) + ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK)) + ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN + ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + & + PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2))) + END DO + ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:)) + ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:)) +ENDIF +! +!* 2. compute the fluxes +! +! optimization by looking for locations where +! the precipitating fields are larger than a minimal value only !!! +! For optimization we consider each variable separately +! +! External tendecies +IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP +ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP +ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)* ZINVTSTEP +ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP +ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP +IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP +! +! mr values inside the time-splitting loop +ZRCT(:,:,:) = PRCT(:,:,:) +ZRRT(:,:,:) = PRRT(:,:,:) +ZRIT(:,:,:) = PRIT(:,:,:) +ZRST(:,:,:) = PRST(:,:,:) +ZRGT(:,:,:) = PRGT(:,:,:) +IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:) +! +DO JK = KKTB , KKTE + ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK)) +END DO +! +DO JN = 1 , KSPLITR + !We add part of the external tendencies + IF (OSEDIC) ZRCT(:,:,:) = ZRCT(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR + ZRRT(:,:,:) = ZRRT(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR + ZRIT(:,:,:) = ZRIT(:,:,:) + ZPRIS(:,:,:)*ZTSPLITR + ZRST(:,:,:) = ZRST(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR + ZRGT(:,:,:) = ZRGT(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR + IF (KRR==7) ZRHT(:,:,:) = ZRHT(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR + ! + ! + !* 2.1 for cloud + ! + IF (OSEDIC) THEN + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRCT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(2) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &2, & + &ZRCT, PRCS, ZWSED, & + &ZRAY, ZLBC, ZFSEDC, ZCONC3D) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,2)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,KKB) / XRHOLW / KSPLITR + END IF + ! + !* 2.2 for rain + ! + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRRT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(3) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &3, & + &ZRRT, PRRS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,3)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR + ! + !* 2.3 for pristine ice + ! + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRIT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(4) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &4, & + &ZRIT, PRIS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,4)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRI(:,:) = PINPRI(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR + ! + !* 2.4 for aggregates/snow + ! + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRST(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(5) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &5, & + &ZRST, PRSS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,5)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR + ! + !* 2.5 for graupeln + ! + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRGT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(6) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &6, & + &ZRGT, PRGS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,6)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR + ! + !* 2.6 for hail + ! + IF ( KRR == 7 ) THEN + GSEDIM(:,:,:)=.FALSE. + GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = & + ZRHT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(7) + ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,& + &SIZE(I1),I1(:),I2(:),I3(:)) + CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &ISEDIM, GSEDIM, I1, I2, I3, & + &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, & + &7, & + &ZRHT, PRHS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,7)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR + END IF + ! +END DO +! +! +CONTAINS +! +! +!------------------------------------------------------------------------------- +! +! + SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, & + &KSEDIM, LDSEDIM, I1, I2, I3, & + &PRHODREF, PTSORHODZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, PTOTAL_TSTEP, & + &KSPE, & + &PRXT, PRXS, PWSED, & + &PRAY, PLBC, PFSEDC, PCONC3D) + ! + !* 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, KKT, KKL + INTEGER, INTENT(IN) :: KSEDIM + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM + INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3 + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref time delta Z) + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST + REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask + REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT + REAL, INTENT(IN) :: PTSTEP ! small timestep + REAL, INTENT(IN) :: PTOTAL_TSTEP ! 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,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D + ! + !* 0.2 declaration of local variables + ! + ! + INTEGER :: JK, JL, JI, JJ + REAL :: ZINVTOTAL_TSTEP + REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC + REAL :: ZFSED, ZEXSED + REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE + ! + !------------------------------------------------------------------------------- + ! + ! + !* 1. Parameters for cloud sedimentation + ! + ! + !* 2. compute the fluxes + ! + ! + ZINVTOTAL_TSTEP = 1./PTOTAL_TSTEP + PWSED(:,:,:) = 0. + IF(KSPE==2) THEN + !******* for cloud + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + 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) + ENDDO + ELSEIF(KSPE==4) THEN + ! ******* for pristine ice + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN + PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * & + & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H + & MAX( 0.05E6,-0.15319E6-0.021454E6* & + & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI + ENDIF + ENDDO + ELSE + ! ******* for other species + IF(KSPE==3) THEN + ZFSED=XFSEDR + ZEXSED=XEXSEDR + ELSEIF(KSPE==5) THEN + ZFSED=XFSEDS + ZEXSED=XEXSEDS + ELSEIF(KSPE==6) THEN + ZFSED=XFSEDG + ZEXSED=XEXSEDG + ELSEIF(KSPE==7) THEN + ZFSED=XFSEDH + ZEXSED=XEXSEDH + ELSE + WRITE(*,*) ' STOP' + WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_OLD','') + ENDIF + DO JL=1, KSEDIM + JI=I1(JL) + JJ=I2(JL) + JK=I3(JL) + PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * & + PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT) + ENDDO + ENDIF + ZMRCHANGE(:,:) = 0. + DO JK = KKTB , KKTE + ZMRCHANGE(:,:) = PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK)) + PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTOTAL_TSTEP + ENDDO + END SUBROUTINE INTERNAL_SEDIM_SPLI + ! + FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC) + ! + !* 0. DECLARATIONS + ! ------------ + ! + IMPLICIT NONE + ! + !* 0.2 declaration of local variables + ! + INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE + LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask + INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK + INTEGER :: JI,JJ,JK,IC + ! + !------------------------------------------------------------------------------- + ! + IC = 0 + DO JK = 1,SIZE(LTAB,3) + DO JJ = 1,SIZE(LTAB,2) + DO JI = 1,SIZE(LTAB,1) + IF( LTAB(JI,JJ,JK) ) THEN + IC = IC +1 + I1(IC) = JI + I2(IC) = JJ + I3(IC) = JK + END IF + END DO + END DO + END DO + ! + END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV + ! +END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90 new file mode 100644 index 000000000..cea7a1c6c --- /dev/null +++ b/src/MNH/ice4_sedimentation_stat.f90 @@ -0,0 +1,464 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_SEDIMENTATION_STAT +INTERFACE +SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,& + &PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & + &PINPRH, PRHT, PRHS, PFPR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos. +REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +END SUBROUTINE ICE4_SEDIMENTATION_STAT +END INTERFACE +END MODULE MODI_ICE4_SEDIMENTATION_STAT +SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, & + &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, & + &PRHODREF, PPABST, PTHT, PRHODJ, & + &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, & + &PRSS, PRST, PRGS, PRGT,& + &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, & + &PSEA, PTOWN, & + &PINPRH, PRHT, PRHS, PFPR) + +!! +!!** PURPOSE +!! ------- +!! Computes the sedimentation +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODI_BUDGET +USE MODD_BUDGET +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT +INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO +REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start) +INTEGER, INTENT(IN) :: KRR ! Number of moist variable +LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. +LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos. +REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip +REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town +REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t +REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source +REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes +! +!* 0.2 declaration of local variables +! +! +INTEGER :: JK +! +REAL :: ZINVTSTEP +REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) & + :: ZW ! work array +REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) & + :: ZWSED ! sedimentation fluxes +LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP +! +! +!------------------------------------------------------------------------------- +! +ZINVTSTEP=1./PTSTEP +!------------------------------------------------------------------------------- +! +!* 1. compute the fluxes +! +! +DO JK = KKTB , KKTE + ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) ) +END DO +! +!* 2.1 for cloud +! +IF (OSEDIC) THEN + CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &2, & + &PRCT, PRCS, ZWSED, PSEA, PTOWN) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,2)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +ENDIF +! +! +!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND +! +IF (ODEPOSC) THEN + GDEP(:,:) = .FALSE. + GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0 + WHERE (GDEP) + PRCS(:,:,KKB) = PRCS(:,:,KKB) - PVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB) + PINPRC(:,:) = PINPRC(:,:) + PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW + PINDEP(:,:) = PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW + END WHERE +END IF +! +!* 2.2 for rain +! +CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &3, & + &PRRT, PRRS, ZWSED) +IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,3)=ZWSED(:,:,JK) + ENDDO +ENDIF +PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +! +!* 2.3 for pristine ice +! +CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &4, & + &PRIT, PRIS, ZWSED) +IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,4)=ZWSED(:,:,JK) + ENDDO +ENDIF +PINPRI(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +! +!* 2.4 for aggregates/snow +! +CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &5, & + &PRST, PRSS, ZWSED) +IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,5)=ZWSED(:,:,JK) + ENDDO +ENDIF +PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +! +!* 2.5 for graupeln +! +CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &6, & + &PRGT, PRGS, ZWSED) +IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,6)=ZWSED(:,:,JK) + ENDDO +ENDIF +PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +! +!* 2.6 for hail +! +IF ( KRR == 7 ) THEN + CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, & + &7, & + &PRHT, PRHS, ZWSED) + IF (PRESENT(PFPR)) THEN + DO JK = KKTB , KKTE + PFPR(:,:,JK,7)=ZWSED(:,:,JK) + ENDDO + ENDIF + PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s +ENDIF +! +! +CONTAINS + SUBROUTINE INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, & + &PRHODREF, PDZZ, PTSORHODZ, PPABST, PTHT, PTSTEP, & + &KSPE, & + &PRXT, PRXS, PWSED, PSEA, PTOWN) + ! + !* 0. DECLARATIONS + ! ------------ + ! + USE MODI_GAMMA + USE MODD_RAIN_ICE_DESCR + USE MODD_RAIN_ICE_PARAM + ! + IMPLICIT NONE + ! + !* 0.1 Declarations of dummy arguments : + ! + INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKT, KKE, KKTB, KKTE, KKL + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m) + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref times delta Z) + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT + REAL, INTENT(IN) :: PTSTEP + INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr... + REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRXT ! mr of specy X + REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE + REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux + REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask + REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town + ! + !* 0.2 declaration of local variables + ! + ! + INTEGER :: JK, JCOUNT, JL, JI, JJ + INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2 + REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) & + :: ZWSEDW1, ZWSEDW2 ! sedimentation speed + REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP + REAL :: ZINVTSTEP, ZH, ZP1, ZP2, ZZWLBDA, ZZWLBDC, ZZCC + REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation + REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: & + ZRAY, & ! Cloud Mean radius + ZLBC, & ! XLBC weighted by sea fraction + ZFSEDC + REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) & + :: ZCONC_TMP ! Weighted concentration + REAL :: ZFSED, ZEXSED + ! + !------------------------------------------------------------------------------- + ! + ! + !* 1. Parameters for cloud sedimentation + ! + IF(KSPE==2) THEN + ZRAY(:,:,:) = 0. + ZLBC(:,:,:) = XLBC(1) + ZFSEDC(:,:,:) = XFSEDC(1) + ZCONC3D(:,:,:)= XCONC_LAND + ZCONC_TMP(:,:)= XCONC_LAND + IF (PRESENT(PSEA)) THEN + ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND + DO JK=KKTB,KKTE + ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1) + ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1)) + ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK)) + ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN + ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + & + PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2))) + END DO + ELSE + ZCONC3D(:,:,:) = XCONC_LAND + ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC))) + END IF + ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:)) + ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:)) + ENDIF + ! + !* 2. compute the fluxes + ! + ! + ZINVTSTEP = 1./PTSTEP + PWSED(:,:,:) = 0. + ZWSEDW1(:,:,:) = 0. + ZWSEDW2(:,:,:) = 0. + ! calculation of ZP1, ZP2 and sedimentation flux + DO JK = KKE , KKB, -1*KKL + !estimation of q' taking into account incomming PWSED + ZQP(:,:)=PWSED(:,:,JK+KKL)*PTSORHODZ(:,:,JK) + JCOUNT=COUNTJV2((PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. & + (ZQP(:,:) > XRTMIN(KSPE)),KIT,KJT,SIZE(I1),I1(:),I2(:)) + IF(KSPE==2) THEN + !******* for cloud + DO JL=1, JCOUNT + JI=I1(JL) + JJ=I2(JL) + !calculation of w + IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN + ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15) + ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) & + &/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)))**XLBEXC + ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed + ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * & + & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK) + ENDIF + IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN + ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15) + ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) & + &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC + ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed + ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * & + & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK) + ENDIF + ENDDO + ELSEIF(KSPE==4) THEN + ! ******* for pristine ice + DO JL=1, JCOUNT + JI=I1(JL) + JJ=I2(JL) + !calculation of w + IF ( PRXT(JI,JJ,JK) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN + ZWSEDW1 (JI,JJ,JK)= XFSEDI * & + & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H + & MAX( 0.05E6,-0.15319E6-0.021454E6* & + & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI + ENDIF + IF ( ZQP(JI,JJ) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN + ZWSEDW2 (JI,JJ,JK)= XFSEDI * & + & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H + & MAX( 0.05E6,-0.15319E6-0.021454E6* & + & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI + ENDIF + ENDDO + ELSE + ! ******* for other species + IF(KSPE==3) THEN + ZFSED=XFSEDR + ZEXSED=XEXSEDR + ELSEIF(KSPE==5) THEN + ZFSED=XFSEDS + ZEXSED=XEXSEDS + ELSEIF(KSPE==6) THEN + ZFSED=XFSEDG + ZEXSED=XEXSEDG + ELSEIF(KSPE==7) THEN + ZFSED=XFSEDH + ZEXSED=XEXSEDH + ELSE + WRITE(*,*) ' STOP' + WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_STAT','') + ENDIF + DO JL=1, JCOUNT + JI=I1(JL) + JJ=I2(JL) + !calculation of w + IF ( PRXT(JI,JJ,JK) > XRTMIN(KSPE) ) THEN + ZWSEDW1 (JI,JJ,JK)= ZFSED *PRXT(JI,JJ,JK)**(ZEXSED-1)* & + PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1) + ENDIF + IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN + ZWSEDW2 (JI,JJ,JK)= ZFSED *ZQP(JI,JJ)**(ZEXSED-1)* & + PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1) + ENDIF + ENDDO + ENDIF + DO JJ = KJB, KJE + DO JI = KIB, KIE + ZH=PDZZ(JI,JJ,JK) + ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH ) + IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN + ZP2 = MAX(0.,1 - ZH & + & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) ) + ELSE + ZP2 = 0. + ENDIF + PWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*& + &ZH*PRXT(JI,JJ,JK)& + &* ZINVTSTEP+ ZP2 * PWSED (JI,JJ,JK+KKL) + ENDDO + ENDDO + ENDDO + DO JK = KKTB , KKTE + PRXS(:,:,JK) = PRXS(:,:,JK) + & + & PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))*ZINVTSTEP + ENDDO + END SUBROUTINE INTERNAL_SEDIM_STAT + ! + FUNCTION COUNTJV2(LTAB,KIT,KJT,KSIZE,I1,I2) RESULT(IC) + ! + !* 0. DECLARATIONS + ! ------------ + ! + IMPLICIT NONE + ! + !* 0.1 Declarations of dummy arguments : + ! + INTEGER, INTENT(IN) :: KIT, KJT, KSIZE + LOGICAL, DIMENSION(KIT,KJT), INTENT(IN) :: LTAB ! Mask + INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2 ! Used to replace the COUNT and PACK + ! + !* 0.2 declaration of local variables + ! + ! + INTEGER :: JI,JJ,IC + ! + !------------------------------------------------------------------------------- + ! + IC = 0 + DO JJ = 1,SIZE(LTAB,2) + DO JI = 1,SIZE(LTAB,1) + IF( LTAB(JI,JJ) ) THEN + IC = IC +1 + I1(IC) = JI + I2(IC) = JJ + END IF + END DO + END DO + ! + END FUNCTION COUNTJV2 +END SUBROUTINE ICE4_SEDIMENTATION_STAT diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90 new file mode 100644 index 000000000..5927644ea --- /dev/null +++ b/src/MNH/ice4_slow.f90 @@ -0,0 +1,226 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_SLOW +INTERFACE +SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT,& + &PSSI, PLVFACT, PLSFACT, & + &PRVT, PRCT, PRIT, PRST, PRGT,& + &PLBDAS, PLBDAG,& + &PAI, PCJ,& + &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, & + &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +END SUBROUTINE ICE4_SLOW +END INTERFACE +END MODULE MODI_ICE4_SLOW +SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, & + &PSSI, PLVFACT, PLSFACT, & + &PRVT, PRCT, PRIT, PRST, PRGT, & + &PLBDAS, PLBDAG, & + &PAI, PCJ, & + &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, & + &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG) +!! +!!** PURPOSE +!! ------- +!! Computes the slow process +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(SIZE(PRHODREF)) :: ZCRIAUTI +REAL :: ZTIMAUTIC +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK +!------------------------------------------------------------------------------- +! +! +!------------------------------------------------------------------------------- +! +! +!* 3.2 compute the homogeneous nucleation source: RCHONI +! +GMASK(:)=PT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRCHONI(:) = 0. + END WHERE +ELSE + PRCHONI(:) = 0. + WHERE(GMASK(:)) + PRCHONI(:) = XHON*PRHODREF(:)*PRCT(:) & + *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ) + ENDWHERE +ENDIF +PA_RI(:) = PA_RI(:) + PRCHONI(:) +PA_RC(:) = PA_RC(:) - PRCHONI(:) +PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:)) +! +!* 3.4 compute the deposition, aggregation and autoconversion sources +! +! +!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI +! +! ZZW(:) = 0.0 +! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC ) +! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) ) +! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) ) +! PRIS(:) = PRIS(:) + ZZW(:) +! PRCS(:) = PRCS(:) - ZZW(:) +! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI)) +! END WHERE +! +!* 3.4.3 compute the deposition on r_s: RVDEPS +! +GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRVDEPS(:) = 0. + END WHERE +ELSE + PRVDEPS(:) = 0. + WHERE(GMASK(:)) + PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * & + ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + END WHERE +ENDIF +PA_RS(:) = PA_RS(:) + PRVDEPS(:) +PA_RV(:) = PA_RV(:) - PRVDEPS(:) +PA_TH(:) = PA_TH(:) + PRVDEPS(:)*PLSFACT(:) +! +!* 3.4.4 compute the aggregation on r_s: RIAGGS +! +GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRIAGGS(:) = 0. + END WHERE +ELSE + PRIAGGS(:) = 0. + WHERE(GMASK(:)) + PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) & + * PRIT(:) & + * PLBDAS(:)**XEXIAGGS & + * PRHODREF(:)**(-XCEXVT) + END WHERE +ENDIF +PA_RS(:) = PA_RS(:) + PRIAGGS(:) +PA_RI(:) = PA_RI(:) - PRIAGGS(:) +! +!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS +! +GMASK(:)=PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRIAUTS(:) = 0. + END WHERE +ELSE + PRIAUTS(:) = 0. + !ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5)) + ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) + WHERE(GMASK(:)) + PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) & + * MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) + END WHERE +ENDIF +PA_RS(:) = PA_RS(:) + PRIAUTS(:) +PA_RI(:) = PA_RI(:) - PRIAUTS(:) +! +!* 3.4.6 compute the deposition on r_g: RVDEPG +! +! +GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRVDEPG(:) = 0. + END WHERE +ELSE + PRVDEPG(:) = 0. + WHERE(GMASK(:)) + PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * & + ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + END WHERE +ENDIF +PA_RG(:) = PA_RG(:) + PRVDEPG(:) +PA_RV(:) = PA_RV(:) - PRVDEPG(:) +PA_TH(:) = PA_TH(:) + PRVDEPG(:)*PLSFACT(:) +! +! +END SUBROUTINE ICE4_SLOW diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90 new file mode 100644 index 000000000..39480e8fd --- /dev/null +++ b/src/MNH/ice4_tendencies.f90 @@ -0,0 +1,555 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_TENDENCIES +INTERFACE +SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, & + &KRR, LDSOFT, LDCOMPUTE, & + &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, & + &PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, & + &PPRES, PCF, PSIGMA_RC, & + &PCIT, & + &PT, PTHT, & + &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, & + &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, & + &PRS_TEND, PRG_TEND, PRH_TEND, & + &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, & + &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, & + &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL +INTEGER, INTENT(IN) :: KRR +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +LOGICAL, INTENT(IN) :: OWARM +CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR +CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP +CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC +CHARACTER*80, INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDMICRO +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1 +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2 +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3 +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRHONG_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIMLTC_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSACCRG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND +REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction +END SUBROUTINE ICE4_TENDENCIES +END INTERFACE +END MODULE MODI_ICE4_TENDENCIES +SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, & + &KRR, LDSOFT, LDCOMPUTE, & + &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, & + &PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, & + &PPRES, PCF, PSIGMA_RC, & + &PCIT, & + &PT, PTHT, & + &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, & + &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, & + &PRS_TEND, PRG_TEND, PRH_TEND, & + &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, & + &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, & + &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR) +!! +!!** PURPOSE +!! ------- +!! Computes the tendencies +!! +!! AUTHOR +!! ------ +!! S. Riette from the splitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR + +USE MODI_ICE4_NUCLEATION +USE MODI_ICE4_RRHONG +USE MODI_ICE4_RIMLTC +USE MODI_ICE4_RSRIMCG_OLD +USE MODI_ICE4_COMPUTE_PDF +USE MODI_ICE4_RAINFR_VERT +USE MODI_ICE4_SLOW +USE MODI_ICE4_WARM +USE MODI_ICE4_FAST_RS +USE MODI_ICE4_FAST_RG +USE MODI_ICE4_FAST_RH +USE MODI_ICE4_FAST_RI + +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL +INTEGER, INTENT(IN) :: KRR +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +LOGICAL, INTENT(IN) :: OWARM +CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR +CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP +CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC +CHARACTER*80, INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT +LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDMICRO +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1 +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2 +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3 +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT +REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D +REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRHONG_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIMLTC_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSACCRG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH_MR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND +REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND +REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC +REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC +REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, & + & ZT, ZTHT, & + & ZZW, & + & ZSSI, ZKA, ZDV, ZAI, ZCJ, & + & ZRF, & + & ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, & + & ZRGSI, ZRGSI_MR +REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D +INTEGER :: JL +LOGICAL, DIMENSION(KSIZE) :: LLWETG + +PA_TH(:)=0. +PA_RV(:)=0. +PA_RC(:)=0. +PA_RR(:)=0. +PA_RI(:)=0. +PA_RS(:)=0. +PA_RG(:)=0. +PA_RH(:)=0. +PB_TH(:)=0. +PB_RV(:)=0. +PB_RC(:)=0. +PB_RR(:)=0. +PB_RI(:)=0. +PB_RS(:)=0. +PB_RG(:)=0. +PB_RH(:)=0. +! +ZRVT(:)=PRVT(:) +ZRCT(:)=PRCT(:) +ZRRT(:)=PRRT(:) +ZRIT(:)=PRIT(:) +ZRST(:)=PRST(:) +ZRGT(:)=PRGT(:) +ZTHT(:)=PTHT(:) +ZT(:)=PT(:) +! +!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES +! -------------------------------------- +CALL ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, & + ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, & + ZRVT, & + PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI) +ZRIT(:)=ZRIT(:) + PRVHENI_MR(:) +ZRVT(:)=ZRVT(:) - PRVHENI_MR(:) +ZTHT(:)=ZTHT(:) + PRVHENI_MR(:)*PLSFACT(:) +ZT(:) = ZTHT(:) * PEXN(:) +! +!* 3.3 compute the spontaneous freezing source: RRHONG +! +CALL ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &ZT, ZRRT, & + &ZTHT, & + &PRRHONG_MR, PB_TH, PB_RR, PB_RG) +ZRGT(:) = ZRGT(:) + PRRHONG_MR(:) +ZRRT(:) = ZRRT(:) - PRRHONG_MR(:) +ZTHT(:) = ZTHT(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG)) +ZT(:) = ZTHT(:) * PEXN(:) +! +!* 7.1 cloud ice melting +! +CALL ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, & + &PEXN, PLVFACT, PLSFACT, & + &ZT, & + &ZTHT, ZRIT, & + &PRIMLTC_MR, PB_TH, PB_RC, PB_RI) +ZRCT(:) = ZRCT(:) + PRIMLTC_MR(:) +ZRIT(:) = ZRIT(:) - PRIMLTC_MR(:) +ZTHT(:) = ZTHT(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC)) +ZT(:) = ZTHT(:) * PEXN(:) +! +! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation) +! +ZLBDAS(:)=0. +WHERE(ZRST(:)>0.) + ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS) +END WHERE +CALL ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, & + &ZLBDAS, & + &ZT, ZRCT, ZRST, & + &PRSRIMCG_MR, PB_RS, PB_RG) +ZRST(:) = ZRST(:) - PRSRIMCG_MR(:) +ZRGT(:) = ZRGT(:) + PRSRIMCG_MR(:) +! +!* Derived fields +! +IF(KSIZE>0) THEN + ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:))) + DO JL=1, KSIZE + ZSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( (XMV/XMD) * ZZW(JL) ) - 1.0 + ! Supersaturation over ice + ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a + ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v + ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) & + + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL)) + ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT)) + ENDDO + ! + !Cloud water split between high and low content part is done here + CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_PR_PDF,& + PRHODREF, ZRCT, PCF, PSIGMA_RC,& + PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, ZRF) + !Diagnostic of precipitation fraction + PRAINFR(:,:,:)=0. + PRAINFR(:,:,:)=UNPACK(ZRF(:), MASK=LDMICRO(:,:,:), FIELD=PRAINFR(:,:,:)) + ZRRT3D(:,:,:)=PRRT3D(:,:,:)-UNPACK(PRRHONG_MR(:), MASK=LDMICRO(:,:,:), FIELD=0.) + CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:)) + DO JL=1,KSIZE + ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL)) + END DO + ! + !* compute the slope parameters + ! + ZLBDAS(:)=0. + WHERE(ZRST(:)>0.) + ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS) + END WHERE + ZLBDAG(:)=0. + WHERE(ZRGT(:)>0.) + ZLBDAG(:) = XLBG*(PRHODREF(:)*MAX(ZRGT(:), XRTMIN(6)))**XLBEXG + END WHERE + !ZLBDAR will be used when we consider rain diluted over the grid box + ZLBDAR(:)=0. + WHERE(ZRRT(:)>0.) + ZLBDAR(:) = XLBR*( PRHODREF(:)*MAX( ZRRT(:), XRTMIN(3)))**XLBEXR + END WHERE + !ZLBDAR_RF is used when we consider rain concentrated in its fraction + ZLBDAR_RF(:)=0. + WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.) + ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR + END WHERE + IF(KRR==7) THEN + ZLBDAH(:)=0. + WHERE(PRHT(:)>0.) + ZLBDAH(:) = XLBH*(PRHODREF(:)*MAX(PRHT(:), XRTMIN(7)))**XLBEXH + END WHERE + ENDIF +ENDIF +! +! +CALL ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, ZT, & + &ZSSI, PLVFACT, PLSFACT, & + &ZRVT, ZRCT, ZRIT, ZRST, ZRGT, & + &ZLBDAS, ZLBDAG, & + &ZAI, ZCJ, & + &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, & + &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG) +! +!------------------------------------------------------------------------------- +! +! +!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES +! -------------------------------------- +! +! +IF(OWARM) THEN ! Check if the formation of the raindrops by the slow + ! warm processes is allowed + CALL ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, & + &PRHODREF, PLVFACT, ZT, PPRES, ZTHT,& + &ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, & + &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, & + &PCF, ZRF, & + &ZRVT, ZRCT, ZRRT, & + &PRCAUTR, PRCACCR, PRREVAV, & + &PA_TH, PA_RV, PA_RC, PA_RR) +ELSE + PRCAUTR(:)=0. + PRCACCR(:)=0. + PRREVAV(:)=0. +END IF +! +!------------------------------------------------------------------------------- +! +! +!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s +! ---------------------------------------------- +! +CALL ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &ZDV, ZKA, ZCJ, & + &ZLBDAR, ZLBDAS, & + &ZT, ZRVT, ZRCT, ZRRT, ZRST, & + &PRIAGGS, & + &PRCRIMSS, PRCRIMSG, PRSRIMCG, & + &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, & + &PRCMLTSR, & + &PRS_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG) +! +!------------------------------------------------------------------------------- +! +! +!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g +! ------------------------------------------------------ +! +ZRGSI(:) = PRVDEPG(:) + PRSMLTG(:) + PRRACCSG(:) + PRSACCRG(:) + PRCRIMSG(:) + PRSRIMCG(:) +ZRGSI_MR(:) = PRRHONG_MR(:) + PRSRIMCG_MR(:) +CALL ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &ZDV, ZKA, ZCJ, PCIT, & + &ZLBDAR, ZLBDAS, ZLBDAG, & + &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, & + &ZRGSI, ZRGSI_MR(:), & + &LLWETG, & + &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, & + &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, & + &PRG_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH) +! +!------------------------------------------------------------------------------- +! +! +!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h +! ---------------------------------------------- +! +IF (KRR==7) THEN + CALL ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LLWETG, & + &PRHODREF, PLVFACT, PLSFACT, PPRES, & + &ZDV, ZKA, ZCJ, & + &ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, & + &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, PRHT, & + &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & + &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, & + &PRH_TEND, & + &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH) +ELSE + PRCWETH(:)=0. + PRIWETH(:)=0. + PRSWETH(:)=0. + PRGWETH(:)=0. + PRRWETH(:)=0. + PRCDRYH(:)=0. + PRIDRYH(:)=0. + PRSDRYH(:)=0. + PRRDRYH(:)=0. + PRGDRYH(:)=0. + PRDRYHG(:)=0. + PRHMLTR(:)=0. +END IF +! +!------------------------------------------------------------------------------- +! +! +!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES +! ------------------------------------------------------------- +! +CALL ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, & + &PRHODREF, PLVFACT, PLSFACT, & + &ZAI, ZCJ, PCIT, & + &ZSSI, & + &ZRCT, ZRIT, & + &PRCBERI, PA_TH, PA_RC, PA_RI) +! +! +END SUBROUTINE ICE4_TENDENCIES diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90 new file mode 100644 index 000000000..1a4b70cbc --- /dev/null +++ b/src/MNH/ice4_warm.f90 @@ -0,0 +1,288 @@ +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODI_ICE4_WARM +INTERFACE +SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, & + &PRHODREF, PLVFACT, PT, PPRES, PTHT, & + &PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, & + &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, & + &PCF, PRF, & + &PRVT, PRCT, PRRT, & + &PRCAUTR, PRCACCR, PRREVAV, & + &PA_TH, PA_RV, PA_RC, PA_RR) +IMPLICIT NONE +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion +CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +END SUBROUTINE ICE4_WARM +END INTERFACE +END MODULE MODI_ICE4_WARM +SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, & + &PRHODREF, PLVFACT, PT, PPRES, PTHT, & + &PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, & + &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, & + &PCF, PRF, & + &PRVT, PRCT, PRRT, & + &PRCAUTR, PRCACCR, PRREVAV, & + &PA_TH, PA_RV, PA_RC, PA_RR) +!! +!!** PURPOSE +!! ------- +!! Computes the warm process +!! +!! AUTHOR +!! ------ +!! S. Riette from the plitting of rain_ice source code (nov. 2014) +!! +!! MODIFICATIONS +!! ------------- +!! +! +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST +USE MODD_RAIN_ICE_PARAM +USE MODD_RAIN_ICE_DESCR +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +INTEGER, INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LDSOFT +LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE +CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion +CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT +REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature +REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution +REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part +REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid +REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC +REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR +! +!* 0.2 declaration of local variables +! +REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW2, ZZW3, ZZW4 +REAL, DIMENSION(SIZE(PRHODREF)) :: ZUSW ! Undersaturation over water +REAL, DIMENSION(SIZE(PRHODREF)) :: ZTHLT ! Liquid potential temperature +REAL :: ZTIMAUTIC +LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK, GMASK1, GMASK2 +!------------------------------------------------------------------------------- +! +! +! +!------------------------------------------------------------------------------- +! +!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR +! +GMASK(:)=PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:) .GT. 0. .AND. LDCOMPUTE(:) +IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRCAUTR(:) = 0. + END WHERE +ELSE + PRCAUTR(:) = 0. + WHERE(GMASK(:)) + PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0) + PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:) + END WHERE +ENDIF +PA_RC(:) = PA_RC(:) - PRCAUTR(:) +PA_RR(:) = PA_RR(:) + PRCAUTR(:) +! +! +!* 4.3 compute the accretion of r_c for r_r production: RCACCR +! +IF (HSUBG_RC_RR_ACCR=='NONE') THEN + !CLoud water and rain are diluted over the grid box + GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:) + IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRCACCR(:)=0. + END WHERE + ELSE + PRCACCR(:) = 0. + WHERE(GMASK(:)) + PRCACCR(:) = XFCACCR * PRCT(:) & + * PLBDAR(:)**XEXCACCR & + * PRHODREF(:)**(-XCEXVT) + END WHERE + ENDIF + +ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN + !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion + !Rain is concnetrated over its fraction + !Rain in high content area fraction: PHLC_HCF + !Rain in low content area fraction: + ! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF + ! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF + ! => min(PCF, PRF)-PHLC_HCF + GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:) + GMASK1(:)=GMASK(:) .AND. PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:)>0. + GMASK2(:)=GMASK(:) .AND. PHLC_LRC(:)>XRTMIN(2) .AND. PHLC_LCF(:)>0. + IF(LDSOFT) THEN + WHERE(.NOT. (GMASK1(:) .OR. GMASK2(:))) + PRCACCR(:)=0. + END WHERE + ELSE + PRCACCR(:)=0. + WHERE(GMASK1(:)) + !Accretion due to rain falling in high cloud content + PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) & + * PLBDAR_RF(:)**XEXCACCR & + * PRHODREF(:)**(-XCEXVT) & + * PHLC_HCF + END WHERE + WHERE(GMASK2(:)) + !We add acrretion due to rain falling in low cloud content + PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) & + * PLBDAR_RF(:)**XEXCACCR & + * PRHODREF(:)**(-XCEXVT) & + * (MIN(PCF(:), PRF(:))-PHLC_HCF(:)) + END WHERE + ENDIF +ELSE + !wrong HSUBG_RC_RR_ACCR case + + WRITE(*,*) 'wrong HSUBG_RC_RR_ACCR case' + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','') +ENDIF +PA_RC(:) = PA_RC(:) - PRCACCR(:) +PA_RR(:) = PA_RR(:) + PRCACCR(:) +! +!* 4.4 compute the evaporation of r_r: RREVAV +! +IF (HSUBG_RR_EVAP=='NONE') THEN + GMASK(:)=PRRT(:)>XRTMIN(3) .AND. PRCT(:)<=XRTMIN(2) .AND. LDCOMPUTE(:) + IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRREVAV(:)=0. + END WHERE + ELSE + PRREVAV(:) = 0. + !Evaporation only when there's no cloud (RC must be 0) + WHERE(GMASK(:)) + PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w + ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) ) + ! Undersaturation over water + PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) & + + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) ) + PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * & + ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR ) + END WHERE + ENDIF + +ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN + !Evaporation in clear sky part + !With CLFR, rain is diluted over the grid box + !With PRFR, rain is concentrated in its fraction + !Use temperature and humidity in clear sky part like Bechtold et al. (1993) + IF (HSUBG_RR_EVAP=='CLFR') THEN + ZZW4(:)=1. !Precipitation fraction + ZZW3(:)=PLBDAR(:) + ELSE + ZZW4(:)=PRF(:) !Precipitation fraction + ZZW3(:)=PLBDAR_RF(:) + ENDIF + + !ATTENTION + !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u + !Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s + !et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice + !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs + GMASK(:)=PRRT(:)>XRTMIN(3) .AND. ZZW4(:) > PCF(:) .AND. LDCOMPUTE(:) + IF(LDSOFT) THEN + WHERE(.NOT. GMASK(:)) + PRREVAV(:)=0. + END WHERE + ELSE + PRREVAV(:) = 0. + WHERE(GMASK(:)) + ! outside the cloud (environment) the use of T^u (unsaturated) instead of T + ! Bechtold et al. 1993 + ! + ! T_l + ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:) + ! + ! T^u = T_l = theta_l * (T/theta) + ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:) + ! + ! es_w with new T^u + PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) ) + ! + ! S, Undersaturation over water (with new theta^u) + ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) ) + ! + PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) & + + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) ) + ! + PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * & + ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR ) + ! + PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:)) + END WHERE + ENDIF + +ELSE + WRITE(*,*) 'wrong HSUBG_RR_EVAP case' + CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','') +END IF +PA_RR(:) = PA_RR(:) - PRREVAV(:) +PA_RV(:) = PA_RV(:) + PRREVAV(:) +PA_TH(:) = PA_TH(:) - PRREVAV(:)*PLVFACT(:) +! +! +END SUBROUTINE ICE4_WARM -- GitLab