diff --git a/docs/TODO b/docs/TODO index 2c8de10ce044f960bf982f7a41b9d9f489c62328..71c56d8534355bd553f402ce2babf4e418b4b01f 100644 --- a/docs/TODO +++ b/docs/TODO @@ -22,6 +22,11 @@ Merge pb: Ryad a fait des tests pour regarder impact des allocatable sur CPU => temps * 2 Code à nettoyer quelque soit l'option retenue Dernier code de Ryad: /home/gmap/mrpm/khatib/public/modset/mods_ice4_nucleation_wrapper.tgz et/ou /home/gmap/mrpm/khatib/public/modset/ice4_nucleation_wrapper.f90 +- shallow_mf (appels dans aro_shallow et arp_shallow): + Dans Méso-NH: shallow_mf doit être appelé avec PDX=XDXHAT(1) et PDY=XDYHAT(1) + Dans AROME/ARP: où trouver la taille de maille? + Pour l'instant 2 versions à cause de l'interface à compute_uprfat_rhcj10 +- compute_updraft_rhcj10: en attente retour de Rachel et/ou Yves pour faire le merge Etape 2: array syntax -> loop - en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation @@ -41,6 +46,8 @@ Pb identifiés à corriger plus tard: concernent qu'une partie des points => à corriger - seules les options oper ont été testées, il manque des test pour sedim_after, nmaxiter, xmrstep, xtstep, autoconv, rainfr +- arome/ini_cmfshall devrait s'appeler ini_param_mfshall +- th_r_from_thl_rt appelée partout, il faudrait limiter à OTEST Répertoire arome/ext contient les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé. Ce répertoire devra être vidé à la fin du phasage, les modifications nécessaires ayadevront avoir été fournies par ailleurs diff --git a/src/arome/ext/aro_shallow_mf.F90 b/src/arome/ext/aro_shallow_mf.F90 new file mode 100644 index 0000000000000000000000000000000000000000..4a59175ab8c1a3ebdb725629820e8a1f87b6e109 --- /dev/null +++ b/src/arome/ext/aro_shallow_mf.F90 @@ -0,0 +1,250 @@ +! ######spl + SUBROUTINE ARO_SHALLOW_MF(KKL, KLON,KLEV, KRR, KRRL, KRRI,KSV, & + HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, & + ONOMIXLG,KSV_LGBEG,KSV_LGEND, & + KTCOUNT, PTSTEP, & + PZZ, PZZF, PDZZF, & + PRHODJ, PRHODREF, & + PPABSM, PEXNM, & + PSFTH,PSFRV, & + PTHM,PRM, & + PUM,PVM,PTKEM,PSVM, & + PDUDT_MF,PDVDT_MF, & + PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, & + PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, & + PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & + PU_UP, PV_UP, PTHV_UP, PW_UP, PFRAC_UP, PEMF) + + USE PARKIND1, ONLY : JPRB + USE YOMHOOK , ONLY : LHOOK, DR_HOOK +! ########################################################################## +! +!!**** * - interface to call SHALLOW_MF : +!! computation of turbulence "mass flux" fluxes and their divergence +!! +!! +!! +!! PURPOSE +!! ------- +!! +!! +!! +!! +!!** METHOD +!! ------ +!! +!! +!! +!! EXTERNAL +!! -------- +!! Subroutine SHALLOW_MF (routine de MesoNH) +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! +!! REFERENCE +!! --------- +!! +!! Documentation AROME +!! +!! AUTHOR +!! ------ +!! S.Malardel +!! +!! MODIFICATIONS +!! ------------- +!! Original 07/2006 +!! Y. Seity : new arguments for EDMF scheme 04/2009 +!! S. Riette 18 May 2010: aro_shallow_mf and shallow_mf interfaces changed +!! S. Riette Jan 2012: support for both order of vertical levels +!! +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_PARAMETERS, ONLY: JPVEXT, JPHEXT +! +USE MODI_SHALLOW_MF +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +! +! +INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to + ! atmosphere top, -1 otherwise +INTEGER, INTENT(IN) :: KLON !NPROMA under CPG +INTEGER, INTENT(IN) :: KLEV !Number of vertical levels +INTEGER, INTENT(IN) :: KRR ! Number of moist variables +INTEGER, INTENT(IN) :: KRRL ! Number of liquide water variables +INTEGER, INTENT(IN) :: KRRI ! Number of ice variables +INTEGER, INTENT(IN) :: KSV ! Number of passive scalar variables +! +CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme +CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme +CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum +! +LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer +INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer +INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer + +INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter +REAL, INTENT(IN) :: PTSTEP ! Time step +! +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! Height of layer boundaries +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZF ! Height of level +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDZZF !thikness between layers + +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODJ ! Dry density * Jacobian +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODREF ! Dry density +! +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABSM ! Pressure at time t-1 +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PEXNM ! Exner function +! +! normal surface fluxes of theta and Rv +REAL, DIMENSION(KLON), INTENT(IN) :: PSFTH,PSFRV +! prognostic variables at t- deltat +! +! thermodynamical variables which are transformed in conservative var. +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHM ! pot. temp. +REAL, DIMENSION(KLON,KLEV,KRR), INTENT(IN) :: PRM ! mixing ratio +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUM,PVM ! momentum +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTKEM +REAL, DIMENSION(KLON,KLEV,KSV), INTENT(IN) :: PSVM ! passive scalar + ! variables for EDMF scheme +REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme +REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme +REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme +REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme +REAL, DIMENSION(KLON,KLEV,KSV), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme + +REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme +REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PFRAC_UP ! updraft fraction +REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PEMF ! updraft mass flux +! +! +!* 0.2 Declarations of local variables : +! +INTEGER :: JRR ! Loop index for the moist +INTEGER :: IIB ! Define the physical domain +INTEGER :: IIE ! +INTEGER :: IJB ! +INTEGER :: IJE ! +INTEGER :: IKB ! +INTEGER :: IKE ! +INTEGER :: IKA, IKU +INTEGER :: JI, JJ, JL, JK ! +INTEGER ::II +INTEGER, DIMENSION(size(PRHODJ,1)) :: IKLCL,IKETL,IKCTL +REAL,DIMENSION(size(PRHODJ,1),size(PRHODJ,2)) :: ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF +REAL,DIMENSION(size(PRHODJ,1),size(PRHODJ,2)) :: ZDETR,ZENTR +! +! + +REAL :: ZIMPL ! degree of implicitness +! +! +! +!------------------------------------------------------------------------------ +! +!* 1. PRELIMINARY COMPUTATIONS +! ------------------------ +! +REAL(KIND=JPRB) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('ARO_SHALLOW_MF',0,ZHOOK_HANDLE) + + +IIB=1+JPHEXT +IIE=SIZE(PZZ,1) - JPHEXT +IJB=1+JPHEXT +IJE=1 - JPHEXT +IF(KKL==1)THEN + IKA=1 + IKU=SIZE(PZZ,2) +ELSE + IKA=SIZE(PZZ,2) + IKU=1 +ENDIF +IKB=IKA+KKL*JPVEXT +IKE=IKU-KKL*JPVEXT +! +! +!------------------------------------------------------------------------------ +! +!* 2. INITIALISATION +! +! --------------- + + +ZIMPL=1. +!ZIMPL=0. +! tableau a recalculer a chaque pas de temps +! attention, ZDZZ est l'altitude entre deux niveaux (et pas l'�paisseur de la couche) + +!DO JL = IIB,IIE +! DO JK = 2, SIZE(PZZF,2)-1 +! ZDZZ(JL,JK)=PZZF(JL,JK)-PZZF(JL,JK-KKL) +! ENDDO +! ZDZZ(JL,IKA)=PZZF(JL,IKA)-(1.5*PZZ(JL,IKA)-0.5*PZZ(JL,IKA+KKL)) ! must work with JPVEXT=0 or 1 +! ZDZZ(JL,IKU)=PZZF(JL,IKU)-PZZF(JL,IKU-KKL) ! excluded from the loop because depending on KKL, IKU can be 1 or SIZE() +!ENDDO +! +! +!------------------------------------------------------------------------------ +! +! +!* 3. MULTIPLICATION PAR RHODJ +! POUR OBTENIR LES TERMES SOURCES DE MESONH +! +! ----------------------------------------------- + +! +!------------------------------------------------------------------------------ +! +! +!* 4. APPEL DE LA TURBULENCE MESONH +! +! --------------------------------- +! + CALL SHALLOW_MF(KKA=IKA,KKU=IKU,KKL=KKL,KRR=KRR,KRRL=KRRL,KRRI=KRRI, & + &HMF_UPDRAFT=HMF_UPDRAFT, HMF_CLOUD=HMF_CLOUD,HFRAC_ICE=HFRAC_ICE,OMIXUV=OMIXUV, & + &ONOMIXLG=ONOMIXLG,KSV_LGBEG=KSV_LGBEG,KSV_LGEND=KSV_LGEND, & + &PIMPL_MF=ZIMPL, PTSTEP=PTSTEP, & + &PDZZ=PDZZF,PZZ=PZZ, & + &PRHODJ=PRHODJ,PRHODREF=PRHODREF, & + &PPABSM=PPABSM,PEXNM=PEXNM, & + &PSFTH=PSFTH,PSFRV=PSFRV, & + &PTHM=PTHM,PRM=PRM,PUM=PUM,PVM=PVM,PTKEM=PTKEM,PSVM=PSVM, & + &PDUDT_MF=PDUDT_MF,PDVDT_MF=PDVDT_MF, & + &PDTHLDT_MF=PDTHLDT_MF,PDRTDT_MF=PDRTDT_MF,PDSVDT_MF=PDSVDT_MF, & + &PSIGMF=PSIGMF,PRC_MF=PRC_MF,PRI_MF=PRI_MF,PCF_MF=PCF_MF,PFLXZTHVMF=PFLXZTHVMF, & + &PFLXZTHMF=ZFLXZTHMF,PFLXZRMF=ZFLXZRMF,PFLXZUMF=ZFLXZUMF,PFLXZVMF=ZFLXZVMF, & + &PTHL_UP=PTHL_UP,PRT_UP=PRT_UP,PRV_UP=PRV_UP,PRC_UP=PRC_UP,PRI_UP=PRI_UP, & + &PU_UP=PU_UP, PV_UP=PV_UP, PTHV_UP=PTHV_UP, PW_UP=PW_UP, & + &PFRAC_UP=PFRAC_UP,PEMF=PEMF,PDETR=ZDETR,PENTR=ZENTR, & + &KKLCL=IKLCL,KKETL=IKETL,KKCTL=IKCTL,PDX=0.,PDY=0. ) +! +! +!------------------------------------------------------------------------------ +! +! +!* 5. DIVISION PAR RHODJ DES TERMES SOURCES DE MESONH +! (on obtient des termes homog�nes � des tendances) +! +! ----------------------------------------------- +! +IF (LHOOK) CALL DR_HOOK('ARO_SHALLOW_MF',1,ZHOOK_HANDLE) +END SUBROUTINE ARO_SHALLOW_MF diff --git a/src/arome/ext/aro_shallow_mf.h b/src/arome/ext/aro_shallow_mf.h new file mode 100644 index 0000000000000000000000000000000000000000..07cdb7a7d38e75a76c8c45716c095ddcd22a0e1c --- /dev/null +++ b/src/arome/ext/aro_shallow_mf.h @@ -0,0 +1,66 @@ +INTERFACE + SUBROUTINE ARO_SHALLOW_MF(KKL, KLON,KLEV, KRR, KRRL, KRRI,KSV,& + & HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV,& + & ONOMIXLG,KSV_LGBEG,KSV_LGEND,& + & KTCOUNT, PTSTEP,& + & PZZ, PZZF,PDZZF,& + & PRHODJ, PRHODREF,& + & PPABSM, PEXNM,& + & PSFTH,PSFRV,& + & PTHM,PRM,& + & PUM,PVM,PTKEM,PSVM,& + & PDUDT_MF,PDVDT_MF,& + & PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF,& + & PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF,& + & PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP,& + & PU_UP, PV_UP, PTHV_UP, PW_UP, PFRAC_UP, PEMF) +USE PARKIND1 ,ONLY : JPIM ,JPRB +INTEGER(KIND=JPIM), INTENT(IN) :: KKL +INTEGER(KIND=JPIM), INTENT(IN) :: KLON +INTEGER(KIND=JPIM), INTENT(IN) :: KLEV +INTEGER(KIND=JPIM), INTENT(IN) :: KRR +INTEGER(KIND=JPIM), INTENT(IN) :: KRRL +INTEGER(KIND=JPIM), INTENT(IN) :: KRRI +INTEGER(KIND=JPIM), INTENT(IN) :: KSV +CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT +CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD +CHARACTER*1, INTENT(IN) :: HFRAC_ICE +LOGICAL, INTENT(IN) :: OMIXUV +LOGICAL, INTENT(IN) :: ONOMIXLG +INTEGER(KIND=JPIM), INTENT(IN) :: KSV_LGBEG +INTEGER(KIND=JPIM), INTENT(IN) :: KSV_LGEND +INTEGER(KIND=JPIM), INTENT(IN) :: KTCOUNT +REAL(KIND=JPRB), INTENT(IN) :: PTSTEP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PZZF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PDZZF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODJ +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PRHODREF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PPABSM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PEXNM +REAL(KIND=JPRB), DIMENSION(KLON), INTENT(IN) :: PSFTH,PSFRV +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PTHM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV,KRR), INTENT(IN) :: PRM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PUM,PVM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(IN) :: PTKEM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV,KSV), INTENT(IN) :: PSVM +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT):: PDUDT_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT):: PDVDT_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHLDT_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT):: PDRTDT_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV,KSV), INTENT(OUT):: PDSVDT_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(OUT) :: PFLXZTHVMF +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PTHL_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRT_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRV_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PU_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PV_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRC_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PRI_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PTHV_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PW_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PFRAC_UP +REAL(KIND=JPRB), DIMENSION(KLON,KLEV), INTENT(INOUT) :: PEMF +END SUBROUTINE ARO_SHALLOW_MF +END INTERFACE diff --git a/src/arome/ext/arp_shallow_mf.F90 b/src/arome/ext/arp_shallow_mf.F90 new file mode 100644 index 0000000000000000000000000000000000000000..f79aee52db64c9364b9ea455f4407b35b9982604 --- /dev/null +++ b/src/arome/ext/arp_shallow_mf.F90 @@ -0,0 +1,455 @@ +! ######spl + SUBROUTINE ARP_SHALLOW_MF(KIDIA,KFDIA,KLON,KTDIA,KLEV,PIMPL,TSPHY,PZZ,PZZF,PR,PCP, & + & CMF_UPDRAFT,CMF_CLOUD,LMIXUV, & + & PU, PV, PT,PQV,PQL,PQI,PQR,PQS,PTKE,PAPRSF, & + & PDELP,PDIFTQ,PDIFTS,PSTRTU,PSTRTV,PSFTH,PSFRV,& + & PRODTH_CVPP,PQLI,PNEB,KNLAB,PMF_UP) + + +! ########################################################################## +! +!!**** * - interface to call SHALLOW_MF : +!! computation of turbulence "mass flux" fluxes and their divergence +!! +!! +!! +!! PURPOSE +!! ------- +!! +!! +!! +!! +!!** METHOD +!! ------ +!! +!! +!! +!! EXTERNAL +!! -------- +!! Subroutine SHALLOW_MF (routine de MesoNH) +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! +!! REFERENCE +!! --------- +!! +!! Documentation ARPEGE +!! +!! AUTHOR +!! ------ +!! Y.Bouteloup from aro_shallow_mf +!! +!! MODIFICATIONS +!! ------------- +!! Original 11/2010 +!! S. Riette shallow_mf now outputs ice cloud +!! S. Riette Jan 2012: support for both order of vertical levels +!! +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ + +USE YOMCST , ONLY : RG, RATM, RKAPPA, RD, RCPD, RCPV + +!USE MODD_PARAMETERS +! +USE MODI_SHALLOW_MF +USE MODD_CST +USE YOMCT3 +! +IMPLICIT NONE +! +!* 0.1 Declarations of dummy arguments : +! +! +! + +INTEGER, INTENT(IN) :: KIDIA +INTEGER, INTENT(IN) :: KFDIA +INTEGER, INTENT(IN) :: KLON !NPROMA under CPG +INTEGER, INTENT(IN) :: KLEV !Number of vertical levels (bottom of atmosphere in ARP) +INTEGER, INTENT(IN) :: KTDIA !Top of atmosphere in ARPEGE +REAL, INTENT(IN) :: TSPHY ! Time step +REAL, INTENT(IN) :: PIMPL + +CHARACTER (LEN=4), INTENT(IN) :: CMF_UPDRAFT ! Type of Mass Flux Scheme +CHARACTER (LEN=4), INTENT(IN) :: CMF_CLOUD ! Type of statistical cloud scheme +LOGICAL, INTENT(IN) :: LMIXUV ! True if mixing of momentum + +!REAL, DIMENSION(KLON,KLEV+2), INTENT(IN) :: PZZ ! Height of layer boundaries +REAL, DIMENSION(KLON,0:KLEV), INTENT(IN) :: PZZ ! Height of layer boundaries +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZF ! Height of level +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PR ! Air gaz constant +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PCP ! Cp +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PT +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PQV +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PQL +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PQI +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PQR +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PQS +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTKE +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PAPRSF +REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDELP + +REAL, DIMENSION(KLON,0:KLEV), INTENT(INOUT) :: PDIFTQ +REAL, DIMENSION(KLON,0:KLEV), INTENT(INOUT) :: PDIFTS +REAL, DIMENSION(KLON,0:KLEV), INTENT(INOUT) :: PSTRTU +REAL, DIMENSION(KLON,0:KLEV), INTENT(INOUT) :: PSTRTV + +REAL, DIMENSION(KLON,0:KLEV), INTENT(INOUT) :: PRODTH_CVPP +REAL, DIMENSION(KLON,KLEV) , INTENT(INOUT) :: PQLI +REAL, DIMENSION(KLON,KLEV) , INTENT(INOUT) :: PNEB +INTEGER, DIMENSION(KLON,KLEV), INTENT(INOUT) :: KNLAB + +REAL, DIMENSION(KLON,0:KLEV), INTENT(OUT) :: PMF_UP + +! +! normal surface fluxes of theta and Rv +REAL, DIMENSION(KLON), INTENT(IN) :: PSFTH,PSFRV +! prognostic variables at t- deltat +! +!CHARACTER (LEN=14), INTENT(IN) :: CPNAME +! +! +!* 0.2 Declarations of local variables : +! +INTEGER :: JRR ! Loop index for the moist +INTEGER :: IIB ! Define the physical domain +INTEGER :: IIE ! +INTEGER :: IJB ! +INTEGER :: IJE ! +INTEGER :: IKA +INTEGER :: IKB ! +INTEGER :: IKE ! +INTEGER :: IKU +INTEGER :: IKL ! +INTEGER :: IKR ! +INTEGER :: IKRL ! +INTEGER :: IKRI ! +INTEGER :: JI, JJ, JL, JK, JLON, JLEV ! +INTEGER ::II, IUSCM, IKK, ILEV +INTEGER :: ISV_LGBEG, ISV_LGEND, ITCOUNT +INTEGER, DIMENSION(KIDIA:KFDIA) :: IKLCL,IKETL,IKCTL +REAL,DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF +REAL,DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZEMF,ZDETR,ZENTR + + +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDZZ,ZZZ,ZTHETA,ZEXNER,ZHRO,ZHRODJ,ZHRODREF +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDUDT_TURB,ZDVDT_TURB,ZDRTDT_TURB,ZDTHLDT_TURB +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2,5) :: ZRM +REAL, DIMENSION(KIDIA:KFDIA) :: ZSFTH,ZSFRV + +REAL :: ZINVG, ZDT, ZEMF_MAX, ZTDCP, ZVMD + +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2,1) :: ZSVM, ZDSVDT_TURB, ZSVDT_MF + +CHARACTER (LEN=4) :: HMF_UPDRAFT, HMF_CLOUD + + +LOGICAL LLOMIXUV, LLONOMIXLG +! +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDUDT_MF ! tendency of U by massflux scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDVDT_MF ! tendency of V by massflux scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDTHLDT_MF ! tendency of thl by massflux scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDRTDT_MF ! tendency of rt by massflux scheme + +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZSIGMF,ZRC_MF,ZRI_MF,ZCF_MF ! cloud info for the cloud scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFLXZTHVMF ! Thermal production for TKE scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZTHL_UP ! Thl updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZRT_UP ! Rt updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZRV_UP ! Vapor updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZU_UP ! U wind updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZV_UP ! V wind updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZRC_UP ! cloud content updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZRI_UP ! ice content updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZTHV_UP ! Thv updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZW_UP ! vertical speed updraft characteristics +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFRAC_UP ! updraft fraction +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZDPSG ! Delta P / g +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFQ_MF ! Flux de qv by massflux scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFH_MF ! Flux d'hentalpy by massflux scheme +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFU_MF +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZFV_MF +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZQDM + +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZAPRSF +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZTKE +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZU +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZV +REAL, DIMENSION(KIDIA:KFDIA,KLEV+2) :: ZZZF + +!------------------------------------------------------------------------------ + +!* 1. PRELIMINARY COMPUTATIONS +! ------------------------ + + +! Controle : + + +! Avec inversion des boucles +IKA=1 ! <== Bottom index of array +IKB=2 ! <== Physical bottom +IKE=KLEV+1 ! <== Physical top +IKU=KLEV+2 ! <== Top index of array +IKL=1 ! <== Loop increment to go from top to bottom + +IIB=KIDIA +IIE=KFDIA +IKR=5 ! <== Number of water species +IKRL=2 +IKRI=2 +ZINVG = 1./RG + +!------------------------------------------------------------------------------ + +!* 2. INITIALISATION + +! --------------- + +! tableau a recalculer a chaque pas de temps +! attention, ZDZZ est l'altitude entre deux niveaux (et pas l'�paisseur de la couche) + +! Inversion des niveaux + +DO JK = IKB , IKE, IKL + DO JL = IIB,IIE + IKK = IKE + 1 - JK + ZAPRSF(JL,JK) = PAPRSF(JL,IKK) + ZTKE (JL,JK) = PTKE (JL,IKK) + ZU (JL,JK) = PU (JL,IKK) + ZV (JL,JK) = PV (JL,IKK) + ENDDO +ENDDO + + +! AROME type initialisation + !initialisation de ZZZ +DO JK = IKB , IKE+1 + DO JL = IIB,IIE + IKK = IKE + 1 - JK + ZZZ(JL,JK) = PZZ(JL,IKK)*ZINVG + ENDDO +ENDDO + + +DO JL = IIB,IIE + ZZZ(JL,1) = 2*ZZZ(JL,2)-ZZZ(JL,3) +ENDDO +!initialisation de ZZZF +DO JK = IKB , IKE + DO JL = IIB,IIE + IKK = IKE + 1 - JK + ZZZF(JL,JK) = PZZF(JL,IKK)*ZINVG + ENDDO +ENDDO +DO JL = IIB,IIE + ZZZF(JL,1)=1.5*ZZZ(JL,2)-0.5*ZZZ(JL,3) + ZZZF(JL,IKE+1)=ZZZF(JL,IKE)+ (ZZZ(JL,IKE+1)-ZZZ(JL,IKE)) + ZDZZ(JL,1)=-999. +ENDDO + +DO JK = IKB , IKE+1 + DO JL = IIB,IIE + ZDZZ(JL,JK)=ZZZF(JL,JK)-ZZZF(JL,JK-1) + ENDDO +ENDDO + +! Inversion des niveaux +DO JL = IIB,IIE + DO JK = IKB , IKE, IKL + IKK = IKE + 1 - JK + ZEXNER(JL,JK)=(ZAPRSF(JL,JK)/RATM)**RKAPPA + ZTHETA(JL,JK)=PT(JL,IKK)/ZEXNER(JL,JK) + ZHRO(JL,JK)=ZAPRSF(JL,JK)/(PT(JL,IKK)*PR(JL,IKK)) + ZQDM(JL,JK)=(1.-PQV(JL,IKK)-PQL(JL,IKK)-PQI(JL,IKK)-PQR(JL,IKK)-PQS(JL,IKK)) + + ZHRODREF(JL,JK)=ZHRO(JL,JK)*ZQDM(JL,JK) + ZHRODJ(JL,JK)=PDELP(JL,IKK)*ZINVG + ZRM(JL,JK,1)=PQV(JL,IKK)/ZQDM(JL,JK) + ZRM(JL,JK,2)=PQL(JL,IKK)/ZQDM(JL,JK) + ZRM(JL,JK,3)=PQR(JL,IKK)/ZQDM(JL,JK) + ZRM(JL,JK,4)=PQI(JL,IKK)/ZQDM(JL,JK) + ZRM(JL,JK,5)=PQS(JL,IKK)/ZQDM(JL,JK) + + ZDPSG(JL,JK) = MAX(1.E-15,PDELP(JL,IKK)/RG) + +! Copy KLEV array into KLEV+2 array, or how to spend cpu time unnecessarily but that's the arome physics rule ! + ENDDO +ENDDO + +ZDUDT_TURB(KIDIA:KFDIA,:) = 0. +ZDVDT_TURB(KIDIA:KFDIA,:) = 0. +ZDRTDT_TURB(KIDIA:KFDIA,:) = 0. +ZDTHLDT_TURB(KIDIA:KFDIA,:) = 0. +ZDSVDT_TURB(KIDIA:KFDIA,:,:)= 0. + +ZSVM(:,:,:)=0. + + ZAPRSF (KIDIA:KFDIA,IKB-IKL) = ZAPRSF (KIDIA:KFDIA,IKB) + ZAPRSF (KIDIA:KFDIA,IKE+IKL) = ZAPRSF (KIDIA:KFDIA,IKE) + ZTKE (KIDIA:KFDIA,IKB-IKL) = ZTKE (KIDIA:KFDIA,IKB) + ZTKE (KIDIA:KFDIA,IKE+IKL) = ZTKE (KIDIA:KFDIA,IKE) + ZU (KIDIA:KFDIA,IKB-IKL) = ZU (KIDIA:KFDIA,IKB) + ZU (KIDIA:KFDIA,IKE+IKL) = ZU (KIDIA:KFDIA,IKE) + ZV (KIDIA:KFDIA,IKB-IKL) = ZV (KIDIA:KFDIA,IKB) + ZV (KIDIA:KFDIA,IKE+IKL) = ZV (KIDIA:KFDIA,IKE) + ZEXNER (KIDIA:KFDIA,IKB-IKL) = ZEXNER (KIDIA:KFDIA,IKB) + ZEXNER (KIDIA:KFDIA,IKE+IKL) = ZEXNER (KIDIA:KFDIA,IKE) + ZTHETA (KIDIA:KFDIA,IKB-IKL) = ZTHETA (KIDIA:KFDIA,IKB) + ZTHETA (KIDIA:KFDIA,IKE+IKL) = ZTHETA (KIDIA:KFDIA,IKE) + ZHRO (KIDIA:KFDIA,IKB-IKL) = ZHRO (KIDIA:KFDIA,IKB) + ZHRO (KIDIA:KFDIA,IKE+IKL) = ZHRO (KIDIA:KFDIA,IKE) + ZQDM (KIDIA:KFDIA,IKB-IKL) = ZQDM (KIDIA:KFDIA,IKB) + ZQDM (KIDIA:KFDIA,IKE+IKL) = ZQDM (KIDIA:KFDIA,IKE) + ZHRODREF(KIDIA:KFDIA,IKB-IKL) = ZHRODREF(KIDIA:KFDIA,IKB) + ZHRODREF(KIDIA:KFDIA,IKE+IKL) = ZHRODREF(KIDIA:KFDIA,IKE) + ZHRODJ (KIDIA:KFDIA,IKB-IKL) = ZHRODJ (KIDIA:KFDIA,IKB) + ZHRODJ (KIDIA:KFDIA,IKE+IKL) = ZHRODJ (KIDIA:KFDIA,IKE) + ZRM (KIDIA:KFDIA,IKB-IKL,1) = ZRM (KIDIA:KFDIA,IKB,1) + ZRM (KIDIA:KFDIA,IKE+IKL,1) = ZRM (KIDIA:KFDIA,IKE,1) + ZRM (KIDIA:KFDIA,IKB-IKL,2) = ZRM (KIDIA:KFDIA,IKB,2) + ZRM (KIDIA:KFDIA,IKE+IKL,2) = ZRM (KIDIA:KFDIA,IKE,2) + ZRM (KIDIA:KFDIA,IKB-IKL,3) = ZRM (KIDIA:KFDIA,IKB,3) + ZRM (KIDIA:KFDIA,IKE+IKL,3) = ZRM (KIDIA:KFDIA,IKE,3) + ZRM (KIDIA:KFDIA,IKB-IKL,4) = ZRM (KIDIA:KFDIA,IKB,4) + ZRM (KIDIA:KFDIA,IKE+IKL,4) = ZRM (KIDIA:KFDIA,IKE,4) + ZRM (KIDIA:KFDIA,IKB-IKL,5) = ZRM (KIDIA:KFDIA,IKB,5) + ZRM (KIDIA:KFDIA,IKE+IKL,5) = ZRM (KIDIA:KFDIA,IKE,5) + ZSVM (KIDIA:KFDIA,IKB-IKL,:) = ZSVM (KIDIA:KFDIA,IKB,:) + ZSVM (KIDIA:KFDIA,IKE+IKL,:) = ZSVM (KIDIA:KFDIA,IKE,:) + ZDUDT_TURB(KIDIA:KFDIA,IKB-IKL) = ZDUDT_TURB(KIDIA:KFDIA,IKB) + ZDUDT_TURB(KIDIA:KFDIA,IKE+IKL) = ZDUDT_TURB(KIDIA:KFDIA,IKE) + ZDVDT_TURB(KIDIA:KFDIA,IKB-IKL) = ZDVDT_TURB(KIDIA:KFDIA,IKB) + ZDVDT_TURB(KIDIA:KFDIA,IKE+IKL) = ZDVDT_TURB(KIDIA:KFDIA,IKE) + ZDTHLDT_TURB(KIDIA:KFDIA,IKB-IKL) = ZDTHLDT_TURB(KIDIA:KFDIA,IKB) + ZDTHLDT_TURB(KIDIA:KFDIA,IKE+IKL) = ZDTHLDT_TURB(KIDIA:KFDIA,IKE) + ZDRTDT_TURB(KIDIA:KFDIA,IKB-IKL) = ZDRTDT_TURB(KIDIA:KFDIA,IKB) + ZDRTDT_TURB(KIDIA:KFDIA,IKE+IKL) = ZDRTDT_TURB(KIDIA:KFDIA,IKE) + ZDSVDT_TURB(KIDIA:KFDIA,IKB-IKL,:)= ZDSVDT_TURB(KIDIA:KFDIA,IKB,:) + ZDSVDT_TURB(KIDIA:KFDIA,IKE+IKL,:)= ZDSVDT_TURB(KIDIA:KFDIA,IKE,:) + +DO JL = IIB,IIE + ZSFTH(JL) = -PSFTH(JL)/ZHRO(JL,IKB)/RCPD + ZSFRV(JL) = -PSFRV(JL)/ZHRO(JL,IKB) +ENDDO + +LLOMIXUV = .TRUE. +HMF_UPDRAFT = CMF_UPDRAFT +HMF_CLOUD = CMF_CLOUD +LLOMIXUV = LMIXUV +LLONOMIXLG = .FALSE. +ISV_LGBEG = 0 +ISV_LGEND = 0 +ITCOUNT = 1 +ZDT = TSPHY + + +! Mise � 0 des tendances + +ZDUDT_MF(:,:) = 0. +ZDVDT_MF(:,:) = 0. +ZDTHLDT_MF(:,:) = 0. +ZDRTDT_MF(:,:) = 0. + +!------------------------------------------------------------------------------ +! +! +!* 3. MULTIPLICATION PAR RHODJ +! POUR OBTENIR LES TERMES SOURCES DE MESONH +! +! ----------------------------------------------- + +! +!------------------------------------------------------------------------------ +! +! +!* 4. APPEL DE LA TURBULENCE MESONH +! +! --------------------------------- + + CALL SHALLOW_MF(KKA=IKA,KKU=IKU,KKL=IKL,KRR=IKR,KRRL=IKRL,KRRI=IKRI, & + HMF_UPDRAFT=HMF_UPDRAFT, HMF_CLOUD=HMF_CLOUD,HFRAC_ICE='N',OMIXUV=LLOMIXUV, & + ONOMIXLG=LLONOMIXLG,KSV_LGBEG=ISV_LGBEG,KSV_LGEND=ISV_LGEND, & + PIMPL_MF=PIMPL, PTSTEP=ZDT, & + PDZZ=ZDZZ,PZZ=ZZZ, & + PRHODJ=ZHRODJ,PRHODREF=ZHRODREF, & + PPABSM=ZAPRSF,PEXNM=ZEXNER, & + PSFTH=ZSFTH,PSFRV=ZSFRV, & + PTHM=ZTHETA,PRM=ZRM,PUM=ZU,PVM=ZV,PTKEM=ZTKE,PSVM=ZSVM, & +! Output + PDUDT_MF=ZDUDT_MF,PDVDT_MF=ZDVDT_MF, & + PDTHLDT_MF=ZDTHLDT_MF,PDRTDT_MF=ZDRTDT_MF,PDSVDT_MF=ZSVDT_MF, & + PSIGMF=ZSIGMF,PRC_MF=ZRC_MF,PRI_MF=ZRI_MF,PCF_MF=ZCF_MF,PFLXZTHVMF=ZFLXZTHVMF, & + PFLXZTHMF=ZFLXZTHMF,PFLXZRMF=ZFLXZRMF,PFLXZUMF=ZFLXZUMF,PFLXZVMF=ZFLXZVMF,& + PTHL_UP=ZTHL_UP,PRT_UP=ZRT_UP,PRV_UP=ZRV_UP,PRC_UP=ZRC_UP,PRI_UP=ZRI_UP, & + PU_UP=ZU_UP, PV_UP=ZV_UP, PTHV_UP=ZTHV_UP, PW_UP=ZW_UP, & + PFRAC_UP=ZFRAC_UP,PEMF=ZEMF,PDETR=ZDETR,PENTR=ZENTR, & + KKLCL=IKLCL,KKETL=IKETL,KKCTL=IKCTL, & +! + PDX=0., PDY=0.) + + +! Conversion des tendances de theta en tendance de cpT +! et conversion en qi en multipliant par qd +! Puis calcul des flux + +ZFQ_MF(:,:) = 0. +ZFH_MF(:,:) = 0. +ZFU_MF(:,:) = 0. +ZFV_MF(:,:) = 0. + + +ZVMD=RCPV-RCPD + +DO JL = IIB,IIE + DO JK = IKE , IKB, -IKL ! Loop from top to bottom + + IKK = IKE + 1 - JK + + ZFQ_MF(JL,JK) = ZFQ_MF(JL,JK+IKL) - ZDPSG(JL,JK)*ZDRTDT_MF(JL,JK)*ZQDM(JL,JK) + ZTDCP=ZVMD*ZDRTDT_MF(JL,JK) + + + + ZFH_MF(JL,JK) = ZFH_MF(JL,JK+IKL) - ZDPSG(JL,JK) & + & * (ZDTHLDT_MF(JL,JK)*ZEXNER(JL,JK)*(PCP(JL,IKK)+TSPHY*ZTDCP)+PT(JL,IKK)*ZTDCP) + +! ZFH_MF(JL,JK) = ZFH_MF(JL,JK+IKL) - ZDPSG(JL,JK) & +! & * (ZDTHLDT_MF(JL,JK)*ZEXNER(JL,JK)*PCP(JL,IKK)+PT(JL,IKK)*ZTDCP) + + ZFU_MF(JL,JK) = ZFU_MF(JL,JK+IKL) - ZDPSG(JL,JK)*ZDUDT_MF(JL,JK) + ZFV_MF(JL,JK) = ZFV_MF(JL,JK+IKL) - ZDPSG(JL,JK)*ZDVDT_MF(JL,JK) + ENDDO +ENDDO + +ZRC_UP(:,:) = ZRC_UP(:,:)*ZFRAC_UP(:,:) +ZRI_UP(:,:) = ZRI_UP(:,:)*ZFRAC_UP(:,:) +PRODTH_CVPP(:,:) = 0. + + +! stockage dans les flux turbulents (Inversion des niveaux !) + +DO JL = IIB,IIE + DO JK = IKE , IKB, -IKL ! Loop from top to bottom + IKK = IKE + 1 - JK + PDIFTQ(JL,IKK) = PDIFTQ(JL,IKK) + ZFQ_MF(JL,JK) + PDIFTS(JL,IKK) = PDIFTS(JL,IKK) + ZFH_MF(JL,JK) + PSTRTU(JL,IKK) = PSTRTU(JL,IKK) + ZFU_MF(JL,JK) + PSTRTV(JL,IKK) = PSTRTV(JL,IKK) + ZFV_MF(JL,JK) + PRODTH_CVPP(JL,IKK) = RG/ZTHETA(JL,JK)*ZFLXZTHVMF(JL,JK) + +! Shallow cloud information + PQLI (JL,IKK) = (ZRC_MF(JL,JK)+ZRI_MF(JL,JK))/(1.+ZRT_UP(JL,JK)) ! with HFRAC_ICE='N', ZRI_MF=0 + KNLAB (JL,IKK) = INT(MAX(0.,SIGN(1.,PQLI(JL,IKK)-1.E-8))) + PNEB (JL,IKK) = ZCF_MF(JL,JK) + PMF_UP(JL,IKK) = -ZEMF(JL,JK)/ZHRODREF(JL,JK) ! <== On ne sort pas le flux de masse mais +! ! ce dont on aura besoin dans ACDIFV1 !!!!!!! + ENDDO +ENDDO + +END SUBROUTINE ARP_SHALLOW_MF diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files index 71db2b81c323a54ef94ab64ba34ed0d9e9a2821f..f4443eaf9130797e1e582adcae398ecca54b5a0b 100644 --- a/src/arome/gmkpack_ignored_files +++ b/src/arome/gmkpack_ignored_files @@ -104,3 +104,28 @@ phyex/micro/modd_spp_type.F90 phyex/micro/modd_cst.F90 phyex/micro/modi_ini_cst.F90 phyex/micro/ini_cst.F90 +phyex/turb/modi_compute_function_thermo_mf.F90 +phyex/turb/compute_function_thermo_mf.F90 +phyex/turb/modd_cmfshall.F90 +phyex/turb/mf_turb_expl.F90 +phyex/turb/modi_mf_turb_expl.F90 +phyex/turb/mf_turb.F90 +phyex/turb/modi_mf_turb.F90 +phyex/turb/compute_mf_cloud.F90 +phyex/turb/compute_mf_cloud_bigaus.F90 +phyex/turb/compute_mf_cloud_direct.F90 +phyex/turb/compute_mf_cloud_stat.F90 +phyex/turb/modi_compute_mf_cloud.F90 +phyex/turb/modi_compute_mf_cloud_bigaus.F90 +phyex/turb/modi_compute_mf_cloud_direct.F90 +phyex/turb/modi_compute_mf_cloud_stat.F90 +phyex/turb/compute_bl89_ml.F90 +phyex/turb/modi_compute_bl89_ml.F90 +phyex/turb/compute_entr_detr.F90 +phyex/turb/modi_compute_entr_detr.F90 +phyex/turb/compute_updraft_raha.F90 +phyex/turb/modi_compute_updraft_raha.F90 +phyex/turb/modi_compute_updraft_rhcj10.F90 +phyex/turb/compute_updraft_rhcj10.F90 +phyex/turb/modi_compute_updraft.F90 +phyex/turb/compute_updraft.F90 diff --git a/src/arome/turb/ini_cmfshall.F90 b/src/arome/turb/ini_cmfshall.F90 index 6842cea3ff764e9b055b3e6ecff8dad83f52596a..be8bbfc007e971b855346474292edb41e2ae88a5 100644 --- a/src/arome/turb/ini_cmfshall.F90 +++ b/src/arome/turb/ini_cmfshall.F90 @@ -12,7 +12,7 @@ !! PURPOSE !! ------- ! The purpose of this routine is to initialize the mass flux -! scheme constants that are stored in module MODD_CMFSHALL +! scheme constants that are stored in module MODD_PARAM_MFSHALL_n ! !! METHOD !! ------ @@ -36,12 +36,13 @@ !! MODIFICATIONS !! ------------- !! S. Riette april 2011 : XALPHA and XSIGMA added +!! S. Riette Jan 2022: Merge with Méso-NH: MODD_MCFSHALL -> MODD_PARAM_MFSHALL_n !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_CMFSHALL +USE MODD_PARAM_MFSHALL_n ! IMPLICIT NONE @@ -76,6 +77,9 @@ REAL, INTENT(IN) :: PLAMBDA ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('INI_CMFSHALL',0,ZHOOK_HANDLE) + +CALL PARAM_MFSHALL_GOTO_MODEL(1, 1) + XALP_PERT = PALP_PERT ! coefficient for the perturbation of ! theta_l and r_t at the first level of ! the updraft @@ -111,7 +115,7 @@ XR = PR ! Aspect ratio of updraft ! Thermodynamic parameter -XLAMBDA = PLAMBDA ! Lambda to compute ThetaS1 from ThetaL +XLAMBDA_MF = PLAMBDA ! Lambda to compute ThetaS1 from ThetaL IF (LHOOK) CALL DR_HOOK('INI_CMFSHALL',1,ZHOOK_HANDLE) END SUBROUTINE INI_CMFSHALL diff --git a/src/arome/turb/modd_cmfshall.F90 b/src/arome/turb/modd_cmfshall.F90 deleted file mode 100644 index 1d4819faefd4cfe476ec8b6e0f1c71b73c72fadf..0000000000000000000000000000000000000000 --- a/src/arome/turb/modd_cmfshall.F90 +++ /dev/null @@ -1,76 +0,0 @@ -! ######spl - MODULE MODD_CMFSHALL -! ############################# -! -!!**** *MODD_CMFSHALL* - Declaration of Mass flux scheme constants -!! -!! PURPOSE -!! ------- -!! The purpose of this declarative module is to declare some -!! constants for Mass Flux Scheme in the shallow convection -!! parameterization. -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! S. Malardel, J. Pergaud (Meteo France) -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/02/07 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ - -IMPLICIT NONE - -REAL,SAVE :: XALP_PERT ! coefficient for the perturbation of - ! theta_l and r_t at the first level of - ! the updraft -REAL,SAVE :: XABUO ! coefficient of the buoyancy term in the w_up equation -REAL,SAVE :: XBENTR ! coefficient of the entrainment term in the w_up equation -REAL,SAVE :: XBDETR ! coefficient of the detrainment term in the w_up equation -REAL,SAVE :: XCMF ! coefficient for the mass flux at the first level - ! of the updraft (closure) -REAL,SAVE :: XENTR_MF ! entrainment constant (m/Pa) = 0.2 (m) -REAL,SAVE :: XCRAD_MF ! cloud radius in cloudy part -REAL,SAVE :: XENTR_DRY ! coefficient for entrainment in dry part -REAL,SAVE :: XDETR_DRY ! coefficient for detrainment in dry part -REAL,SAVE :: XDETR_LUP ! coefficient for detrainment in dry part -REAL,SAVE :: XKCF_MF ! coefficient for cloud fraction -REAL,SAVE :: XKRC_MF ! coefficient for convective rc -REAL,SAVE :: XTAUSIGMF -REAL,SAVE :: XPRES_UV ! coefficient for pressure term in wind - ! mixing - -REAL,SAVE :: XALPHA_MF ! coefficient for cloudy fraction -REAL,SAVE :: XSIGMA_MF ! coefficient for sigma computation - -REAL,SAVE :: XFRAC_UP_MAX! maximum Updraft fraction - - -! Parameter for Rio et al (2010) formulation for entrainment and detrainment - -REAL,SAVE :: XA1 ! a1 -REAL,SAVE :: XB ! b -REAL,SAVE :: XC ! c -REAL,SAVE :: XBETA1 ! beta1 - -! Parameters for closure assumption of Hourdin et al 2002 - -REAL,SAVE :: XR ! Aspect ratio of updraft - -! Thermodynamic parameter - -REAL,SAVE :: XLAMBDA ! Lambda to compute ThetaS1 from ThetaL - -END MODULE MODD_CMFSHALL diff --git a/src/arome/turb/compute_updraft_rhcj10.F90 b/src/arome/turb/mode_compute_updraft_rhcj10.F90 similarity index 68% rename from src/arome/turb/compute_updraft_rhcj10.F90 rename to src/arome/turb/mode_compute_updraft_rhcj10.F90 index c6d108cf8fe3d7b6ffc3a1d82615587028a2beb7..bac5e7f1392f91d9ecc949a76fcfbca35989f890 100644 --- a/src/arome/turb/compute_updraft_rhcj10.F90 +++ b/src/arome/turb/mode_compute_updraft_rhcj10.F90 @@ -1,5 +1,16 @@ +!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- ! ######spl - SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & + MODULE MODE_COMPUTE_UPDRAFT_RHCJ10 +! ########################### +! +IMPLICIT NONE +CONTAINS +! +SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & OENTR_DETR,OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & PZZ,PDZZ, & @@ -13,9 +24,6 @@ PEMF,PDETR,PENTR, & PBUO_INTEG,KKLCL,KKETL,KKCTL, & PDEPTH ) - - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! ################################################################# !! !!**** *COMPUTE_UPDRAFT_RHCJ10* - calculates caracteristics of the updraft @@ -42,21 +50,25 @@ !! AUTHOR !! ------ !! Y. Bouteloup (2012) -!! R. Honert Janv 2013 ==> corection of some coding bugs +!! R. Honert Janv 2013 ==> corection of some bugs !! R. El Khatib 15-Oct-2014 Optimization !! Q.Rodier 01/2019 : support RM17 mixing length !! -------------------------------------------------------------------------- -! + +! WARNING ==> This updraft is not yet ready to use scalar variables + !* 0. DECLARATIONS ! ------------ ! USE MODD_CST -USE MODD_CMFSHALL +USE MODD_PARAM_MFSHALL_n USE MODD_TURB_n, ONLY : CTURBLEN USE MODI_TH_R_FROM_THL_RT_1D USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF -USE MODI_COMPUTE_BL89_ML +USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK IMPLICIT NONE @@ -64,13 +76,12 @@ IMPLICIT NONE !* 1.1 Declaration of Arguments ! ! -! INTEGER, INTENT(IN) :: KKA ! near ground array index INTEGER, INTENT(IN) :: KKB ! near ground physical index INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer @@ -78,8 +89,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient -!REAL, DIMENSION(:,:), INTENT(IN) :: PEXNMH ! Exner on flux level -!REAL, DIMENSION(:,:), INTENT(INOUT) :: PCPTPPHY_UP ! CpT+PHY of updraft REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta,rv,(u,v) parallel to the orography @@ -90,7 +99,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt - +! REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt @@ -116,7 +125,6 @@ INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud ! 1.2 Declaration of local variables ! -! ! Mean environment variables at t-dt at flux point REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of ! updraft environnement @@ -139,7 +147,7 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds -REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav' +REAL :: ZWTHVSURF ! Surface w'thetav' REAL :: ZRVORD ! RV/RD @@ -159,7 +167,6 @@ LOGICAL :: GLMIX LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1 LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2 - INTEGER :: ITEST REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI @@ -173,7 +180,6 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft REAL, DIMENSION(SIZE(PTHM,1)) :: ZQTM,ZQT_UP - REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process REAL :: ZTMAX,ZRMAX, ZEPS ! control value @@ -182,7 +188,6 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE) - ! Thresholds for the perturbation of ! theta_l and r_t at the first level of the updraft @@ -195,6 +200,7 @@ ZEPS=1.E-15 ! Initialisation of the constants ZRVORD = (XRV / XRD) +! depth are different in compute_updraft (3000. and 4000.) ==> impact is small ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed @@ -231,13 +237,11 @@ PTHV_UP(:,:)=0. PBUO_INTEG=0. ZBUO =0. -!no ice cloud coded yet +!no ice cloud coded yet PRI_UP(:,:)=0. PFRAC_ICE_UP(:,:)=0. PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used - - ! Initialisation of environment variables at t-dt ! variables at flux level @@ -247,11 +251,15 @@ ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL) ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL) ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL) -!DO JSV=1,ISV -! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE +! This updraft is not yet ready to use scalar variables +!DO JSV=1,ISV +! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE +! *** SR merge AROME/Méso-nh: following two lines come from the AROME version ! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV)) ! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV) -!END DO +! *** the following single line comes from the Meso-NH version +! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)) +!END DO ! Initialisation of updraft characteristics PTHL_UP(:,:)=ZTHLM_F(:,:) @@ -259,6 +267,7 @@ PRT_UP(:,:)=ZRTM_F(:,:) PU_UP(:,:)=ZUM_F(:,:) PV_UP(:,:)=ZVM_F(:,:) PSV_UP(:,:,:)=0. +! This updraft is not yet ready to use scalar variables !IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then ! PSV_UP(:,:,:)=ZSVM_F(:,:,:) !ENDIF @@ -267,11 +276,11 @@ PSV_UP(:,:,:)=0. ! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF) DO JI=1,IIJU -PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) -PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) - -ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB)) -ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA*ZQT_UP(JI)) + PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) + PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) + + ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB)) + ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JI)) ENDDO ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL) @@ -281,9 +290,9 @@ ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL) ! thetav at mass and flux levels DO JK=1,IKU -DO JI=1,IIJU -ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK))) -ENDDO + DO JI=1,IIJU + ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK))) + ENDDO ENDDO PTHV_UP(:,:)= ZTHVM_F(:,:) @@ -302,13 +311,13 @@ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), & PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:)) DO JI=1,IIJU -! compute updraft thevav and buoyancy term at KKB level -PTHV_UP(JI,KKB) = ZTH_UP(JI,KKB)*((1+ZRVORD*PRV_UP(JI,KKB))/(1+PRT_UP(JI,KKB))) -! compute mean rsat in updraft -PRSAT_UP(JI,KKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,KKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,KKB) + ! compute updraft thevav and buoyancy term at KKB level + PTHV_UP(JI,KKB) = ZTH_UP(JI,KKB)*((1+ZRVORD*PRV_UP(JI,KKB))/(1+PRT_UP(JI,KKB))) + ! compute mean rsat in updraft + PRSAT_UP(JI,KKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,KKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,KKB) ENDDO -!Tout est commente pour tester dans un premier temps la s�paration en deux de la +!Tout est commente pour tester dans un premier temps la separation en deux de la ! boucle verticale, une pour w et une pour PEMF ZG_O_THVREF=XG/ZTHVM_F @@ -316,9 +325,9 @@ ZG_O_THVREF=XG/ZTHVM_F ! Calcul de la fermeture de Julien Pergaut comme limite max de PHY DO JK=KKB,KKE-KKL,KKL ! Vertical loop -DO JI=1,IIJU - ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level -ENDDO + DO JI=1,IIJU + ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level + ENDDO ENDDO ! compute L_up @@ -341,21 +350,21 @@ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), ZLUP(:)=MAX(ZLUP(:),1.E-10) DO JI=1,IIJU -! Compute Buoyancy flux at the ground -ZWTHVSURF(JI) = (ZTHVM_F(JI,KKB)/ZTHM_F(JI,KKB))*PSFTH(JI)+ & - (0.61*ZTHM_F(JI,KKB))*PSFRV(JI) -! Mass flux at KKB level (updraft triggered if PSFTH>0.) - -IF (ZWTHVSURF(JI)>0.010) THEN - PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF(JI)*ZLUP(JI))**(1./3.) - PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX) - PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB)) -! ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2 - GTEST(JI)=.TRUE. -ELSE - PEMF(JI,KKB) =0. - GTEST(JI)=.FALSE. -ENDIF + ! Compute Buoyancy flux at the ground + ZWTHVSURF = (ZTHVM_F(JI,KKB)/ZTHM_F(JI,KKB))*PSFTH(JI)+ & + (0.61*ZTHM_F(JI,KKB))*PSFRV(JI) + + ! Mass flux at KKB level (updraft triggered if PSFTH>0.) + IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!! + PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF*ZLUP(JI))**(1./3.) + PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX) + PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB)) + ! ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2 + GTEST(JI)=.TRUE. + ELSE + PEMF(JI,KKB) =0. + GTEST(JI)=.FALSE. + ENDIF ENDDO @@ -375,14 +384,12 @@ GTESTLCL(:)=.FALSE. ZW_MAX(:) = 0. ZZTOP(:) = 0. -!GTEST(:) = (ZW_UP2(:,KKB)>ZEPS) - DO JK=KKB,KKE-KKL,KKL ! IF the updraft top is reached for all column, stop the loop on levels -! ITEST=COUNT(GTEST) -! IF (ITEST==0) CYCLE + !ITEST=COUNT(GTEST) + !IF (ITEST==0) CYCLE ! Computation of entrainment and detrainment with KF90 ! parameterization in clouds and LR01 in subcloud layer @@ -391,10 +398,10 @@ DO JK=KKB,KKE-KKL,KKL ! to find the LCL (check if JK is LCL or not) DO JI=1,IIJU - IF ((PRC_UP(JI,JK)+PRI_UP(JI,JK)>0.).AND.(.NOT.(GTESTLCL(JI)))) THEN + IF ((PRC_UP(JI,JK)+PRI_UP(JI,JK)>0.).AND.(.NOT.(GTESTLCL(JI)))) THEN KKLCL(JI) = JK GTESTLCL(JI)=.TRUE. - ENDIF + ENDIF ENDDO @@ -421,46 +428,43 @@ DO JK=KKB,KKE-KKL,KKL ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ZTEST(JI) = XA1*ZBUO(JI,JK) - XB*ZW_UP2(JI,JK) -! Ancien calcul de la vitesse - + ! Ancien calcul de la vitesse ZCOE(JI) = ZDZ(JI) IF (ZTEST(JI)>0.) THEN ZCOE(JI) = ZDZ(JI)/(1.+ XBETA1) ENDIF -! Calcul de la vitesse - + ! Convective Vertical speed computation ZWCOE(JI) = (1.-XB*ZCOE(JI))/(1.+XB*ZCOE(JI)) ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+XB*ZCOE(JI)) -! Second Rachel bug correction (XA1 has been forgotten) + ! Second Rachel bug correction (XA1 has been forgotten) ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + XA1*ZBUO(JI,JK)*ZBUCOE(JI) ) ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+KKL))) ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+KKL)+ZW_UP2(JI,JK))) -! Entrainement et detrainement + ! Entrainement and detrainement -! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small) - PENTR(JI,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-XB)) - ZDETR_BUO(JI) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)) - ZDETR_RT(JI) = XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI)) - PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI) + ! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small) + PENTR(JI,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-XB)) + ZDETR_BUO(JI) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)) + ZDETR_RT(JI) = XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI)) + PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI) -! If the updraft did not stop, compute cons updraft characteritics at jk+1 - - ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL)) - ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !& + ! If the updraft did not stop, compute cons updraft characteritics at jk+1 + ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL)) + ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !& -! Utilisation de thetaS - ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK)) - ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA*ZQTM(JI)) - ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) & - /(1.+0.5*ZMIX2(JI)) - PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & - /(1.+0.5*ZMIX2(JI)) - ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL)) - PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA*ZQT_UP(JI)) + ! Utilisation de thetaS + ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK)) + ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA_MF*ZQTM(JI)) + ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) & + /(1.+0.5*ZMIX2(JI)) + PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & + /(1.+0.5*ZMIX2(JI)) + ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL)) + PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JI)) ENDIF ! GTEST ENDDO @@ -468,34 +472,36 @@ DO JK=KKB,KKE-KKL,KKL IF(OMIXUV) THEN IF(JK/=KKB) THEN DO JI=1,IIJU - IF(GTEST(JI)) THEN - PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & - 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& - ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)+& - (PUM(JI,JK)-PUM(JI,JK-KKL))/PDZZ(JI,JK)) ) & - /(1+0.5*ZMIX2(JI)) - PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & - 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& - ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)+& - (PVM(JI,JK)-PVM(JI,JK-KKL))/PDZZ(JI,JK)) ) & - /(1+0.5*ZMIX2(JI)) - ENDIF + IF(GTEST(JI)) THEN + PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)+& + (PUM(JI,JK)-PUM(JI,JK-KKL))/PDZZ(JI,JK)) ) & + /(1+0.5*ZMIX2(JI)) + PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)+& + (PVM(JI,JK)-PVM(JI,JK-KKL))/PDZZ(JI,JK)) ) & + /(1+0.5*ZMIX2(JI)) + ENDIF ENDDO ELSE DO JI=1,IIJU - IF(GTEST(JI)) THEN - PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & - 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& - ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)) ) & - /(1+0.5*ZMIX2(JI)) - PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & - 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& - ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)) ) & - /(1+0.5*ZMIX2(JI)) - ENDIF + IF(GTEST(JI)) THEN + PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)) ) & + /(1+0.5*ZMIX2(JI)) + PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)) ) & + /(1+0.5*ZMIX2(JI)) + ENDIF ENDDO ENDIF ENDIF + +! This updraft is not yet ready to use scalar variables ! DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE ! WHERE(GTEST) @@ -514,50 +520,51 @@ DO JK=KKB,KKE-KKL,KKL ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:)) DO JI=1,IIJU - IF(GTEST(JI)) THEN - ZT_UP(JI) = ZTH_UP(JI,JK+KKL)*PEXNM(JI,JK+KKL) - ZCP(JI) = XCPD + XCL * ZRC_UP(JI) - ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL) - PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) - PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL)) - PRV_UP(JI,JK+KKL)=ZRV_UP(JI) - PRI_UP(JI,JK+KKL)=ZRI_UP(JI) - PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL) - PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL) -! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 -! PTHV_UP(:,JK+KKL) = PTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL))) + IF(GTEST(JI)) THEN + ZT_UP(JI) = ZTH_UP(JI,JK+KKL)*PEXNM(JI,JK+KKL) + ZCP(JI) = XCPD + XCL * ZRC_UP(JI) + ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL) + PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) + PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL)) + PRV_UP(JI,JK+KKL)=ZRV_UP(JI) + PRI_UP(JI,JK+KKL)=ZRI_UP(JI) + PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL) + PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL) + + ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 + !PTHV_UP(:,JK+KKL) = PTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL))) PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*(1.+0.608*PRV_UP(JI,JK+KKL) - PRC_UP(JI,JK+KKL)) -! A corriger pour utiliser q et non r !!!! - ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK)) - ENDIF + ! A corriger pour utiliser q et non r !!!! + ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK)) + ENDIF ENDDO DO JI=1,IIJU - IF(GTEST(JI)) THEN - PEMF(JI,JK+KKL)=PEMF(JI,JK)*EXP(ZMIX1(JI)) - ENDIF + IF(GTEST(JI)) THEN + PEMF(JI,JK+KKL)=PEMF(JI,JK)*EXP(ZMIX1(JI)) + ENDIF ENDDO DO JI=1,IIJU - IF(GTEST(JI)) THEN -! Updraft fraction must be smaller than XFRAC_UP_MAX - PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX,PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL))) - PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL)) - ENDIF + IF(GTEST(JI)) THEN + ! Updraft fraction must be smaller than XFRAC_UP_MAX + PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX, & + &PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL))) + PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL)) + ENDIF ENDDO ! Test if the updraft has reach the ETL DO JI=1,IIJU - IF (GTEST(JI).AND.(PBUO_INTEG(JI,JK)<=0.)) THEN + IF (GTEST(JI) .AND. (PBUO_INTEG(JI,JK)<=0.)) THEN KKETL(JI) = JK+KKL - ENDIF + ENDIF ENDDO ! Test is we have reached the top of the updraft - DO JI=1,IIJU - IF (GTEST(JI).AND.((ZW_UP2(JI,JK+KKL)<=ZEPS).OR.(PEMF(JI,JK+KKL)<=ZEPS))) THEN + IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+KKL)<=ZEPS).OR.(PEMF(JI,JK+KKL)<=ZEPS))) THEN ZW_UP2 (JI,JK+KKL)=ZEPS PEMF (JI,JK+KKL)=0. GTEST (JI) =.FALSE. @@ -569,13 +576,11 @@ DO JK=KKB,KKE-KKL,KKL PTHV_UP (JI,JK+KKL)=ZTHVM_F(JI,JK+KKL) PFRAC_UP (JI,JK+KKL)=0. KKCTL (JI) =JK+KKL - - ENDIF + ENDIF ENDDO ENDDO ! Fin de la boucle verticale - PW_UP(:,:)=SQRT(ZW_UP2(:,:)) PEMF(:,KKB) =0. @@ -594,14 +599,15 @@ GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU ) ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU) ZCOEF(:,:)=MIN(MAX(ZCOEF(:,:),0.),1.) DO JK=1, IKU -DO JI=1,IIJU -IF (GWORK2(JI,JK)) THEN - PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK) - PFRAC_UP(JI,JK) = PFRAC_UP(JI,JK) * ZCOEF(JI,JK) -ENDIF -ENDDO + DO JI=1,IIJU + IF (GWORK2(JI,JK)) THEN + PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK) + PFRAC_UP(JI,JK) = PFRAC_UP(JI,JK) * ZCOEF(JI,JK) + ENDIF + ENDDO ENDDO IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10 +END MODULE MODE_COMPUTE_UPDRAFT_RHCJ10 diff --git a/src/arome/turb/modi_compute_bl89_ml.F90 b/src/arome/turb/modi_compute_bl89_ml.F90 deleted file mode 100644 index c42759094d59acf316dad60bd0f7ae0b13fa7a31..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_bl89_ml.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_BL89_ML -! ########################### - -INTERFACE - -! ################################################################### - SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, & - PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK) -! ################################################################### - -!* 1.1 Declaration of Arguments - -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels -REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume -REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point -REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels -INTEGER, INTENT(IN) :: KK ! index of departure level -LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or - ! downward (false) mixing length -LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level -REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length -REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length - -END SUBROUTINE COMPUTE_BL89_ML - -END INTERFACE -! -END MODULE MODI_COMPUTE_BL89_ML diff --git a/src/arome/turb/modi_compute_entr_detr.F90 b/src/arome/turb/modi_compute_entr_detr.F90 deleted file mode 100644 index c742ec8a408e83df107ccf9bf72c262d5d9f7e48..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_entr_detr.F90 +++ /dev/null @@ -1,62 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_ENTR_DETR -! ############################## -! -INTERFACE -! - SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,HFRAC_ICE, & - PFRAC_ICE,PRHODREF,PPRE_MINUS_HALF,& - PPRE_PLUS_HALF,PZZ,PDZZ,& - PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,& - PTHL_UP,PRT_UP,PLUP,& - PRC_UP,PRI_UP,PTHV_UP,& - PRSAT_UP,PRC_MIX,PRI_MIX, & - PENTR,PDETR,PENTR_CLD,PDETR_CLD,& - PBUO_INTEG_DRY,PBUO_INTEG_CLD,& - PPART_DRY) - -! -! -! -INTEGER, INTENT(IN) :: KK ! near ground physical index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST -LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation -CHARACTER*1, INTENT(IN) :: HFRAC_ICE -REAL, DIMENSION(:) ,INTENT(IN) :: PFRAC_ICE - -! -! prognostic variables at t- deltat -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref -REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK -REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment -! -! -! thermodynamical variables which are transformed in conservative var. -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio -REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2 -REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground -REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content -REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft -REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft -REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content -REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY,PBUO_INTEG_CLD ! Integrated Buoyancy -REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY -! -! -END SUBROUTINE COMPUTE_ENTR_DETR - -END INTERFACE -! -END MODULE MODI_COMPUTE_ENTR_DETR diff --git a/src/arome/turb/modi_compute_mf_cloud.F90 b/src/arome/turb/modi_compute_mf_cloud.F90 deleted file mode 100644 index 059f466302adc75d9ff5617b1d58763c6fcf01b6..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_mf_cloud.F90 +++ /dev/null @@ -1,53 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD -! ############################ -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,& - PFRAC_ICE, & - PRC_UP,PRI_UP,PEMF, & - PTHL_UP, PRT_UP, PFRAC_UP, & - PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, & - PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, & - PDZZ, PZZ, KKLCL, & - PPABSM, PRHODREF, & - PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH ) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content and -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! cloud fraction for MF scheme -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud - -END SUBROUTINE COMPUTE_MF_CLOUD - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD diff --git a/src/arome/turb/modi_compute_mf_cloud_bigaus.F90 b/src/arome/turb/modi_compute_mf_cloud_bigaus.F90 deleted file mode 100644 index 9be4f5548f255fa6d0737f488cd0b5ab61636b62..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_mf_cloud_bigaus.F90 +++ /dev/null @@ -1,37 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS -! ################################### -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - PRC_UP, PRI_UP, PEMF, PDEPTH,& - PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& - PRTM, PTHM, PTHVM,& - PDZZ, PZZ, PRHODREF,& - PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme - -END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS diff --git a/src/arome/turb/modi_compute_mf_cloud_direct.F90 b/src/arome/turb/modi_compute_mf_cloud_direct.F90 deleted file mode 100644 index d58977f51bbdb0d16c2a7e1ae192a90e734e1bff..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_mf_cloud_direct.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_DIRECT -! ################################### -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKB, KKE, KKL, & - &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,& - &PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKB ! near groud physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud) -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme - -END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_DIRECT diff --git a/src/arome/turb/modi_compute_mf_cloud_stat.F90 b/src/arome/turb/modi_compute_mf_cloud_stat.F90 deleted file mode 100644 index 94d9b5b2e6df5d24bc1ad9d232a15ae175780c21..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_mf_cloud_stat.F90 +++ /dev/null @@ -1,42 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_STAT -! ############################ -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,& - &PFRAC_ICE,& - &PTHLM, PRTM, PPABSM, PRM,& - &PDZZ, PTHM, PEXNM,& - &PEMF, PTHL_UP, PRT_UP,& - &PSIGMF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1 -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme - - -END SUBROUTINE COMPUTE_MF_CLOUD_STAT - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_STAT diff --git a/src/arome/turb/modi_compute_updraft.F90 b/src/arome/turb/modi_compute_updraft.F90 deleted file mode 100644 index 81f2363391efe31d55677362d3bc344e90f2b82e..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_updraft.F90 +++ /dev/null @@ -1,79 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_UPDRAFT -! ########################### -! -INTERFACE -! -! ################################################################# - SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM,PTKEM, & - PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH) -! ################################################################# -! -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! entrainment, detrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT diff --git a/src/arome/turb/modi_compute_updraft_raha.F90 b/src/arome/turb/modi_compute_updraft_raha.F90 deleted file mode 100644 index be726b2c80e027078c050676199474803e5f12f6..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_updraft_raha.F90 +++ /dev/null @@ -1,80 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_UPDRAFT_RAHA -! ########################### -! -INTERFACE -! - SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM, PTKEM, & - PEXNM,PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) -! ################################################################# -!! - -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt - -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! detrainment,entrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT_RAHA - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT_RAHA diff --git a/src/arome/turb/modi_compute_updraft_rhcj10.F90 b/src/arome/turb/modi_compute_updraft_rhcj10.F90 deleted file mode 100644 index 74cfccd50036695b603181e1742c53ec670b5ad8..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_compute_updraft_rhcj10.F90 +++ /dev/null @@ -1,80 +0,0 @@ -! ######spl - MODULE MODI_COMPUTE_UPDRAFT_RHCJ10 -! ########################### -! -INTERFACE -! - SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM, PTKEM, & - PEXNM,PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) -! ################################################################# -!! - -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt - -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! detrainment,entrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10 - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT_RHCJ10 diff --git a/src/arome/turb/modi_mf_turb.F90 b/src/arome/turb/modi_mf_turb.F90 deleted file mode 100644 index e3dbf894b10da9093764fa0f749d017638b0a402..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_mf_turb.F90 +++ /dev/null @@ -1,77 +0,0 @@ -! ######spl - MODULE MODI_MF_TURB -! ###################### -! -INTERFACE -! ################################################################# - SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL, PTSTEP, PTSTEP_MET, PTSTEP_SV, & - PDZZ, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, & - PTHLDT,PRTDT,PUDT,PVDT,PSVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, & - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & - PFLXZSVMF ) - -! ################################################################# -! -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise - -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, INTENT(IN) :: PIMPL ! degree of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables -REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables -! -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! scalar variables at t-dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT -! Tendencies of scalar variables -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT - - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF - -REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF - -END SUBROUTINE MF_TURB - -END INTERFACE -! -END MODULE MODI_MF_TURB diff --git a/src/arome/turb/modi_mf_turb_expl.F90 b/src/arome/turb/modi_mf_turb_expl.F90 deleted file mode 100644 index 768afa201393af341bb8bbeecab7d13486f0a8c2..0000000000000000000000000000000000000000 --- a/src/arome/turb/modi_mf_turb_expl.F90 +++ /dev/null @@ -1,63 +0,0 @@ -! ######spl - MODULE MODI_MF_TURB_EXPL -! ###################### -! -INTERFACE -! ################################################################# - SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM, & - PTHLDT,PRTDT,PUDT,PVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & - PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) - -! ################################################################# -! -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where -!REAL, DIMENSION(:,:), INTENT(IN) :: PRVM -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Potential temperature at t-dt -!REAL, DIMENSION(:,:), INTENT(IN) :: PTHM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT -!REAL, DIMENSION(:,:), INTENT(OUT) :: PTHVDT -!REAL, DIMENSION(:,:), INTENT(OUT) :: PTHDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT -!REAL, DIMENSION(:,:), INTENT(OUT) :: PRVDT -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP -!REAL, DIMENSION(:,:), INTENT(IN) :: PRV_UP -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF -!REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF - -END SUBROUTINE MF_TURB_EXPL - -END INTERFACE -! -END MODULE MODI_MF_TURB_EXPL diff --git a/src/common/turb/modd_param_mfshalln.F90 b/src/common/turb/modd_param_mfshalln.F90 new file mode 100644 index 0000000000000000000000000000000000000000..936d408ae32e3996df7c130e438f71c0180b9d9b --- /dev/null +++ b/src/common/turb/modd_param_mfshalln.F90 @@ -0,0 +1,171 @@ +!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 MODD_PARAM_MFSHALL_n +! ############################# +! +!!**** *MODD_PARAM_MFSHALL_n* - Declaration of Mass flux scheme free parameters +!! +!! PURPOSE +!! ------- +!! The purpose of this declarative module is to declare the +!! variables that may be set by namelist for the mass flux scheme +!! +!!** IMPLICIT ARGUMENTS +!! ------------------ +!! None +!! +!! REFERENCE +!! --------- +!! +!! +!! AUTHOR +!! ------ +!! S. Malardel, J. Pergaud (Meteo France) +!! +!! MODIFICATIONS +!! ------------- +!! Original 01/02/07 +!! 10/16 R.Honnert Update with AROME +!! 01/2019 R.Honnert add parameters for the reduction of mass-flux surface closure with resolution +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ +! +USE MODD_PARAMETERS, ONLY: JPMODELMAX +IMPLICIT NONE + +TYPE PARAM_MFSHALL_t + +REAL :: XIMPL_MF ! degre of implicitness + +CHARACTER (LEN=4) :: CMF_UPDRAFT ! Type of Mass Flux Scheme + ! 'NONE' if no parameterization +CHARACTER (LEN=4) :: CMF_CLOUD + + +LOGICAL :: LMIXUV ! True if mixing of momentum +LOGICAL :: LMF_FLX ! logical switch for the storage of + ! the mass flux fluxes +REAL :: XALP_PERT ! coefficient for the perturbation of + ! theta_l and r_t at the first level of + ! the updraft +REAL :: XABUO ! coefficient of the buoyancy term in the w_up equation +REAL :: XBENTR ! coefficient of the entrainment term in the w_up equation +REAL :: XBDETR ! coefficient of the detrainment term in the w_up equation +REAL :: XCMF ! coefficient for the mass flux at the first level + ! of the updraft (closure) +REAL :: XENTR_MF ! entrainment constant (m/Pa) = 0.2 (m) +REAL :: XCRAD_MF ! cloud radius in cloudy part +REAL :: XENTR_DRY ! coefficient for entrainment in dry part +REAL :: XDETR_DRY ! coefficient for detrainment in dry part +REAL :: XDETR_LUP ! coefficient for detrainment in dry part +REAL :: XKCF_MF ! coefficient for cloud fraction +REAL :: XKRC_MF ! coefficient for convective rc +REAL :: XTAUSIGMF +REAL :: XPRES_UV ! coefficient for pressure term in wind + ! mixing +REAL :: XALPHA_MF ! coefficient for cloudy fraction +REAL :: XSIGMA_MF ! coefficient for sigma computation +REAL :: XFRAC_UP_MAX! maximum Updraft fraction +! +! Parameter for Rio et al (2010) formulation for entrainment and detrainment (RHCJ10) +REAL :: XA1 +REAL :: XB +REAL :: XC +REAL :: XBETA1 +! +! Parameters for closure assumption of Hourdin et al 2002 + +REAL :: XR ! Aspect ratio of updraft +! +! Grey Zone +LOGICAL :: LGZ ! Grey Zone Surface Closure +REAL :: XGZ ! Tuning of the surface initialisation +! +! Thermodynamic parameter +REAL :: XLAMBDA_MF ! Lambda to compute ThetaS1 from ThetaL + +END TYPE PARAM_MFSHALL_t + +TYPE(PARAM_MFSHALL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PARAM_MFSHALL_MODEL + +REAL , POINTER :: XIMPL_MF=>NULL() +CHARACTER (LEN=4), POINTER :: CMF_UPDRAFT=>NULL() +CHARACTER (LEN=4), POINTER :: CMF_CLOUD=>NULL() +LOGICAL , POINTER :: LMIXUV=>NULL() +LOGICAL , POINTER :: LMF_FLX=>NULL() +! +REAL, POINTER :: XALP_PERT=>NULL() +REAL, POINTER :: XABUO=>NULL() +REAL, POINTER :: XBENTR=>NULL() +REAL, POINTER :: XBDETR=>NULL() +REAL, POINTER :: XCMF=>NULL() +REAL, POINTER :: XENTR_MF=>NULL() +REAL, POINTER :: XCRAD_MF=>NULL() +REAL, POINTER :: XENTR_DRY=>NULL() +REAL, POINTER :: XDETR_DRY=>NULL() +REAL, POINTER :: XDETR_LUP=>NULL() +REAL, POINTER :: XKCF_MF=>NULL() +REAL, POINTER :: XKRC_MF=>NULL() +REAL, POINTER :: XTAUSIGMF=>NULL() +REAL, POINTER :: XPRES_UV=>NULL() +REAL, POINTER :: XALPHA_MF=>NULL() +REAL, POINTER :: XSIGMA_MF=>NULL() +REAL, POINTER :: XFRAC_UP_MAX=>NULL() +REAL, POINTER :: XA1=>NULL() +REAL, POINTER :: XB=>NULL() +REAL, POINTER :: XC=>NULL() +REAL, POINTER :: XBETA1=>NULL() +REAL, POINTER :: XR=>NULL() +REAL, POINTER :: XLAMBDA_MF=>NULL() +LOGICAL, POINTER :: LGZ=>NULL() +REAL, POINTER :: XGZ=>NULL() +CONTAINS + +SUBROUTINE PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO) +INTEGER, INTENT(IN) :: KFROM, KTO +! +! Save current state for allocated arrays +! +! Current model is set to model KTO +XIMPL_MF=>PARAM_MFSHALL_MODEL(KTO)%XIMPL_MF +CMF_UPDRAFT=>PARAM_MFSHALL_MODEL(KTO)%CMF_UPDRAFT +CMF_CLOUD=>PARAM_MFSHALL_MODEL(KTO)%CMF_CLOUD +LMIXUV=>PARAM_MFSHALL_MODEL(KTO)%LMIXUV +LMF_FLX=>PARAM_MFSHALL_MODEL(KTO)%LMF_FLX +! +XALP_PERT=>PARAM_MFSHALL_MODEL(KTO)%XALP_PERT +XABUO=>PARAM_MFSHALL_MODEL(KTO)%XABUO +XBENTR=>PARAM_MFSHALL_MODEL(KTO)%XBENTR +XBDETR=>PARAM_MFSHALL_MODEL(KTO)%XBDETR +XCMF=>PARAM_MFSHALL_MODEL(KTO)%XCMF +XENTR_MF=>PARAM_MFSHALL_MODEL(KTO)%XENTR_MF +XCRAD_MF=>PARAM_MFSHALL_MODEL(KTO)%XCRAD_MF +XENTR_DRY=>PARAM_MFSHALL_MODEL(KTO)%XENTR_DRY +XDETR_DRY=>PARAM_MFSHALL_MODEL(KTO)%XDETR_DRY +XDETR_LUP=>PARAM_MFSHALL_MODEL(KTO)%XDETR_LUP +XKCF_MF=>PARAM_MFSHALL_MODEL(KTO)%XKCF_MF +XKRC_MF=>PARAM_MFSHALL_MODEL(KTO)%XKRC_MF +XTAUSIGMF=>PARAM_MFSHALL_MODEL(KTO)%XTAUSIGMF +XPRES_UV=>PARAM_MFSHALL_MODEL(KTO)%XPRES_UV +XALPHA_MF=>PARAM_MFSHALL_MODEL(KTO)%XALPHA_MF +XSIGMA_MF=>PARAM_MFSHALL_MODEL(KTO)%XSIGMA_MF +XFRAC_UP_MAX=>PARAM_MFSHALL_MODEL(KTO)%XFRAC_UP_MAX +XA1=>PARAM_MFSHALL_MODEL(KTO)%XA1 +XB=>PARAM_MFSHALL_MODEL(KTO)%XB +XC=>PARAM_MFSHALL_MODEL(KTO)%XC +XBETA1=>PARAM_MFSHALL_MODEL(KTO)%XBETA1 +XR=>PARAM_MFSHALL_MODEL(KTO)%XR +XLAMBDA_MF=>PARAM_MFSHALL_MODEL(KTO)%XLAMBDA_MF +LGZ=>PARAM_MFSHALL_MODEL(KTO)%LGZ +XGZ=>PARAM_MFSHALL_MODEL(KTO)%XGZ +! +END SUBROUTINE PARAM_MFSHALL_GOTO_MODEL + +END MODULE MODD_PARAM_MFSHALL_n diff --git a/src/common/turb/compute_bl89_ml.F90 b/src/common/turb/mode_compute_bl89_ml.F90 similarity index 99% rename from src/common/turb/compute_bl89_ml.F90 rename to src/common/turb/mode_compute_bl89_ml.F90 index f303a4529174397fba30e59386820b60c3b651fc..92e576ecb88c25e956df59916a7483e367944cbd 100644 --- a/src/common/turb/compute_bl89_ml.F90 +++ b/src/common/turb/mode_compute_bl89_ml.F90 @@ -1,3 +1,6 @@ +MODULE MODE_COMPUTE_BL89_ML +IMPLICIT NONE +CONTAINS ! ######spl SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, & PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK) @@ -214,3 +217,4 @@ ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_BL89_ML +END MODULE MODE_COMPUTE_BL89_ML diff --git a/src/arome/turb/compute_entr_detr.F90 b/src/common/turb/mode_compute_entr_detr.F90 similarity index 62% rename from src/arome/turb/compute_entr_detr.F90 rename to src/common/turb/mode_compute_entr_detr.F90 index 16d23c24e0da948d2781d9661395ec9b4b36065e..0b4ba055584d29363adc3a12948d23e18d5428d4 100644 --- a/src/arome/turb/compute_entr_detr.F90 +++ b/src/common/turb/mode_compute_entr_detr.F90 @@ -1,3 +1,13 @@ +!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +! ######spl + MODULE MODE_COMPUTE_ENTR_DETR +! ############################## +! +IMPLICIT NONE +CONTAINS ! ######spl SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,& HFRAC_ICE,PFRAC_ICE,PRHODREF,& @@ -10,9 +20,6 @@ PENTR,PDETR,PENTR_CLD,PDETR_CLD,& PBUO_INTEG_DRY,PBUO_INTEG_CLD,& PPART_DRY) - - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! ############################################################# !! @@ -49,14 +56,18 @@ !! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup !! protection against too big ZPART_DRY, interface modified !! S. Riette Jan 2012: support for both order of vertical levels +!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case !! P.Marguinaud Jun 2012: fix uninitialized variable !! P.Marguinaud Nov 2012: fix gfortran bug !! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and !! improvement of continuity at the condensation level !! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR +!! R.Honnert Oct 2016 : Update with AROME +! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed !! R. El Khatib 29-Apr-2019 portability fix : compiler may get confused by embricked WHERE statements !! eventually breaking tests with NaN initializations at compile time. !! Replace by IF conditions and traditional DO loops can only improve the performance. +! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -64,11 +75,13 @@ ! USE MODD_CST ! -USE MODD_CMFSHALL +USE MODD_PARAM_MFSHALL_n ! -USE MODI_TH_R_FROM_THL_RT_1D +USE MODI_TH_R_FROM_THL_RT_1D USE MODE_THERMO +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK IMPLICIT NONE ! @@ -82,7 +95,7 @@ INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physica INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using ! Temperature (T) or prescribed ! (Y) REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice @@ -123,7 +136,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the tr ! Variables for cloudy part REAL, DIMENSION(SIZE(PTHLM,1)) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI,ZDELTA ! factor entrainment detrainment -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI_CLOUD ! factor entrainment detrainment +REAL :: ZEPSI_CLOUD ! factor entrainment detrainment REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr. REAL, DIMENSION(SIZE(PTHLM,1)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHMIX ! Theta and Thetav of mixtures @@ -133,13 +146,13 @@ REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRSATW, ZRSATI ! working arrays (mixing ratio at saturation) REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV ! theta V of environment at the bottom of cloudy part REAL :: ZKIC_INIT !Initial value of ZKIC -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part +REAL :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part ! Variables for dry part -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFOESW, ZFOESI ! saturating vapor pressure -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDRSATODP ! d.Rsat/dP -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZT ! Temperature -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZWK ! Work array +REAL :: ZFOESW, ZFOESI ! saturating vapor pressure +REAL :: ZDRSATODP ! d.Rsat/dP +REAL :: ZT ! Temperature +REAL :: ZWK ! Work array ! Variables for dry and cloudy parts REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk @@ -150,16 +163,15 @@ REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFRAC_ICE ! fraction of ice REAL :: ZRVORD ! RV/RD REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK ZTHV_MINUS_HALF,& ! Thv at flux point(kk) - ZTHV_PLUS_HALF,& ! Thv at flux point(kk+kkl) - ZDZ ! Delta Z used in computations -INTEGER :: JI - + ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl) +REAL :: ZDZ ! Delta Z used in computations +INTEGER :: JI, JLOOP +REAL(KIND=JPRB) :: ZHOOK_HANDLE !---------------------------------------------------------------------------------- ! 1.3 Initialisation - REAL(KIND=JPRB) :: ZHOOK_HANDLE +! ------------------ IF (LHOOK) CALL DR_HOOK('COMPUTE_ENTR_DETR',0,ZHOOK_HANDLE) - ZRVORD = XRV / XRD !=1.607 ZG_O_THVREF(:)=XG/PTHVM(:,KK) @@ -168,39 +180,39 @@ INTEGER :: JI ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice ZPRE(:)=PPRE_MINUS_HALF(:) - ZMIXTHL(:)=0.1 - ZMIXRT(:)=0.1 ! 1.4 Estimation of PPART_DRY - WHERE(OTEST) - WHERE(OTESTLCL) + DO JLOOP=1,SIZE(OTEST) + IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN !No dry part when condensation level is reached - PPART_DRY(:)=0. - ZDZ_STOP(:)=0. - ZPRE(:)=PPRE_MINUS_HALF(:) - ELSEWHERE + PPART_DRY(JLOOP)=0. + ZDZ_STOP(JLOOP)=0. + ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP) + ELSE IF (OTEST(JLOOP) .AND. .NOT. OTESTLCL(JLOOP)) THEN !Temperature at flux level KK - ZT(:)=PTH_UP(:)*(PPRE_MINUS_HALF(:)/XP00) ** (XRD/XCPD) + ZT=PTH_UP(JLOOP)*(PPRE_MINUS_HALF(JLOOP)/XP00) ** (XRD/XCPD) !Saturating vapor pressure at flux level KK - ZFOESW(:) = MIN(EXP( XALPW - XBETAW/ZT(:) - XGAMW*LOG(ZT(:)) ), 0.99*PPRE_MINUS_HALF(:)) - ZFOESI(:) = MIN(EXP( XALPI - XBETAI/ZT(:) - XGAMI*LOG(ZT(:)) ), 0.99*PPRE_MINUS_HALF(:)) + ZFOESW = MIN(EXP( XALPW - XBETAW/ZT - XGAMW*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JLOOP)) + ZFOESI = MIN(EXP( XALPI - XBETAI/ZT - XGAMI*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JLOOP)) !Computation of d.Rsat / dP (partial derivations with respect to P and T !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up !constant at the vertical) - ZDRSATODP(:)=(XBETAW/ZT(:)-XGAMW)*(1-ZFRAC_ICE(:))+(XBETAI/ZT(:)-XGAMI)*ZFRAC_ICE(:) - ZDRSATODP(:)=((XRD/XCPD)*ZDRSATODP(:)-1.)*PRSAT_UP(:)/ & - &(PPRE_MINUS_HALF(:)-(ZFOESW(:)*(1-ZFRAC_ICE(:)) + ZFOESI(:)*ZFRAC_ICE(:))) + ZDRSATODP=(XBETAW/ZT-XGAMW)*(1-ZFRAC_ICE(JLOOP))+(XBETAI/ZT-XGAMI)*ZFRAC_ICE(JLOOP) + ZDRSATODP=((XRD/XCPD)*ZDRSATODP-1.)*PRSAT_UP(JLOOP)/ & + &(PPRE_MINUS_HALF(JLOOP)-(ZFOESW*(1-ZFRAC_ICE(JLOOP)) + ZFOESI*ZFRAC_ICE(JLOOP))) !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE) !where Rsat is equal to PRT_UP - ZPRE(:)=PPRE_MINUS_HALF(:)+(PRT_UP(:)-PRSAT_UP(:))/ZDRSATODP(:) + ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)+(PRT_UP(JLOOP)-PRSAT_UP(JLOOP))/ZDRSATODP !Fraction of dry part (computed with pressure and used with heights, no !impact found when using log function here and for pressure on flux levels !computation) - PPART_DRY(:)=MAX(0., MIN(1., (PPRE_MINUS_HALF(:)-ZPRE(:))/(PPRE_MINUS_HALF(:)-PPRE_PLUS_HALF(:)))) + PPART_DRY(JLOOP)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JLOOP)-ZPRE(JLOOP))/(PPRE_MINUS_HALF(JLOOP)-PPRE_PLUS_HALF(JLOOP)))) !Height above flux level KK of the cloudy part - ZDZ_STOP(:) = (PZZ(:,KK+KKL)-PZZ(:,KK))*PPART_DRY(:) - ENDWHERE - ENDWHERE + ZDZ_STOP(JLOOP) = (PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*PPART_DRY(JLOOP) + ELSE + PPART_DRY(JLOOP)=0. ! value does not matter, here + END IF + END DO ! 1.5 Gradient and flux values of thetav IF(KK/=KKB)THEN @@ -217,53 +229,46 @@ INTEGER :: JI ! Integral buoyancy and computation of PENTR and PDETR for dry part ! -------------------------------------------------------------------- - DO JI=1,SIZE(PTHLM,1) - IF(OTEST(JI)) THEN - IF(PPART_DRY(JI)>0.) THEN - !Buoyancy computation in two parts to use change of gradient of theta v of environment - !Between flux level KK and min(mass level, bottom of cloudy part) - ZDZ(JI)=MIN(ZDZ_STOP(JI),(PZZ(JI,KK+KKL)-PZZ(JI,KK))*0.5) - PBUO_INTEG_DRY(JI) = ZG_O_THVREF(JI)*ZDZ(JI)*& - (0.5 * ( - ZCOEFF_MINUS_HALF(JI))*ZDZ(JI) & - - ZTHV_MINUS_HALF(JI) + PTHV_UP(JI) ) - - !Between mass flux KK and bottom of cloudy part (if above mass flux) - ZDZ(JI)=MAX(0., ZDZ_STOP(JI)-(PZZ(JI,KK+KKL)-PZZ(JI,KK))*0.5) - PBUO_INTEG_DRY(JI) = PBUO_INTEG_DRY(JI) + ZG_O_THVREF(JI)*ZDZ(JI)*& - (0.5 * ( - ZCOEFF_PLUS_HALF(JI))*ZDZ(JI) & - - PTHVM(JI,KK) + PTHV_UP(JI) ) - - !Entr//Detr. computation - IF (PBUO_INTEG_DRY(JI)>=0.) THEN - PENTR(JI) = 0.5/(XABUO-XBENTR*XENTR_DRY)*& - LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JI,KK))* & - PBUO_INTEG_DRY(JI)) - PDETR(JI) = 0. - ELSE - PENTR(JI) = 0. - PDETR(JI) = 0.5/(XABUO)*& - LOG(1.+ (2.*(XABUO)/PW_UP2(JI,KK))* & - (-PBUO_INTEG_DRY(JI))) - ENDIF - PENTR(JI) = XENTR_DRY*PENTR(JI)/(PZZ(JI,KK+KKL)-PZZ(JI,KK)) - PDETR(JI) = XDETR_DRY*PDETR(JI)/(PZZ(JI,KK+KKL)-PZZ(JI,KK)) - !Minimum value of detrainment - ZWK(JI)=PLUP(JI)-0.5*(PZZ(JI,KK)+PZZ(JI,KK+KKL)) - ZWK(JI)=SIGN(MAX(1., ABS(ZWK(JI))), ZWK(JI)) ! ZWK must not be zero - PDETR(JI) = MAX(PPART_DRY(JI)*XDETR_LUP/ZWK(JI), PDETR(JI)) - ELSE - !No dry part, consation reached (OTESTLCL) - PBUO_INTEG_DRY(JI) = 0. - PENTR(JI)=0. - PDETR(JI)=0. - ENDIF +DO JLOOP=1,SIZE(OTEST) + IF (OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.) THEN + !Buoyancy computation in two parts to use change of gradient of theta v of environment + !Between flux level KK and min(mass level, bottom of cloudy part) + ZDZ=MIN(ZDZ_STOP(JLOOP),(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5) + PBUO_INTEG_DRY(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ*& + (0.5 * ( - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ & + - ZTHV_MINUS_HALF(JLOOP) + PTHV_UP(JLOOP) ) + + !Between mass flux KK and bottom of cloudy part (if above mass flux) + ZDZ=MAX(0., ZDZ_STOP(JLOOP)-(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5) + PBUO_INTEG_DRY(JLOOP) = PBUO_INTEG_DRY(JLOOP) + ZG_O_THVREF(JLOOP)*ZDZ*& + (0.5 * ( - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ & + - PTHVM(JLOOP,KK) + PTHV_UP(JLOOP) ) + + !Entr//Detr. computation + IF (PBUO_INTEG_DRY(JLOOP)>=0.) THEN + PENTR(JLOOP) = 0.5/(XABUO-XBENTR*XENTR_DRY)*& + LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JLOOP,KK))* & + PBUO_INTEG_DRY(JLOOP)) + PDETR(JLOOP) = 0. ELSE - !No dry part, consation reached (OTESTLCL) - PBUO_INTEG_DRY(JI) = 0. - PENTR(JI)=0. - PDETR(JI)=0. + PENTR(JLOOP) = 0. + PDETR(JLOOP) = 0.5/(XABUO)*& + LOG(1.+ (2.*(XABUO)/PW_UP2(JLOOP,KK))* & + (-PBUO_INTEG_DRY(JLOOP))) ENDIF - ENDDO + PENTR(JLOOP) = XENTR_DRY*PENTR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) + PDETR(JLOOP) = XDETR_DRY*PDETR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) + !Minimum value of detrainment + ZWK=PLUP(JLOOP)-0.5*(PZZ(JLOOP,KK)+PZZ(JLOOP,KK+KKL)) + ZWK=SIGN(MAX(1., ABS(ZWK)), ZWK) ! ZWK must not be zero + PDETR(JLOOP) = MAX(PPART_DRY(JLOOP)*XDETR_LUP/ZWK, PDETR(JLOOP)) + ELSE + !No dry part, condensation reached (OTESTLCL) + PBUO_INTEG_DRY(JLOOP) = 0. + PENTR(JLOOP)=0. + PDETR(JLOOP)=0. + ENDIF +ENDDO ! 3 Wet part computation ! ----------------------- @@ -282,34 +287,31 @@ INTEGER :: JI ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:)) ! Integral buoyancy for cloudy part - WHERE(OTEST) - WHERE(PPART_DRY(:)<1.) + DO JLOOP=1,SIZE(OTEST) + IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)<1.) THEN !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change !between flux level KK and bottom of cloudy part - ZCOTHVU(:)=(ZTHV_UP_F2(:)-PTHV_UP(:))/((PZZ(:,KK+KKL)-PZZ(:,KK))*(1-PPART_DRY(:))) + ZCOTHVU=(ZTHV_UP_F2(JLOOP)-PTHV_UP(JLOOP))/((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*(1-PPART_DRY(JLOOP))) !Computation in two parts to use change of gradient of theta v of environment !Between bottom of cloudy part (if under mass level) and mass level KK - ZDZ(:)=MAX(0., 0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))-ZDZ_STOP(:)) - PBUO_INTEG_CLD(:) = ZG_O_THVREF(:)*ZDZ(:)*& - (0.5*( ZCOTHVU(:) - ZCOEFF_MINUS_HALF(:))*ZDZ(:) & - - (PTHVM(:,KK)-ZDZ(:)*ZCOEFF_MINUS_HALF(:)) + PTHV_UP(:) ) + ZDZ=MAX(0., 0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP)) + PBUO_INTEG_CLD(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ*& + (0.5*( ZCOTHVU - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ & + - (PTHVM(JLOOP,KK)-ZDZ*ZCOEFF_MINUS_HALF(JLOOP)) + PTHV_UP(JLOOP) ) !Between max(mass level, bottom of cloudy part) and flux level KK+KKL - ZDZ(:)=(PZZ(:,KK+KKL)-PZZ(:,KK))-MAX(ZDZ_STOP(:),0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))) - PBUO_INTEG_CLD(:) = PBUO_INTEG_CLD(:)+ZG_O_THVREF(:)*ZDZ(:)*& - (0.5*( ZCOTHVU(:) - ZCOEFF_PLUS_HALF(:))*ZDZ(:)& - - (PTHVM(:,KK)+(0.5*((PZZ(:,KK+KKL)-PZZ(:,KK)))-ZDZ(:))*ZCOEFF_PLUS_HALF(:)) +& - PTHV_UP(:) ) + ZDZ=(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-MAX(ZDZ_STOP(JLOOP),0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))) + PBUO_INTEG_CLD(JLOOP) = PBUO_INTEG_CLD(JLOOP)+ZG_O_THVREF(JLOOP)*ZDZ*& + (0.5*( ZCOTHVU - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ& + - (PTHVM(JLOOP,KK)+(0.5*((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))-ZDZ)*ZCOEFF_PLUS_HALF(JLOOP)) +& + PTHV_UP(JLOOP) ) - ELSEWHERE + ELSE !No cloudy part - PBUO_INTEG_CLD(:)=0. - ENDWHERE - ELSEWHERE - !No cloudy part - PBUO_INTEG_CLD(:)=0. - ENDWHERE + PBUO_INTEG_CLD(JLOOP)=0. + END IF + END DO ! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and ! for bottom of cloudy part (ZKIC), then a mean for the cloudy part @@ -326,27 +328,31 @@ INTEGER :: JI ! and cons then non cons. var. of mixture at the bottom of cloudy part ! JI computed to avoid KKL(KK-KKL) being < KKL*KKB - JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB) - - WHERE(OTEST .AND. PPART_DRY(:)>0.5) - ZDZ(:)=ZDZ_STOP(:)-0.5*(PZZ(:,KK+KKL)-PZZ(:,KK)) - ZTHV(:)= PTHVM(:,KK)+ZCOEFF_PLUS_HALF(:)*ZDZ(:) - ZMIXTHL(:) = ZKIC_INIT * & - (PTHLM(:,KK)+ZDZ(:)*(PTHLM(:,KK+KKL)-PTHLM(:,KK))/PDZZ(:,KK+KKL)) + & - (1. - ZKIC_INIT)*PTHL_UP(:) - ZMIXRT(:) = ZKIC_INIT * & - (PRTM(:,KK)+ZDZ(:)*(PRTM(:,KK+KKL)-PRTM(:,KK))/PDZZ(:,KK+KKL)) + & - (1. - ZKIC_INIT)*PRT_UP(:) - ELSEWHERE(OTEST) - ZDZ(:)=0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))-ZDZ_STOP(:) - ZTHV(:)= PTHVM(:,KK)-ZCOEFF_MINUS_HALF(:)*ZDZ(:) - ZMIXTHL(:) = ZKIC_INIT * & - (PTHLM(:,KK)-ZDZ(:)*(PTHLM(:,KK)-PTHLM(:,JI))/PDZZ(:,KK)) + & - (1. - ZKIC_INIT)*PTHL_UP(:) - ZMIXRT(:) = ZKIC_INIT * & - (PRTM(:,KK)-ZDZ(:)*(PRTM(:,KK)-PRTM(:,JI))/PDZZ(:,KK)) + & - (1. - ZKIC_INIT)*PRT_UP(:) - ENDWHERE +JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB) +DO JLOOP=1,SIZE(OTEST) + IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.5) THEN + ZDZ=ZDZ_STOP(JLOOP)-0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) + ZTHV(JLOOP)= PTHVM(JLOOP,KK)+ZCOEFF_PLUS_HALF(JLOOP)*ZDZ + ZMIXTHL(JLOOP) = ZKIC_INIT * & + (PTHLM(JLOOP,KK)+ZDZ*(PTHLM(JLOOP,KK+KKL)-PTHLM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + & + (1. - ZKIC_INIT)*PTHL_UP(JLOOP) + ZMIXRT(JLOOP) = ZKIC_INIT * & + (PRTM(JLOOP,KK)+ZDZ*(PRTM(JLOOP,KK+KKL)-PRTM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + & + (1. - ZKIC_INIT)*PRT_UP(JLOOP) + ELSEIF(OTEST(JLOOP)) THEN + ZDZ=0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP) + ZTHV(JLOOP)= PTHVM(JLOOP,KK)-ZCOEFF_MINUS_HALF(JLOOP)*ZDZ + ZMIXTHL(JLOOP) = ZKIC_INIT * & + (PTHLM(JLOOP,KK)-ZDZ*(PTHLM(JLOOP,KK)-PTHLM(JLOOP,JI))/PDZZ(JLOOP,KK)) + & + (1. - ZKIC_INIT)*PTHL_UP(JLOOP) + ZMIXRT(JLOOP) = ZKIC_INIT * & + (PRTM(JLOOP,KK)-ZDZ*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + & + (1. - ZKIC_INIT)*PRT_UP(JLOOP) + ELSE + ZMIXTHL(JLOOP) = 300. + ZMIXRT(JLOOP) = 0.1 + ENDIF +ENDDO CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,& ZPRE,ZMIXTHL,ZMIXRT,& ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,& @@ -363,25 +369,27 @@ INTEGER :: JI ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:)) !Computation of mean ZKIC over the cloudy part - WHERE (OTEST) +DO JLOOP=1,SIZE(OTEST) + IF (OTEST(JLOOP)) THEN ! Compute ZKIC at the bottom of cloudy part ! Thetav_up at bottom is equal to Thetav_up at flux level KK - WHERE (ABS(PTHV_UP(:)-ZTHVMIX(:))<1.E-10) - ZKIC(:)=1. - ELSEWHERE - ZKIC(:) = MAX(0.,PTHV_UP(:)-ZTHV(:))*ZKIC_INIT / & - (PTHV_UP(:)-ZTHVMIX(:)) - ENDWHERE + IF (ABS(PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))<1.E-10) THEN + ZKIC(JLOOP)=1. + ELSE + ZKIC(JLOOP) = MAX(0.,PTHV_UP(JLOOP)-ZTHV(JLOOP))*ZKIC_INIT / & + (PTHV_UP(JLOOP)-ZTHVMIX(JLOOP)) + END IF ! Compute ZKIC_F2 at flux level KK+KKL - WHERE (ABS(ZTHV_UP_F2(:)-ZTHVMIX_F2(:))<1.E-10) - ZKIC_F2(:)=1. - ELSEWHERE - ZKIC_F2(:) = MAX(0.,ZTHV_UP_F2(:)-ZTHV_PLUS_HALF(:))*ZKIC_INIT / & - (ZTHV_UP_F2(:)-ZTHVMIX_F2(:)) - ENDWHERE + IF (ABS(ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))<1.E-10) THEN + ZKIC_F2(JLOOP)=1. + ELSE + ZKIC_F2(JLOOP) = MAX(0.,ZTHV_UP_F2(JLOOP)-ZTHV_PLUS_HALF(JLOOP))*ZKIC_INIT / & + (ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP)) + END IF !Mean ZKIC over the cloudy part - ZKIC(:)=MAX(MIN(0.5*(ZKIC(:)+ZKIC_F2(:)),1.),0.) - ENDWHERE + ZKIC(JLOOP)=MAX(MIN(0.5*(ZKIC(JLOOP)+ZKIC_F2(JLOOP)),1.),0.) + END IF +END DO ! 3.3 Integration of PDF ! According to Kain and Fritsch (1990), we replace delta Mt @@ -390,10 +398,12 @@ INTEGER :: JI !Constant PDF !For this PDF, eq. (5) is delta Me=0.5*delta Mt - WHERE(OTEST) - ZEPSI(:) = ZKIC(:)**2. !integration multiplied by 2 - ZDELTA(:) = (1.-ZKIC(:))**2. !idem - ENDWHERE +DO JLOOP=1,SIZE(OTEST) + IF(OTEST(JLOOP)) THEN + ZEPSI(JLOOP) = ZKIC(JLOOP)**2. !integration multiplied by 2 + ZDELTA(JLOOP) = (1.-ZKIC(JLOOP))**2. !idem + ENDIF +ENDDO !Triangular PDF !Calculus must be verified before activating this part, but in this state, @@ -411,16 +421,19 @@ INTEGER :: JI !ENDWHERE ! 3.4 Computation of PENTR and PDETR - WHERE (OTEST) - ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI) - PENTR_CLD(:) = (1.-PPART_DRY(:))*ZCOEFFMF_CLOUD*PRHODREF(:)*ZEPSI_CLOUD(:) - PDETR_CLD(:) = (1.-PPART_DRY(:))*ZCOEFFMF_CLOUD*PRHODREF(:)*ZDELTA(:) - PENTR(:) = PENTR(:)+PENTR_CLD(:) - PDETR(:) = PDETR(:)+PDETR_CLD(:) - ELSEWHERE - PENTR_CLD(:) = 0. - PDETR_CLD(:) = 0. - ENDWHERE +DO JLOOP=1,SIZE(OTEST) + IF(OTEST(JLOOP)) THEN + ZEPSI_CLOUD=MIN(ZDELTA(JLOOP), ZEPSI(JLOOP)) + PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD + PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP) + PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP) + PDETR(JLOOP) = PDETR(JLOOP)+PDETR_CLD(JLOOP) + ELSE + PENTR_CLD(JLOOP) = 0. + PDETR_CLD(JLOOP) = 0. + ENDIF +ENDDO IF (LHOOK) CALL DR_HOOK('COMPUTE_ENTR_DETR',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_ENTR_DETR +END MODULE MODE_COMPUTE_ENTR_DETR diff --git a/src/arome/turb/compute_function_thermo_mf.F90 b/src/common/turb/mode_compute_function_thermo_mf.F90 similarity index 93% rename from src/arome/turb/compute_function_thermo_mf.F90 rename to src/common/turb/mode_compute_function_thermo_mf.F90 index d54c8584ad7beeebb0ee0b0e0c830b732342d822..64cc93462a8539820657547cf78cff60ce859fb9 100644 --- a/src/arome/turb/compute_function_thermo_mf.F90 +++ b/src/common/turb/mode_compute_function_thermo_mf.F90 @@ -1,4 +1,13 @@ +!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. ! ######spl + MODULE MODE_COMPUTE_FUNCTION_THERMO_MF +! ###################################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, & PTH, PR, PEXN, PFRAC_ICE, PPABS, & PT,PAMOIST,PATHETA ) @@ -204,3 +213,5 @@ ELSE ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF +! +END MODULE MODE_COMPUTE_FUNCTION_THERMO_MF diff --git a/src/arome/turb/compute_mf_cloud.F90 b/src/common/turb/mode_compute_mf_cloud.F90 similarity index 86% rename from src/arome/turb/compute_mf_cloud.F90 rename to src/common/turb/mode_compute_mf_cloud.F90 index a8582c0cfafc84d829b00f1bf5d713aeba7012f6..7792adb25787829f9d597b25f55bd389ae29d32e 100644 --- a/src/arome/turb/compute_mf_cloud.F90 +++ b/src/common/turb/mode_compute_mf_cloud.F90 @@ -1,3 +1,15 @@ +!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- +! ######spl + MODULE MODE_COMPUTE_MF_CLOUD +! ############################ +! +IMPLICIT NONE +CONTAINS +! ! ######spl SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,& PFRAC_ICE, & @@ -42,14 +54,17 @@ !! S. Riette Dec 2010 BIGA case !! S. Riette Aug 2011 code is split into subroutines !! S. Riette Jan 2012: support for both order of vertical levels +! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODI_COMPUTE_MF_CLOUD_DIRECT -USE MODI_COMPUTE_MF_CLOUD_STAT -USE MODI_COMPUTE_MF_CLOUD_BIGAUS +USE MODE_MSG +! +USE MODE_COMPUTE_MF_CLOUD_DIRECT, ONLY: COMPUTE_MF_CLOUD_DIRECT +USE MODE_COMPUTE_MF_CLOUD_STAT, ONLY: COMPUTE_MF_CLOUD_STAT +USE MODE_COMPUTE_MF_CLOUD_BIGAUS, ONLY: COMPUTE_MF_CLOUD_BIGAUS ! USE PARKIND1, ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK @@ -123,7 +138,7 @@ ELSEIF (HMF_CLOUD == 'STAT') THEN ELSEIF (HMF_CLOUD == 'BIGA') THEN !Statistical scheme using the bi-gaussian PDF proposed by E. Perraud. CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - &PRC_UP, PRI_UP, PEMF, PDEPTH,& + &PEMF, PDEPTH,& &PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& &PRTM, PTHM, PTHVM,& &PDZZ, PZZ, PRHODREF,& @@ -133,12 +148,10 @@ ELSEIF (HMF_CLOUD == 'NONE') THEN ! No CONVECTIVE CLOUD SCHEME ! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero ELSE - WRITE(*,*) ' STOP' - WRITE(*,*) ' Shallow convection cloud scheme not valid : HMF_CLOUD =',TRIM(HMF_CLOUD) - CALL ABORT - STOP + CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD)) ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_MF_CLOUD +END MODULE MODE_COMPUTE_MF_CLOUD diff --git a/src/arome/turb/compute_mf_cloud_bigaus.F90 b/src/common/turb/mode_compute_mf_cloud_bigaus.F90 similarity index 87% rename from src/arome/turb/compute_mf_cloud_bigaus.F90 rename to src/common/turb/mode_compute_mf_cloud_bigaus.F90 index 06f062de47119dbe9f4ef2f3ea3d46c08c27d11d..86d33090bb8e41b731f5e583d1ef19746f3a7d96 100644 --- a/src/arome/turb/compute_mf_cloud_bigaus.F90 +++ b/src/common/turb/mode_compute_mf_cloud_bigaus.F90 @@ -1,6 +1,16 @@ +!MNH_LIC Copyright 2011-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- ! ######spl + MODULE MODE_COMPUTE_MF_CLOUD_BIGAUS +! ################################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - PRC_UP, PRI_UP, PEMF, PDEPTH,& + PEMF, PDEPTH,& PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& PRTM, PTHM, PTHVM,& PDZZ, PZZ, PRHODREF,& @@ -42,11 +52,12 @@ !! ------------- !! Original 25 Aug 2011 !! S. Riette Jan 2012: support for both order of vertical levels +!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ -USE MODD_CMFSHALL, ONLY : XALPHA_MF, XSIGMA_MF +USE MODD_PARAM_MFSHALL_n, ONLY : XALPHA_MF, XSIGMA_MF USE MODD_CST, ONLY : XPI, XG ! USE MODI_SHUMAN_MF, ONLY: MZF_MF, GZ_M_W_MF @@ -66,7 +77,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics +REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft @@ -86,8 +97,7 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M ! REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array INTEGER :: JK ! vertical loop control REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & ! - & ZRSAT_UP_M, ZRC_UP_M,& ! Interpolation on mass points - & ZRI_UP_M, ZRT_UP_M,& ! + & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points & ZFRAC_ICE_UP_M ! REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration @@ -109,8 +119,6 @@ ZGRAD_Z_RT(:,:)=MZF_MF(ZW1(:,:), KKA, KKU, KKL) !Interpolation on mass points ZTHV_UP_M(:,:) = MZF_MF(PTHV_UP(:,:), KKA, KKU, KKL) ZRSAT_UP_M(:,:)= MZF_MF(PRSAT_UP(:,:), KKA, KKU, KKL) -ZRC_UP_M(:,:) = MZF_MF(PRC_UP(:,:), KKA, KKU, KKL) -ZRI_UP_M(:,:) = MZF_MF(PRI_UP(:,:), KKA, KKU, KKL) ZRT_UP_M(:,:) = MZF_MF(PRT_UP(:,:), KKA, KKU, KKL) ZEMF_M(:,:) = MZF_MF(PEMF(:,:), KKA, KKU, KKL) ZFRAC_ICE_UP_M(:,:) = MZF_MF(PFRAC_ICE_UP(:,:), KKA, KKU, KKL) @@ -157,25 +165,8 @@ ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40)) !Computation of ZA and ZGAM (=efrc(ZA)) coefficient ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:)) -!erf computed by an incomplete gamma function approximation -!DO JK=KKA,KKU,KKL -! DO JI=1, SIZE(PCF_MF,1) -! IF(ZA(JI,JK)>1E-20) THEN -! ZGAM(JI,JK)=1-GAMMA_INC(0.5,ZA(JI,JK)**2) -! ELSEIF(ZA(JI,JK)<-1E-20) THEN -! ZGAM(JI,JK)=1+GAMMA_INC(0.5,ZA(JI,JK)**2) -! ELSE -! ZGAM(JI,JK)=1 -! ENDIF -! ENDDO -!ENDDO - -!alternative approximation of erf function (better for vectorisation) -WHERE(ZA(:,:)>0) - ZGAM(:,:)=1-SQRT(1-EXP(-4*ZA(:,:)**2/XPI)) -ELSEWHERE - ZGAM(:,:)=1+SQRT(1-EXP(-4*ZA(:,:)**2/XPI)) -ENDWHERE +!Approximation of erf function +ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI)) !computation of cloud fraction PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:))) @@ -189,3 +180,4 @@ PRI_MF(:,:)=( ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:) IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS +END MODULE MODE_COMPUTE_MF_CLOUD_BIGAUS diff --git a/src/arome/turb/compute_mf_cloud_direct.F90 b/src/common/turb/mode_compute_mf_cloud_direct.F90 similarity index 88% rename from src/arome/turb/compute_mf_cloud_direct.F90 rename to src/common/turb/mode_compute_mf_cloud_direct.F90 index e0e3a36ae369d7a1f28929e594f1e6609eede251..090e49e487bce7f09e8258a00767572ed26150b2 100644 --- a/src/arome/turb/compute_mf_cloud_direct.F90 +++ b/src/common/turb/mode_compute_mf_cloud_direct.F90 @@ -1,4 +1,13 @@ +!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. ! ######spl + MODULE MODE_COMPUTE_MF_CLOUD_DIRECT +! ################################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKB, KKE, KKL, & &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,& &PRC_MF, PRI_MF, PCF_MF) @@ -44,7 +53,7 @@ ! !* 0. DECLARATIONS ! ------------ -USE MODD_CMFSHALL, ONLY : XKCF_MF +USE MODD_PARAM_MFSHALL_n, ONLY : XKCF_MF USE PARKIND1, ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! @@ -97,3 +106,4 @@ END DO IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_DIRECT',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT +END MODULE MODE_COMPUTE_MF_CLOUD_DIRECT diff --git a/src/arome/turb/compute_mf_cloud_stat.F90 b/src/common/turb/mode_compute_mf_cloud_stat.F90 similarity index 90% rename from src/arome/turb/compute_mf_cloud_stat.F90 rename to src/common/turb/mode_compute_mf_cloud_stat.F90 index 3c86b33b9b6746d406fb3d2a793d76be93f66b83..12fcce462fef6b0eb2c4b73fec8b6058a78ada08 100644 --- a/src/arome/turb/compute_mf_cloud_stat.F90 +++ b/src/common/turb/mode_compute_mf_cloud_stat.F90 @@ -1,3 +1,13 @@ +!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. +! ######spl + MODULE MODE_COMPUTE_MF_CLOUD_STAT +! ############################ +! +IMPLICIT NONE +CONTAINS ! ######spl SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,& &PFRAC_ICE,& @@ -42,11 +52,11 @@ ! !* 0. DECLARATIONS ! ------------ -USE MODD_CMFSHALL, ONLY : XTAUSIGMF +USE MODD_PARAM_MFSHALL_n, ONLY : XTAUSIGMF USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT ! USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF -USE MODI_COMPUTE_FUNCTION_THERMO_MF +USE MODE_COMPUTE_FUNCTION_THERMO_MF, ONLY: COMPUTE_FUNCTION_THERMO_MF ! USE PARKIND1, ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK @@ -138,3 +148,4 @@ END IF IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',1,ZHOOK_HANDLE) ! END SUBROUTINE COMPUTE_MF_CLOUD_STAT +END MODULE MODE_COMPUTE_MF_CLOUD_STAT diff --git a/src/arome/turb/compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90 similarity index 90% rename from src/arome/turb/compute_updraft.F90 rename to src/common/turb/mode_compute_updraft.F90 index b0047fc1ec66cfacbeb6093e8910ee1f81381b69..b8c7f64c50fd4d550e0cf930402ae62bb37e5476 100644 --- a/src/arome/turb/compute_updraft.F90 +++ b/src/common/turb/mode_compute_updraft.F90 @@ -1,4 +1,14 @@ +!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- ! ######spl + MODULE MODE_COMPUTE_UPDRAFT +! ########################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & OENTR_DETR,OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & @@ -12,10 +22,8 @@ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & PEMF,PDETR,PENTR, & PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) + PDEPTH, PDX, PDY ) - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! ################################################################# !! !!**** *COMPUTE_UPDRAFT* - calculates caracteristics of the updraft @@ -49,22 +57,26 @@ !! S. Riette Jan 2012: support for both order of vertical levels !! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value !! S. Riette Apr 2013: improvement of continuity at the condensation level +!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME !! Q.Rodier 01/2019 : support RM17 mixing length +!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution) !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_CST -USE MODD_CMFSHALL +USE MODD_CST, ONLY: XG, XRV, XRD +USE MODD_PARAM_MFSHALL_n, ONLY: LGZ, XALP_PERT, XCMF, XPRES_UV, XFRAC_UP_MAX, & + XABUO, XBENTR, XENTR_DRY, XBDETR, XGZ USE MODD_TURB_n, ONLY : CTURBLEN -USE MODI_COMPUTE_ENTR_DETR +USE MODE_COMPUTE_ENTR_DETR, ONLY: COMPUTE_ENTR_DETR USE MODI_TH_R_FROM_THL_RT_1D USE MODI_SHUMAN_MF, ONLY: MZM_MF, MZF_MF, GZ_M_W_MF -USE MODI_COMPUTE_BL89_ML - +USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK IMPLICIT NONE @@ -77,7 +89,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer @@ -117,6 +129,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud +REAL, INTENT(IN) :: PDX, PDY ! 1.2 Declaration of local variables ! ! @@ -163,7 +176,7 @@ LOGICAL :: GLMIX LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1 LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2 -INTEGER :: ITEST +INTEGER :: ITEST, JLOOP REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP,& ZRSATW, ZRSATI,& @@ -172,8 +185,11 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP,& REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process REAL :: ZTMAX,ZRMAX ! control value + +REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear REAL(KIND=JPRB) :: ZHOOK_HANDLE +! IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',0,ZHOOK_HANDLE) ! Thresholds for the perturbation of @@ -299,13 +315,10 @@ IF (OENTR_DETR) THEN ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL) ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL) ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ) - PRINT*, 'phasage bete sans controle' - CALL ABORT - STOP ELSE ZSHEAR = 0. !no shear in bl89 mixing length END IF - ! + ! CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) ZLUP(:)=MAX(ZLUP(:),1.E-10) @@ -314,8 +327,14 @@ IF (OENTR_DETR) THEN (0.61*ZTHM_F(:,KKB))*PSFRV(:) ! Mass flux at KKB level (updraft triggered if PSFTH>0.) + IF (LGZ) THEN + ZSURF(:)=TANH(XGZ*SQRT(PDX*PDY)/ZLUP) + ELSE + ZSURF(:)=1. + END IF WHERE (ZWTHVSURF(:)>0.) - PEMF(:,KKB) = XCMF * ZRHO_F(:,KKB) * ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.) + PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * & + ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.) PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX) ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2 GTEST(:)=.TRUE. @@ -401,16 +420,18 @@ DO JK=KKB,KKE-KKL,KKL ! If the updraft did not stop, compute cons updraft characteritics at jk+KKL - WHERE(GTEST) - ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !& - ZMIX3_CLD(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*(1.-ZPART_DRY(:))*ZDETR_CLD(:,JK) !& - ZMIX2_CLD(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*(1.-ZPART_DRY(:))*ZENTR_CLD(:,JK) - - PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - ENDWHERE + DO JLOOP=1,SIZE(GTEST) + IF(GTEST(JLOOP)) THEN + ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !& + ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !& + ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK) + + PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) & + /(1.+0.5*ZMIX2(JLOOP)) + PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) & + /(1.+0.5*ZMIX2(JLOOP)) + ENDIF + ENDDO IF(OMIXUV) THEN @@ -551,3 +572,4 @@ ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_UPDRAFT +END MODULE MODE_COMPUTE_UPDRAFT diff --git a/src/arome/turb/compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90 similarity index 96% rename from src/arome/turb/compute_updraft_raha.F90 rename to src/common/turb/mode_compute_updraft_raha.F90 index 337696338c23e4075da3b4416e6b46a74bd16957..4082137400341dae238ad5e23349e25eb1726700 100644 --- a/src/arome/turb/compute_updraft_raha.F90 +++ b/src/common/turb/mode_compute_updraft_raha.F90 @@ -1,4 +1,14 @@ +!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- ! ######spl + MODULE MODE_COMPUTE_UPDRAFT_RAHA +! ########################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & OENTR_DETR,OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & @@ -14,8 +24,6 @@ PBUO_INTEG,KKLCL,KKETL,KKCTL, & PDEPTH ) - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! ################################################################# !! !!**** *COMPUTE_UPDRAF_RAHA* - calculates caracteristics of the updraft @@ -44,7 +52,7 @@ !! AUTHOR !! ------ !! Y. Bouteloup (2012) -!! R. Honert Janv 2013 ==> corection of some coding bugs +!! R. Honnert Janv 2013 ==> corection of some coding bugs !! Y. Bouteloup Janv 2014 ==> Allow the use of loops in the both direction !! -------------------------------------------------------------------------- ! @@ -52,10 +60,13 @@ ! ------------ USE MODD_CST -USE MODD_CMFSHALL +USE MODD_PARAM_MFSHALL_n USE MODI_TH_R_FROM_THL_RT_1D USE MODI_SHUMAN_MF, ONLY: MZM_MF +! +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK IMPLICIT NONE @@ -68,7 +79,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer @@ -267,7 +278,7 @@ PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))* PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB)) -ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA*ZQT_UP(:)) +ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA_MF*ZQT_UP(:)) ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL) ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL) @@ -418,13 +429,13 @@ DO JK=KKB,KKE-KKL,KKL ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !& ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK)) - ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA*ZQTM(:)) + ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA_MF*ZQTM(:)) ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) & /(1.+0.5*ZMIX2(:)) PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) & /(1.+0.5*ZMIX2(:)) ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL)) - PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA*ZQT_UP(:)) + PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(:)) ENDWHERE @@ -584,3 +595,4 @@ ENDWHERE IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_UPDRAFT_RAHA +END MODULE MODE_COMPUTE_UPDRAFT_RAHA diff --git a/src/arome/turb/mf_turb.F90 b/src/common/turb/mode_mf_turb.F90 similarity index 91% rename from src/arome/turb/mf_turb.F90 rename to src/common/turb/mode_mf_turb.F90 index ee1e2cbf2b3be24d91653abc9987bbd08d6dfc50..86f1d2f311ec85ab6c0997c594572caf87a684b7 100644 --- a/src/arome/turb/mf_turb.F90 +++ b/src/common/turb/mode_mf_turb.F90 @@ -1,7 +1,16 @@ -! ######spl +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +! ###################### + MODULE MODE_MF_TURB +! ###################### +! +IMPLICIT NONE +CONTAINS SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL, PTSTEP, PTSTEP_MET, PTSTEP_SV, & + PIMPL, PTSTEP, & PDZZ, & PRHODJ, & PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, & @@ -10,9 +19,6 @@ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & PFLXZSVMF ) - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK - ! ################################################################# ! ! @@ -56,11 +62,12 @@ !* 0. DECLARATIONS ! ------------ ! -USE MODD_CMFSHALL -! USE MODI_SHUMAN_MF, ONLY: MZM_MF USE MODI_TRIDIAG_MASSFLUX ! +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK +! IMPLICIT NONE ! ! @@ -78,8 +85,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer REAL, INTENT(IN) :: PIMPL ! degree of implicitness REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables -REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables ! REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients @@ -123,19 +128,17 @@ REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF ! REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS - -! INTEGER :: ISV,JSV !number of scalar variables and Loop counter +REAL(KIND=JPRB) :: ZHOOK_HANDLE ! !---------------------------------------------------------------------------- ! !* 1.PRELIMINARIES ! ------------- ! +IF (LHOOK) CALL DR_HOOK('MF_TURB',0,ZHOOK_HANDLE) ! ! number of scalar var -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK('MF_TURB',0,ZHOOK_HANDLE) ISV=SIZE(PSVM,3) ! @@ -179,25 +182,25 @@ ENDIF ! 3.1 Compute the tendency for the conservative potential temperature ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) ! -CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP_MET,PIMPL, & +CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, & PDZZ,PRHODJ,ZVARS ) ! compute new flux PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL)) !!! compute THL tendency ! -PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP_MET +PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP ! ! 3.2 Compute the tendency for the conservative mixing ratio ! -CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP_MET,PIMPL, & +CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, & PDZZ,PRHODJ,ZVARS ) ! compute new flux PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(ZVARS(:,:), KKA, KKU, KKL)) !!! compute RT tendency -PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP_MET +PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP ! IF (OMIXUV) THEN @@ -246,14 +249,15 @@ DO JSV=1,ISV ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) ! CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),& - -PEMF,PTSTEP_SV,PIMPL,PDZZ,PRHODJ,ZVARS ) + -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS ) ! compute new flux PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(ZVARS, KKA, KKU, KKL)) ! compute Sv tendency - PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP_SV + PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP ENDDO ! IF (LHOOK) CALL DR_HOOK('MF_TURB',1,ZHOOK_HANDLE) END SUBROUTINE MF_TURB +END MODULE MODE_MF_TURB diff --git a/src/arome/turb/mf_turb_expl.F90 b/src/common/turb/mode_mf_turb_expl.F90 similarity index 88% rename from src/arome/turb/mf_turb_expl.F90 rename to src/common/turb/mode_mf_turb_expl.F90 index 0ac56e3236e5bf9ae5a995c7d509397fde4593fe..2bff78e0aa035c9bf2d1427e5c674ec844d2be80 100644 --- a/src/arome/turb/mf_turb_expl.F90 +++ b/src/common/turb/mode_mf_turb_expl.F90 @@ -1,4 +1,12 @@ -! ######spl +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +! ###################### + MODULE MODE_MF_TURB_EXPL +! ###################### +IMPLICIT NONE +CONTAINS SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, & PRHODJ, & PTHLM,PTHVM,PRTM,PUM,PVM, & @@ -6,9 +14,6 @@ PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK - ! ################################################################# ! ! @@ -47,7 +52,9 @@ !* 0. DECLARATIONS ! ------------ -USE MODD_CMFSHALL +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK +USE MODD_PARAM_MFSHALL_n, ONLY: XLAMBDA_MF USE MODI_SHUMAN_MF, ONLY: MZM_MF IMPLICIT NONE @@ -95,13 +102,13 @@ REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZQT_UP,ZQTM,ZTHSDT,ZQT REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZTHLM_F,ZRTM_F INTEGER :: JK ! loop counter +REAL(KIND=JPRB) :: ZHOOK_HANDLE !---------------------------------------------------------------------------- ! !* 1.PRELIMINARIES ! ------------- -REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MF_TURB_EXPL',0,ZHOOK_HANDLE) PFLXZRMF = 0. @@ -127,8 +134,8 @@ ZRTM_F (:,:) = MZM_MF(PRTM (:,:), KKA, KKU, KKL) ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL) ZQTM (:,:) = ZRTM_F (:,:)/(1.+ZRTM_F (:,:)) ZQT_UP (:,:) = PRT_UP (:,:)/(1.+PRT_UP (:,:)) -ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA*ZQT_UP(:,:)) -ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA*ZQTM(:,:)) +ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA_MF*ZQT_UP(:,:)) +ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA_MF*ZQTM(:,:)) PFLXZTHLMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(PTHLM(:,:), KKA, KKU, KKL)) ! ThetaL PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP (:,:)-MZM_MF(PRTM (:,:), KKA, KKU, KKL)) ! Rt @@ -156,7 +163,7 @@ DO JK=KKB,KKE-KKL,KKL PRTDT (:,JK) = (PFLXZRMF (:,JK ) - PFLXZRMF (:,JK+KKL)) / PRHODJ(:,JK) ZQTDT (:,JK) = PRTDT (:,JK)/(1.+ ZRTM_F (:,JK)*ZRTM_F (:,JK)) ZTHSDT(:,JK) = (ZFLXZTHSMF(:,JK ) - ZFLXZTHSMF(:,JK+KKL)) / PRHODJ(:,JK) - PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA*ZQTDT(:,JK) + PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA_MF*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA_MF*ZQTDT(:,JK) END DO IF (OMIXUV) THEN @@ -169,3 +176,4 @@ ENDIF IF (LHOOK) CALL DR_HOOK('MF_TURB_EXPL',1,ZHOOK_HANDLE) END SUBROUTINE MF_TURB_EXPL +END MODULE MODE_MF_TURB_EXPL diff --git a/src/arome/turb/modi_shallow_mf.F90 b/src/common/turb/modi_shallow_mf.F90 similarity index 93% rename from src/arome/turb/modi_shallow_mf.F90 rename to src/common/turb/modi_shallow_mf.F90 index 944ea3450dd6d66fb0098706e2742e812525863c..23559eeec6a0afd8573c7c913de4933267eb154b 100644 --- a/src/arome/turb/modi_shallow_mf.F90 +++ b/src/common/turb/modi_shallow_mf.F90 @@ -7,7 +7,7 @@ INTERFACE SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, & HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, & + PIMPL_MF, PTSTEP, & PDZZ, PZZ, & PRHODJ, PRHODREF, & PPABSM, PEXNM, & @@ -20,7 +20,7 @@ INTERFACE PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & PU_UP, PV_UP, PTHV_UP, PW_UP, & PFRAC_UP,PEMF,PDETR,PENTR, & - KKLCL,KKETL,KKCTL ) + KKLCL,KKETL,KKCTL,PDX,PDY ) ! ################################################################# !! ! @@ -43,9 +43,7 @@ LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangia INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables -REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables +REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients @@ -89,6 +87,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL +REAL, INTENT(IN) :: PDX, PDY END SUBROUTINE SHALLOW_MF diff --git a/src/arome/turb/shallow_mf.F90 b/src/common/turb/shallow_mf.F90 similarity index 76% rename from src/arome/turb/shallow_mf.F90 rename to src/common/turb/shallow_mf.F90 index da72c1ceb966a7923a83eea8d89d87b79792f180..a836b8e093bc2a6dddb10dfa756d07b4c8210586 100644 --- a/src/arome/turb/shallow_mf.F90 +++ b/src/common/turb/shallow_mf.F90 @@ -1,8 +1,13 @@ -! ######spl +!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- +! ################################################################ SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, & HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, & + PIMPL_MF, PTSTEP, & PDZZ, PZZ, & PRHODJ, PRHODREF, & PPABSM, PEXNM, & @@ -15,10 +20,8 @@ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & PU_UP, PV_UP, PTHV_UP, PW_UP, & PFRAC_UP,PEMF,PDETR,PENTR, & - KKLCL,KKETL,KKCTL ) + KKLCL,KKETL,KKCTL,PDX,PDY ) - USE PARKIND1, ONLY : JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! ################################################################# !! !!**** *SHALLOW_MF* - @@ -53,7 +56,16 @@ !! S. Riette 18 May 2010 interface changed due to ice correction !! S.Riette DUAL case !! S. Riette Jan 2012: support for both order of vertical levels +!! R.Honnert 07/2012 : elemnts of Rio according to Bouteloup +!! R.Honnert 07/2012 : MF gray zone +!! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF +!! R.Honnert 10/2016 : Update with Arome !! S. Riette Nov 2016: HFRAC_ICE support +!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.) +!! Q.Rodier 01/2019 : support RM17 mixing length +!! R.Honnert 1/2019 : remove SURF +! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg +! R. Honnert 04/2021: remove HRIO and BOUT schemes !! -------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -61,15 +73,19 @@ ! USE MODD_CST USE MODD_PARAMETERS, ONLY: JPVEXT -USE MODD_CMFSHALL +USE MODD_PARAM_MFSHALL_n USE MODI_THL_RT_FROM_TH_R_MF -USE MODI_COMPUTE_UPDRAFT -USE MODI_COMPUTE_UPDRAFT_RHCJ10 -USE MODI_COMPUTE_UPDRAFT_RAHA -USE MODI_MF_TURB -USE MODI_MF_TURB_EXPL -USE MODI_COMPUTE_MF_CLOUD +USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT +USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10 +USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA +USE MODE_MF_TURB, ONLY: MF_TURB +USE MODE_MF_TURB_EXPL, ONLY: MF_TURB_EXPL +USE MODE_COMPUTE_MF_CLOUD, ONLY: COMPUTE_MF_CLOUD +USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE +USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! IMPLICIT NONE @@ -83,19 +99,17 @@ INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from grou INTEGER, INTENT(IN) :: KRR ! number of moist var. INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme +CHARACTER(LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme ! 'NONE' if no parameterization -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud +CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud ! scheme -CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables -REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables +REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients @@ -127,7 +141,7 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics -REAL, DIMENSION(:,:), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics +REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics @@ -139,6 +153,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL +REAL, INTENT(IN) :: PDX, PDY ! ! 0.2 Declaration of local variables ! @@ -147,7 +162,6 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: & ZRTM, & ! ZTHVM, & ! ZEMF_O_RHODREF, & ! entrainment/detrainment - ZTHVDT,ZTHDT,ZRVDT, & ! tendencies ZBUO_INTEG ! integrated buoyancy REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE @@ -162,11 +176,11 @@ LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flu INTEGER :: IKB ! near ground physical index INTEGER :: IKE ! uppest atmosphere physical index INTEGER, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: IERR +! +REAL(KIND=JPRB) :: ZHOOK_HANDLE !------------------------------------------------------------------------ !!! 1. Initialisation - -REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE) ! vertical boundaries @@ -174,7 +188,7 @@ IKB=KKA+KKL*JPVEXT IKE=KKU-KKL*JPVEXT ! updraft governing variables -IF (HMF_UPDRAFT == 'EDKF') THEN +IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN PENTR = 1.E20 PDETR = 1.E20 PEMF = 1.E20 @@ -183,9 +197,11 @@ ENDIF ! Thermodynamics functions ZFRAC_ICE(:,:) = 0. -WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20) - ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4)) -ENDWHERE +IF (SIZE(PRM,3).GE.4) THEN + WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20) + ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4)) + ENDWHERE +ENDIF CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:)) ! Conservative variables at t-dt @@ -211,9 +227,11 @@ IF (HMF_UPDRAFT == 'EDKF') THEN PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, & PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,& - PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH ) + PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH,& + PDX,PDY) ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN - CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,& + GENTR_DETR = .TRUE. + CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,& ONOMIXLG,KSV_LGBEG,KSV_LGEND, & PZZ,PDZZ, & PSFTH,PSFRV,PPABSM,PRHODREF, & @@ -224,23 +242,24 @@ ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,& PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH ) ELSEIF (HMF_UPDRAFT == 'RAHA') THEN - CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,& + CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, & + GENTR_DETR,OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & PZZ,PDZZ, & - PSFTH,PSFRV,PPABSM,PRHODREF, & - PUM,PVM,PTKEM, & - PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, & - PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & - PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, & - PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,& - PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH ) + PSFTH,PSFRV, & + PPABSM,PRHODREF,PUM,PVM,PTKEM, & + PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM, & + PSVM,PTHL_UP,PRT_UP, & + PRV_UP,PRC_UP,PRI_UP, PTHV_UP, & + PW_UP, PU_UP, PV_UP, ZSV_UP, & + PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP, & + PEMF,PDETR,PENTR, & + ZBUO_INTEG,KKLCL,KKETL,KKCTL, & + ZDEPTH ) ELSEIF (HMF_UPDRAFT == 'DUAL') THEN !Updraft characteristics are already computed and received by interface ELSE - WRITE(*,*) ' STOP' - WRITE(*,*) ' NO UPDRAFT MODEL FOR EDKF : CMF_UPDRAFT =',HMF_UPDRAFT - CALL ABORT - STOP + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//TRIM(HMF_UPDRAFT) ) ENDIF !!! 5. Compute diagnostic convective cloud fraction and content @@ -264,9 +283,9 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,& ZEMF_O_RHODREF=PEMF/PRHODREF IF ( PIMPL_MF > 1.E-10 ) THEN -CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, & + CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, & ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, & + PIMPL_MF, PTSTEP, & PDZZ, & PRHODJ, & ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, & @@ -275,12 +294,12 @@ CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, & PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & ZFLXZSVMF ) ELSE - CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, & - PRHODJ, & - ZTHLM,ZTHVM,ZRTM,PUM,PVM, & - PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, & - ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) + CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, & + PRHODJ, & + ZTHLM,ZTHVM,ZRTM,PUM,PVM, & + PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, & + ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & + PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) ENDIF ! security in the case HMF_UPDRAFT = 'DUAL' diff --git a/src/mesonh/turb/compute_entr_detr.f90 b/src/mesonh/turb/compute_entr_detr.f90 deleted file mode 100644 index 80a9d68db57ef58f31574c47e144887ab441ce7a..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_entr_detr.f90 +++ /dev/null @@ -1,488 +0,0 @@ -!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -! ######spl - MODULE MODI_COMPUTE_ENTR_DETR -! ############################## -! -INTERFACE -! - SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,& - HFRAC_ICE,PFRAC_ICE,PRHODREF,& - PPRE_MINUS_HALF,& - PPRE_PLUS_HALF,PZZ,PDZZ,& - PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,& - PTHL_UP,PRT_UP,PLUP,& - PRC_UP,PRI_UP,PTHV_UP,& - PRSAT_UP,PRC_MIX,PRI_MIX, & - PENTR,PDETR,PENTR_CLD,PDETR_CLD,& - PBUO_INTEG_DRY,PBUO_INTEG_CLD,& - PPART_DRY) - -!INTEGER, INTENT(IN) :: KK -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running -LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using - ! Temperature (T) or prescribed - ! (Y) -REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice -! -! prognostic variables at t- deltat -! -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref -REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK -REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment - -! -! thermodynamical variables which are transformed in conservative var. -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio -REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2 -REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground -REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content -REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft -REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft -REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content -REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy -REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level -! -! -END SUBROUTINE COMPUTE_ENTR_DETR - -END INTERFACE -! -END MODULE MODI_COMPUTE_ENTR_DETR -! ######spl - SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,& - HFRAC_ICE,PFRAC_ICE,PRHODREF,& - PPRE_MINUS_HALF,& - PPRE_PLUS_HALF,PZZ,PDZZ,& - PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,& - PTHL_UP,PRT_UP,PLUP,& - PRC_UP,PRI_UP,PTHV_UP,& - PRSAT_UP,PRC_MIX,PRI_MIX, & - PENTR,PDETR,PENTR_CLD,PDETR_CLD,& - PBUO_INTEG_DRY,PBUO_INTEG_CLD,& - PPART_DRY) -! ############################################################# - -!! -!!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft -!! using model of the EDMF scheme -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to compute entrainement and -!! detrainement at one level of the updraft -! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! Book 1 of Meso-NH documentation (chapter Convection) -!! -!! -!! AUTHOR -!! ------ -!! J.Pergaud : 2009 -!! -!! MODIFICATIONS -!! ------------- -!! Y.Seity (06/2010) Bug correction -!! V.Masson (09/2010) Optimization -!! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup -!! protection against too big ZPART_DRY, interface modified -!! S. Riette Jan 2012: support for both order of vertical levels -!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case -!! P.Marguinaud Jun 2012: fix uninitialized variable -!! P.Marguinaud Nov 2012: fix gfortran bug -!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and -!! improvement of continuity at the condensation level -!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR -!! R.Honnert Oct 2016 : Update with AROME -! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed -! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST -USE MODD_PARAM_MFSHALL_n -USE MODD_PARAMETERS, ONLY: XUNDEF - -USE MODE_THERMO - -USE MODI_TH_R_FROM_THL_RT_1D - -IMPLICIT NONE -! -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KK -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running -LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using - ! Temperature (T) or prescribed - ! (Y) -REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice -! -! prognostic variables at t- deltat -! -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref -REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK -REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment - -! -! thermodynamical variables which are transformed in conservative var. -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio -REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2 -REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground -REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content -REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft -REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft -REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content -REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft -REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part -REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy -REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level -! -! -! 1.2 Declaration of local variables -! -! - -! Variables for cloudy part -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI,ZDELTA ! factor entrainment detrainment -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI_CLOUD ! factor entrainment detrainment -REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr. -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHMIX ! Theta and Thetav of mixtures -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRSATW, ZRSATI ! working arrays (mixing ratio at saturation) -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV ! theta V of environment at the bottom of cloudy part -REAL :: ZKIC_INIT !Initial value of ZKIC -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part - -! Variables for dry part -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFOESW, ZFOESI ! saturating vapor pressure -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDRSATODP ! d.Rsat/dP -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZT ! Temperature -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZWK ! Work array - -! Variables for dry and cloudy parts -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk - ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZPRE ! pressure at the bottom of the cloudy part -REAL, DIMENSION(SIZE(PTHVM,1)) :: ZG_O_THVREF -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFRAC_ICE ! fraction of ice -REAL :: ZRVORD ! RV/RD -REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK - ZTHV_MINUS_HALF,& ! Thv at flux point(kk) - ZTHV_PLUS_HALF,& ! Thv at flux point(kk+kkl) - ZDZ ! Delta Z used in computations -INTEGER :: JI,JLOOP - -!---------------------------------------------------------------------------------- - -! 1.3 Initialisation -! ------------------ - - - ZRVORD = XRV / XRD !=1.607 - ZG_O_THVREF(:)=XG/PTHVM(:,KK) - ZCOEFFMF_CLOUD=XENTR_MF * XG / XCRAD_MF - - ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice - - ZPRE(:)=PPRE_MINUS_HALF(:) - ZMIXTHL(:)=0.1 - ZMIXRT(:)=0.1 - - !Initialize PPART_DRY everywhere to prevent access to non-initialized values - ! (intent(out) arrays have undefined values at subroutine entry) - PPART_DRY(:) = XUNDEF - -! 1.4 Estimation of PPART_DRY - DO JLOOP=1,SIZE(OTEST) - IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN - !No dry part when condensation level is reached - PPART_DRY(JLOOP)=0. - ZDZ_STOP(JLOOP)=0. - ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP) - ELSE IF (OTEST(JLOOP) .AND. .NOT. OTESTLCL(JLOOP)) THEN - !Temperature at flux level KK - ZT(JLOOP)=PTH_UP(JLOOP)*(PPRE_MINUS_HALF(JLOOP)/XP00) ** (XRD/XCPD) - !Saturating vapor pressure at flux level KK - ZFOESW(JLOOP) = MIN(EXP( XALPW - XBETAW/ZT(JLOOP) - XGAMW*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP)) - ZFOESI(JLOOP) = MIN(EXP( XALPI - XBETAI/ZT(JLOOP) - XGAMI*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP)) - !Computation of d.Rsat / dP (partial derivations with respect to P and T - !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up - !constant at the vertical) - ZDRSATODP(JLOOP)=(XBETAW/ZT(JLOOP)-XGAMW)*(1-ZFRAC_ICE(JLOOP))+(XBETAI/ZT(JLOOP)-XGAMI)*ZFRAC_ICE(JLOOP) - ZDRSATODP(JLOOP)=((XRD/XCPD)*ZDRSATODP(JLOOP)-1.)*PRSAT_UP(JLOOP)/ & - &(PPRE_MINUS_HALF(JLOOP)-(ZFOESW(JLOOP)*(1-ZFRAC_ICE(JLOOP)) + ZFOESI(JLOOP)*ZFRAC_ICE(JLOOP))) - !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE) - !where Rsat is equal to PRT_UP - ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)+(PRT_UP(JLOOP)-PRSAT_UP(JLOOP))/ZDRSATODP(JLOOP) - !Fraction of dry part (computed with pressure and used with heights, no - !impact found when using log function here and for pressure on flux levels - !computation) - PPART_DRY(JLOOP)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JLOOP)-ZPRE(JLOOP))/(PPRE_MINUS_HALF(JLOOP)-PPRE_PLUS_HALF(JLOOP)))) - !Height above flux level KK of the cloudy part - ZDZ_STOP(JLOOP) = (PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*PPART_DRY(JLOOP) - END IF - END DO - -! 1.5 Gradient and flux values of thetav - IF(KK/=KKB)THEN - ZCOEFF_MINUS_HALF(:)=((PTHVM(:,KK)-PTHVM(:,KK-KKL))/PDZZ(:,KK)) - ZTHV_MINUS_HALF(:) = PTHVM(:,KK) - ZCOEFF_MINUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK)) - ELSE - ZCOEFF_MINUS_HALF(:)=0. - ZTHV_MINUS_HALF(:) = PTHVM(:,KK) - ENDIF - ZCOEFF_PLUS_HALF(:) = ((PTHVM(:,KK+KKL)-PTHVM(:,KK))/PDZZ(:,KK+KKL)) - ZTHV_PLUS_HALF(:) = PTHVM(:,KK) + ZCOEFF_PLUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK)) - -! 2 Dry part computation: -! Integral buoyancy and computation of PENTR and PDETR for dry part -! -------------------------------------------------------------------- - -DO JLOOP=1,SIZE(OTEST) - IF (OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.) THEN - ZDZ(JLOOP)=MIN(ZDZ_STOP(JLOOP),(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5) - PBUO_INTEG_DRY(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*& - (0.5 * ( - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) & - - ZTHV_MINUS_HALF(JLOOP) + PTHV_UP(JLOOP) ) - - !Between mass flux KK and bottom of cloudy part (if above mass flux) - ZDZ(JLOOP)=MAX(0., ZDZ_STOP(JLOOP)-(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5) - PBUO_INTEG_DRY(JLOOP) = PBUO_INTEG_DRY(JLOOP) + ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*& - (0.5 * ( - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP) & - - PTHVM(JLOOP,KK) + PTHV_UP(JLOOP) ) - IF (PBUO_INTEG_DRY(JLOOP)>=0.) THEN - PENTR(JLOOP) = 0.5/(XABUO-XBENTR*XENTR_DRY)*& - LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JLOOP,KK))* & - PBUO_INTEG_DRY(JLOOP)) - PDETR(JLOOP) = 0. - ELSE - PENTR(JLOOP) = 0. - PDETR(JLOOP) = 0.5/(XABUO)*& - LOG(1.+ (2.*(XABUO)/PW_UP2(JLOOP,KK))* & - (-PBUO_INTEG_DRY(JLOOP))) - ENDIF - PENTR(JLOOP) = XENTR_DRY*PENTR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) - PDETR(JLOOP) = XDETR_DRY*PDETR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) - !Minimum value of detrainment - ZWK(JLOOP)=PLUP(JLOOP)-0.5*(PZZ(JLOOP,KK)+PZZ(JLOOP,KK+KKL)) - ZWK(JLOOP)=SIGN(MAX(1., ABS(ZWK(JLOOP))), ZWK(JLOOP)) ! ZWK must not be zero - PDETR(JLOOP) = MAX(PPART_DRY(JLOOP)*XDETR_LUP/ZWK(JLOOP), PDETR(JLOOP)) - ELSE - !No dry part, consation reached (OTESTLCL) - PBUO_INTEG_DRY(JLOOP) = 0. - PENTR(JLOOP)=0. - PDETR(JLOOP)=0. - END IF -ENDDO - - -! 3 Wet part computation -! ----------------------- - -! 3.1 Integral buoyancy for cloudy part - - ! Compute theta_v of updraft at flux level KK+KKL - !MIX variables are used to avoid declaring new variables - !but we are dealing with updraft and not mixture - ZRCMIX(:)=PRC_UP(:) - ZRIMIX(:)=PRI_UP(:) - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,& - PPRE_PLUS_HALF,PTHL_UP,PRT_UP,& - ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,& - ZRSATW, ZRSATI) - ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:)) - - ! Integral buoyancy for cloudy part - DO JLOOP=1,SIZE(OTEST) - IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)<1.) THEN - !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change - !between flux level KK and bottom of cloudy part - ZCOTHVU(JLOOP)=(ZTHV_UP_F2(JLOOP)-PTHV_UP(JLOOP))/((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*(1-PPART_DRY(JLOOP))) - - !Computation in two parts to use change of gradient of theta v of environment - !Between bottom of cloudy part (if under mass level) and mass level KK - ZDZ(JLOOP)=MAX(0., 0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP)) - PBUO_INTEG_CLD(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*& - (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) & - - (PTHVM(JLOOP,KK)-ZDZ(JLOOP)*ZCOEFF_MINUS_HALF(JLOOP)) + PTHV_UP(JLOOP) ) - - !Between max(mass level, bottom of cloudy part) and flux level KK+KKL - ZDZ(JLOOP)=(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-MAX(ZDZ_STOP(JLOOP),0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))) - PBUO_INTEG_CLD(JLOOP) = PBUO_INTEG_CLD(JLOOP)+ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*& - (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP)& - - (PTHVM(JLOOP,KK)+(0.5*((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))-ZDZ(JLOOP))*ZCOEFF_PLUS_HALF(JLOOP)) +& - PTHV_UP(JLOOP) ) - - ELSE - !No cloudy part - PBUO_INTEG_CLD(JLOOP)=0. - END IF - END DO - -! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and -! for bottom of cloudy part (ZKIC), then a mean for the cloudy part -! (put also in ZKIC) -! -! computation by estimating unknown -! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix -! We determine the zero crossing of the linear curve -! evaluating the derivative using ZMIXF=0.1 - - ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part - - ! Compute thetaV of environment at the bottom of cloudy part - ! and cons then non cons. var. of mixture at the bottom of cloudy part - - ! JI computed to avoid KKL(KK-KKL) being < KKL*KKB - JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB) - DO JLOOP=1,SIZE(OTEST) - IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.5) THEN - ZDZ(JLOOP)=ZDZ_STOP(JLOOP)-0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)) - ZTHV(JLOOP)= PTHVM(JLOOP,KK)+ZCOEFF_PLUS_HALF(JLOOP)*ZDZ(JLOOP) - ZMIXTHL(JLOOP) = ZKIC_INIT * & - (PTHLM(JLOOP,KK)+ZDZ(JLOOP)*(PTHLM(JLOOP,KK+KKL)-PTHLM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + & - (1. - ZKIC_INIT)*PTHL_UP(JLOOP) - ZMIXRT(JLOOP) = ZKIC_INIT * & - (PRTM(JLOOP,KK)+ZDZ(JLOOP)*(PRTM(JLOOP,KK+KKL)-PRTM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + & - (1. - ZKIC_INIT)*PRT_UP(JLOOP) - ELSEIF(OTEST(JLOOP)) THEN - ZDZ(JLOOP)=0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP) - ZTHV(JLOOP)= PTHVM(JLOOP,KK)-ZCOEFF_MINUS_HALF(JLOOP)*ZDZ(JLOOP) - ZMIXTHL(JLOOP) = ZKIC_INIT * & - (PTHLM(JLOOP,KK)-ZDZ(JLOOP)*(PTHLM(JLOOP,KK)-PTHLM(JLOOP,JI))/PDZZ(JLOOP,KK)) + & - (1. - ZKIC_INIT)*PTHL_UP(JLOOP) - ZMIXRT(JLOOP) = ZKIC_INIT * & - (PRTM(JLOOP,KK)-ZDZ(JLOOP)*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + & - (1. - ZKIC_INIT)*PRT_UP(JLOOP) - ENDIF - ENDDO - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,& - ZPRE,ZMIXTHL,ZMIXRT,& - ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,& - ZRSATW, ZRSATI) - ZTHVMIX(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:)) - - ! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC - ZMIXTHL(:) = ZKIC_INIT * 0.5*(PTHLM(:,KK)+PTHLM(:,KK+KKL))+(1. - ZKIC_INIT)*PTHL_UP(:) - ZMIXRT(:) = ZKIC_INIT * 0.5*(PRTM(:,KK)+PRTM(:,KK+KKL))+(1. - ZKIC_INIT)*PRT_UP(:) - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,& - PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,& - ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,& - ZRSATW, ZRSATI) - ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:)) - - !Computation of mean ZKIC over the cloudy part - DO JLOOP=1,SIZE(OTEST) - IF (OTEST(JLOOP)) THEN - ! Compute ZKIC at the bottom of cloudy part - ! Thetav_up at bottom is equal to Thetav_up at flux level KK - IF (ABS(PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))<1.E-10) THEN - ZKIC(JLOOP)=1. - ELSE - ZKIC(JLOOP) = MAX(0.,PTHV_UP(JLOOP)-ZTHV(JLOOP))*ZKIC_INIT / & - (PTHV_UP(JLOOP)-ZTHVMIX(JLOOP)) - END IF - ! Compute ZKIC_F2 at flux level KK+KKL - IF (ABS(ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))<1.E-10) THEN - ZKIC_F2(JLOOP)=1. - ELSE - ZKIC_F2(JLOOP) = MAX(0.,ZTHV_UP_F2(JLOOP)-ZTHV_PLUS_HALF(JLOOP))*ZKIC_INIT / & - (ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP)) - END IF - !Mean ZKIC over the cloudy part - ZKIC(JLOOP)=MAX(MIN(0.5*(ZKIC(JLOOP)+ZKIC_F2(JLOOP)),1.),0.) - END IF - END DO - - -! 3.3 Integration of PDF -! According to Kain and Fritsch (1990), we replace delta Mt -! in eq. (7) and (8) using eq. (5). Here we compute the ratio -! of integrals without computing delta Me - - !Constant PDF - !For this PDF, eq. (5) is delta Me=0.5*delta Mt - DO JLOOP=1,SIZE(OTEST) - IF(OTEST(JLOOP)) THEN - ZEPSI(JLOOP) = ZKIC(JLOOP)**2. !integration multiplied by 2 - ZDELTA(JLOOP) = (1.-ZKIC(JLOOP))**2. !idem - ENDIF - ENDDO - - !Triangular PDF - !Calculus must be verified before activating this part, but in this state, - !results on ARM case are almost identical - !For this PDF, eq. (5) is also delta Me=0.5*delta Mt - !WHERE(OTEST) - ! !Integration multiplied by 2 - ! WHERE(ZKIC<0.5) - ! ZEPSI(:)=8.*ZKIC(:)**3/3. - ! ZDELTA(:)=1.-4.*ZKIC(:)**2+8.*ZKIC(:)**3/3. - ! ELSEWHERE - ! ZEPSI(:)=5./3.-4*ZKIC(:)**2+8.*ZKIC(:)**3/3. - ! ZDELTA(:)=8.*(1.-ZKIC(:))**3/3. - ! ENDWHERE - !ENDWHERE - -! 3.4 Computation of PENTR and PDETR - DO JLOOP=1,SIZE(OTEST) - IF(OTEST(JLOOP)) THEN - ZEPSI_CLOUD(JLOOP)=MIN(ZDELTA(JLOOP),ZEPSI(JLOOP)) - PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD(JLOOP) - PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP) - PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP) - PDETR(JLOOP) = PDETR(JLOOP)+PDETR_CLD(JLOOP) - ELSE - PENTR_CLD(JLOOP) = 0. - PDETR_CLD(JLOOP) = 0. - ENDIF - ENDDO - -END SUBROUTINE COMPUTE_ENTR_DETR diff --git a/src/mesonh/turb/compute_function_thermo_mf.f90 b/src/mesonh/turb/compute_function_thermo_mf.f90 deleted file mode 100644 index ae9499c7008d5bd965ba30482a71e048d98c6f78..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_function_thermo_mf.f90 +++ /dev/null @@ -1,238 +0,0 @@ -!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. -! ######spl - MODULE MODI_COMPUTE_FUNCTION_THERMO_MF -! ###################################### -! -INTERFACE - -! ################################################################# - SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, & - PTH, PR, PEXN, PFRAC_ICE, PPABS, & - PT, PAMOIST,PATHETA ) -! ################################################################# - -!* 1.1 Declaration of Arguments -! - -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. - -REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta -REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species -REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct. -REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction - -REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature - -REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA -! -END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF - -END INTERFACE -! -END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF -! ######spl - SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, & - PTH, PR, PEXN, PFRAC_ICE, PPABS, & - PT,PAMOIST,PATHETA ) -! ################################################################# -! -!! -!!**** *COMPUTE_FUNCTION_THERMO_MF* - -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! JP Pinty *LA* -!! -!! MODIFICATIONS -!! ------------- -!! Original 24/02/03 -!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007) -!! Optimization : V.Masson, 09/2010 -!! S. Riette Sept 2011 : remove of unused PL?OCPEXN, use of received ice fraction -!! -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST -! -IMPLICIT NONE -! -! -!* 0.1 declarations of arguments -! -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. - -REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta -REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species -REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct. -REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction - -REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature - -REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA -! -!------------------------------------------------------------------------------- -! -!* 0.2 Declarations of local variables -! -REAL :: ZEPS ! XMV / XMD -REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: & - ZCP, & ! Cp - ZE, & ! Saturation mixing ratio - ZDEDT, & ! Saturation mixing ratio derivative - ZAMOIST_W, & ! Coefficients for s = f (Thetal,Rnp) - ZATHETA_W, & ! - ZAMOIST_I, & ! - ZATHETA_I, & ! - ZLVOCP,ZLSOCP - -INTEGER :: JRR -! -!------------------------------------------------------------------------------- -! -! - ZEPS = XMV / XMD - -! -!* Cph -! -ZCP=XCPD - -IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1) - -DO JRR = 2,1+KRRL ! loop on the liquid components - ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR) -END DO - -DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components - ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR) -END DO - -!* Temperature -! -PT(:,:) = PTH(:,:) * PEXN(:,:) -! -! -!! Liquid water -! -IF ( KRRL >= 1 ) THEN -! -!* Lv/Cph -! - ZLVOCP(:,:) = (XLVTT + (XCPV-XCL) * (PT(:,:)-XTT) ) / ZCP(:,:) -! -!* Saturation vapor pressure with respect to water -! - ZE(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*ALOG( PT(:,:) ) ) -! -!* Saturation mixing ratio with respect to water -! - ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) ) -! -!* Compute the saturation mixing ratio derivative (rvs') -! - ZDEDT(:,:) = ( XBETAW / PT(:,:) - XGAMW ) / PT(:,:) & - * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS ) -! -!* Compute Amoist -! - ZAMOIST_W(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLVOCP(:,:) ) -! -!* Compute Atheta -! - ZATHETA_W(:,:)= ZAMOIST_W(:,:) * PEXN(:,:) * & - ( ( ZE(:,:) - PR(:,:,1) ) * ZLVOCP(:,:) / & - ( 1. + ZDEDT(:,:) * ZLVOCP(:,:) ) * & - ( & - ZE(:,:) * (1. + ZE(:,:)/ZEPS) & - * ( -2.*XBETAW/PT(:,:) + XGAMW ) / PT(:,:)**2 & - +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) & - * ( XBETAW/PT(:,:) - XGAMW ) / PT(:,:) & - ) & - - ZDEDT(:,:) & - ) - -! -!! Solid water -! - IF ( KRRI >= 1 ) THEN - -! -!* Ls/Cph -! - ZLSOCP(:,:) = (XLSTT + (XCPV-XCI) * (PT(:,:)-XTT) ) / ZCP(:,:) -! -!* Saturation vapor pressure with respect to ice -! - ZE(:,:) = EXP( XALPI - XBETAI/PT(:,:) - XGAMI*ALOG( PT(:,:) ) ) -! -!* Saturation mixing ratio with respect to ice -! - ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) ) -! -!* Compute the saturation mixing ratio derivative (rvs') -! - ZDEDT(:,:) = ( XBETAI / PT(:,:) - XGAMI ) / PT(:,:) & - * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS ) -! -!* Compute Amoist -! - ZAMOIST_I(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLSOCP(:,:) ) -! -!* Compute Atheta -! - ZATHETA_I(:,:)= ZAMOIST_I(:,:) * PEXN(:,:) * & - ( ( ZE(:,:) - PR(:,:,1) ) * ZLSOCP(:,:) / & - ( 1. + ZDEDT(:,:) * ZLSOCP(:,:) ) * & - ( & - ZE(:,:) * (1. + ZE(:,:)/ZEPS) & - * ( -2.*XBETAI/PT(:,:) + XGAMI ) / PT(:,:)**2 & - +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) & - * ( XBETAI/PT(:,:) - XGAMI ) / PT(:,:) & - ) & - - ZDEDT(:,:) & - ) - - ELSE - ZAMOIST_I(:,:)=0. - ZATHETA_I(:,:)=0. - ENDIF - - PAMOIST(:,:) = (1.0-PFRAC_ICE(:,:))*ZAMOIST_W(:,:) & - +PFRAC_ICE(:,:) *ZAMOIST_I(:,:) - PATHETA(:,:) = (1.0-PFRAC_ICE(:,:))*ZATHETA_W(:,:) & - +PFRAC_ICE(:,:) *ZATHETA_I(:,:) - -! -ELSE - PAMOIST(:,:) = 0. - PATHETA(:,:) = 0. -ENDIF -END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF diff --git a/src/mesonh/turb/compute_mf_cloud.f90 b/src/mesonh/turb/compute_mf_cloud.f90 deleted file mode 100644 index 23f94bce58fd8595d043f8050b86189873745c78..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_mf_cloud.f90 +++ /dev/null @@ -1,196 +0,0 @@ -!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD -! ############################ -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,& - PFRAC_ICE, & - PRC_UP,PRI_UP,PEMF, & - PTHL_UP, PRT_UP, PFRAC_UP, & - PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, & - PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, & - PDZZ, PZZ, KKLCL, & - PPABSM, PRHODREF, & - PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH ) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content and -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! cloud fraction for MF scheme -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud - -END SUBROUTINE COMPUTE_MF_CLOUD - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD -! ######spl - SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD, & - PFRAC_ICE, & - PRC_UP,PRI_UP,PEMF, & - PTHL_UP, PRT_UP, PFRAC_UP, & - PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, & - PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, & - PDZZ, PZZ, KKLCL, & - PPABSM, PRHODREF, & - PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH ) -! ################################################################# -!! -!!**** *COMPUTE_MF_CLOUD* - -!! compute diagnostic subgrid cumulus cloud caracteristics -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to compute the cloud fraction and -!! the mean cloud content associated with clouds described by the -!! mass flux scheme -!! -! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! -!! MODIFICATIONS -!! ------------- -!! Original -!! S. Riette Dec 2010 BIGA case -!! S. Riette Aug 2011 code is split into subroutines -!! S. Riette Jan 2012: support for both order of vertical levels -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -use mode_msg -! -USE MODI_COMPUTE_MF_CLOUD_BIGAUS -USE MODI_COMPUTE_MF_CLOUD_DIRECT -USE MODI_COMPUTE_MF_CLOUD_STAT -! - -IMPLICIT NONE - -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud) -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud - -! -! 1.2 Declaration of local variables -! -!------------------------------------------------------------------------ - -! 1. INITIALISATION -! -! -! 2.1 Internal domain - -PRC_MF = 0. -PRI_MF = 0. -PCF_MF = 0. -PSIGMF = 0. - -IF (HMF_CLOUD == 'DIRE') THEN - !Direct cloud scheme - CALL COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, & - &KKLCL(:), PFRAC_UP(:,:), PRC_UP(:,:), PRI_UP(:,:),& - &PRC_MF(:,:), PRI_MF(:,:), PCF_MF(:,:)) - ! -ELSEIF (HMF_CLOUD == 'STAT') THEN - !Statistical scheme using the PDF proposed by Bougeault (81, 82) and - !Bechtold et al (95). - CALL COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,& - &PFRAC_ICE,& - &PTHLM, PRTM, PPABSM, PRM,& - &PDZZ, PTHM, PEXNM,& - &PEMF, PTHL_UP, PRT_UP,& - &PSIGMF) -ELSEIF (HMF_CLOUD == 'BIGA') THEN - !Statistical scheme using the bi-gaussian PDF proposed by E. Perraud. - CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - &PEMF, PDEPTH,& - &PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& - &PRTM, PTHM, PTHVM,& - &PDZZ, PZZ, PRHODREF,& - &PRC_MF, PRI_MF, PCF_MF) - ! -ELSEIF (HMF_CLOUD == 'NONE') THEN - ! No CONVECTIVE CLOUD SCHEME - ! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero -ELSE - call Print_msg(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD)) -ENDIF - -END SUBROUTINE COMPUTE_MF_CLOUD diff --git a/src/mesonh/turb/compute_mf_cloud_bigaus.f90 b/src/mesonh/turb/compute_mf_cloud_bigaus.f90 deleted file mode 100644 index b080f9923a6aff7ef04af89ddcaba2d4a6ca6405..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_mf_cloud_bigaus.f90 +++ /dev/null @@ -1,209 +0,0 @@ -!MNH_LIC Copyright 2011-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS -! ################################### -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - PEMF, PDEPTH,& - PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& - PRTM, PTHM, PTHVM,& - PDZZ, PZZ, PRHODREF,& - PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme - -END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS -! ######spl - SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,& - PEMF, PDEPTH,& - PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,& - PRTM, PTHM, PTHVM,& - PDZZ, PZZ, PRHODREF,& - PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -!!**** *COMPUTE_MF_CLOUD_BIGAUS* - -!! compute diagnostic subgrid cumulus cloud caracteristics with a statistical scheme -!! based on a bi-gaussian PDF. In this routine, we only compute the shallow convection -!! part of this bi-gaussian -!! -!! PURPOSE -!! ------- -!!**** With this option, a formulation for the computation of the variance of the departure -!! to saturation is proposed. This variance is used to compute the cloud fraction and -!! the mean convective cloud content from the bi-gaussian PDF proposed by E. Perraud -!! -! -!!** METHOD -!! ------ -!! Updraft variables are used to diagnose the variance -!! Perraud et al (2011) -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! S. Riette moving of code previously in compute_mf_cloud code -!! -!! MODIFICATIONS -!! ------------- -!! Original 25 Aug 2011 -!! S. Riette Jan 2012: support for both order of vertical levels -!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -USE MODD_PARAM_MFSHALL_n, ONLY : XALPHA_MF, XSIGMA_MF -USE MODD_CST, ONLY : XPI, XG -! -USE MODI_SHUMAN_MF -USE MODI_GAMMA_INC -! -USE MODE_THERMO -! -! -IMPLICIT NONE -! -!* 0.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics -REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud -REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme -! -!* 0.1 Declaration of local variables -! -! -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZGRAD_Z_RT, & ! - & ZALPHA_UP_M, & ! Variables used to compute variance - & ZSIGMF ! and sqrt(variance) -REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M ! -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array -INTEGER :: JK ! vertical loop control -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & ! - & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points - & ZFRAC_ICE_UP_M ! -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration - - -!Computation is done on mass points -!---------------------------------------------------------------------------- -! -!* 1. Computation of the variance -! ------------------------------------------------ -! -! -!Vertical gradient of RT, result on mass points -ZW1(:,:)=GZ_M_W_MF(KKA,KKU,KKL, PRTM(:,:), PDZZ(:,:)) -ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:)) - -!Interpolation on mass points -ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:)) -ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:)) -ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:)) -ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:)) -ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:)) - -!computation of omega star up -ZOMEGA_UP_M(:)=0. -DO JK=KKB,KKE,KKL - !Vertical integration over the entire column but only buoyant points are used - !ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + & - ! ZEMF_M(:,JK) * & - ! MAX(0.,(ZTHV_UP_M(:,JK)-PTHVM(:,JK))) * & - ! (PZZ(:,JK+KKL)-PZZ(:,JK)) / & - ! (PTHM(:,JK) * PRHODREF(:,JK)) - - !Vertical integration over the entire column - ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + & - ZEMF_M(:,JK) * & - (ZTHV_UP_M(:,JK)-PTHVM(:,JK)) * & - (PZZ(:,JK+KKL)-PZZ(:,JK)) / & - (PTHM(:,JK) * PRHODREF(:,JK)) -ENDDO -ZOMEGA_UP_M(:)=MAX(ZOMEGA_UP_M(:), 1.E-20) -ZOMEGA_UP_M(:)=(XG*ZOMEGA_UP_M(:))**(1./3.) - -!computation of alpha up -DO JK=KKA,KKU,KKL - ZALPHA_UP_M(:,JK)=ZEMF_M(:,JK)/(XALPHA_MF*PRHODREF(:,JK)*ZOMEGA_UP_M(:)) -ENDDO -ZALPHA_UP_M(:,:)=MAX(0., MIN(ZALPHA_UP_M(:,:), 1.)) - -!computation of sigma of the distribution -DO JK=KKA,KKU,KKL - ZSIGMF(:,JK)=ZEMF_M(:,JK) * & - (ZRT_UP_M(:,JK) - PRTM(:,JK)) * & - PDEPTH(:) * ZGRAD_Z_RT(:,JK) / & - (XSIGMA_MF * ZOMEGA_UP_M(:) * PRHODREF(:,JK)) -ENDDO -ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40)) -! -!* 2. PDF integration -! ------------------------------------------------ -! -!The mean of the distribution is ZRT_UP -!Computation of ZA and ZGAM (=efrc(ZA)) coefficient -ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:)) - -!Approximation of erf function -ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI)) - -!computation of cloud fraction -PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:))) - -!computation of condensate, then PRC and PRI -ZCOND(:,:)=(EXP(-ZA(:,:)**2)-ZA(:,:)*SQRT(XPI)*ZGAM(:,:))*ZSIGMF(:,:)/SQRT(2.*XPI) * ZALPHA_UP_M(:,:) -ZCOND(:,:)=MAX(ZCOND(:,:), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative -PRC_MF(:,:)=(1.-ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:) -PRI_MF(:,:)=( ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:) - - -END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS diff --git a/src/mesonh/turb/compute_mf_cloud_direct.f90 b/src/mesonh/turb/compute_mf_cloud_direct.f90 deleted file mode 100644 index c1c1b6220f77c571fad9b291f4d1863f76203239..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_mf_cloud_direct.f90 +++ /dev/null @@ -1,119 +0,0 @@ -!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. -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_DIRECT -! ################################### -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, & - &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,& - &PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud) -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme - -END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_DIRECT -! ######spl - SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, & - &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,& - &PRC_MF, PRI_MF, PCF_MF) -! ################################################################# -!! -!!**** *COMPUTE_MF_CLOUD_DIRECT* - -!! compute diagnostic subgrid cumulus cloud caracteristics with a direct scheme -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to compute the cloud fraction and -!! the mean cloud content associated with clouds described by the -!! mass flux scheme -!! -! -!!** METHOD -!! ------ -!! Updraft variables are used directly to diagnose subgrid clouds -!! This scheme may be activated only if the selected updraft model -!! gives the updraft fraction as an output -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! S. Riette moving of code previously in compute_mf_cloud code -!! -!! MODIFICATIONS -!! ------------- -!! Original 25 Aug 2011 -!! S. Riette Jan 2012: support for both order of vertical levels -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -USE MODD_PARAM_MFSHALL_n, ONLY : XKCF_MF -! -IMPLICIT NONE -! -!* 0.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content -REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme -! -!* 0.1 Declaration of local variables -! -INTEGER :: JI,JK -! -!* 0.2 Initialisation -! -! -!* 1. COMPUTATION OF SUBGRID CLOUD -! ---------------------------- - -! -! Warning: updraft variables are on flux levels -! and PRC_MF, PRI_MF and PCF_MF are on mass levels -PRC_MF(:,:)=0. -PRI_MF(:,:)=0. -PCF_MF(:,:)=0. - -DO JI=1,SIZE(PCF_MF,1) - DO JK=KKLCL(JI),KKE-KKL,KKL - PCF_MF(JI,JK ) = MAX( 0., MIN(1.,XKCF_MF *0.5* ( & - & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+KKL) ) )) - PRC_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) & - + PFRAC_UP(JI,JK+KKL)*PRC_UP(JI,JK+KKL) ) - PRI_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) & - + PFRAC_UP(JI,JK+KKL)*PRI_UP(JI,JK+KKL) ) - END DO -END DO - - -END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT diff --git a/src/mesonh/turb/compute_mf_cloud_stat.f90 b/src/mesonh/turb/compute_mf_cloud_stat.f90 deleted file mode 100644 index c3c78d4677e2624ff759e6a50da959d81f8fe251..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_mf_cloud_stat.f90 +++ /dev/null @@ -1,181 +0,0 @@ -!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. -! ######spl - MODULE MODI_COMPUTE_MF_CLOUD_STAT -! ############################ -! -INTERFACE -! ################################################################# - SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,& - &PFRAC_ICE,& - &PTHLM, PRTM, PPABSM, PRM,& - &PDZZ, PTHM, PEXNM,& - &PEMF, PTHL_UP, PRT_UP,& - &PSIGMF) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1 -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme - - -END SUBROUTINE COMPUTE_MF_CLOUD_STAT - -END INTERFACE -! -END MODULE MODI_COMPUTE_MF_CLOUD_STAT -! ######spl - SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,& - &PFRAC_ICE,& - &PTHLM, PRTM, PPABSM, PRM,& - &PDZZ, PTHM, PEXNM, & - &PEMF, PTHL_UP, PRT_UP,& - &PSIGMF) -! ################################################################# -!! -!!**** *COMPUTE_MF_CLOUD_STAT* - -!! compute diagnostic subgrid cumulus cloud caracteristics with a statistical scheme -!! -!! PURPOSE -!! ------- -!!**** With this option, a formulation for the computation of the variance of the departure -!! to saturation is proposed. -!! -! -!!** METHOD -!! ------ -!! Updraft variables are used to diagnose the variance -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! S. Riette moving of code previously in compute_mf_cloud code -!! -!! MODIFICATIONS -!! ------------- -!! Original 25 Aug 2011 -!! S. Riette Jan 2012: support for both order of vertical levels -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -USE MODD_PARAM_MFSHALL_n, ONLY : XTAUSIGMF -USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT -! -USE MODI_SHUMAN_MF -USE MODI_COMPUTE_FUNCTION_THERMO_MF -! -! -IMPLICIT NONE -! -!* 0.1 Declaration of Arguments -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1 -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme -! -!* 0.1 Declaration of local variables -! -! -REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZFLXZ -REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZT -REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZAMOIST, ZATHETA -! -!* 0.2 initialisation -! -! -!---------------------------------------------------------------------------- -! -!* 1. COMPUTE SIGMA_MF (saturation deviation variance) -! Soares et al (2004) formulation -! ------------------------------------------------ -! -! Thermodynamics functions -CALL COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, & - PTHM,PRM,PEXNM,PFRAC_ICE,PPABSM, & - ZT,ZAMOIST,ZATHETA ) -! -IF (KRRL > 0) THEN -! -!* 1.1 contribution from <THl THl> -! - -! - ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) * & - GZ_M_W_MF(KKA,KKU,KKL,PTHLM(:,:),PDZZ(:,:)) -! -! Avoid negative values - ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:)) - - - PSIGMF(:,:) = MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:)) * ZATHETA(:,:)**2 - -! -! -!* 1.2 contribution from <Rnp Rnp> -! -! -! -! - ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:))) * & - GZ_M_W_MF(KKA,KKU,KKL,PRTM(:,:),PDZZ(:,:)) -! -! Avoid negative values - ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:)) -! - - PSIGMF(:,:) = PSIGMF(:,:) + ZAMOIST(:,:) **2 * MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:)) -! -! 1.3 Vertical part of Sigma_s -! - PSIGMF(:,:) = SQRT( MAX (PSIGMF(:,:) , 0.) ) -ELSE - PSIGMF(:,:) = 0. -END IF -! -! -END SUBROUTINE COMPUTE_MF_CLOUD_STAT diff --git a/src/mesonh/turb/compute_updraft.f90 b/src/mesonh/turb/compute_updraft.f90 deleted file mode 100644 index 69985ecdb2976aa04462ab124cddfe561f38bffe..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_updraft.f90 +++ /dev/null @@ -1,647 +0,0 @@ -!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######spl - MODULE MODI_COMPUTE_UPDRAFT -! ########################### -! -INTERFACE -! -! ################################################################# - SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM,PTKEM, & - PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH) -! ################################################################# -! -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! entrainment, detrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT -! ######spl - SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM, PTKEM, & - PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) - -! ################################################################# -!! -!!**** *COMPUTE_UPDRAFT* - calculates caracteristics of the updraft -!! -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to build the updraft model -!! -! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! !! REFERENCE -!! --------- -!! Book 1 of Meso-NH documentation (chapter Turbulence) -!! Soares et al. 2004 QJ -!! -!! AUTHOR -!! ------ -!! J.Pergaud -!! V.Masson : Optimization 07/2010 -!! S. Riette : 07/2010 : modification for reproducibility -!! S. Riette may 2011: ice added, interface modified -!! S. Riette Jan 2012: support for both order of vertical levels -!! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value -!! S. Riette Apr 2013: improvement of continuity at the condensation level -!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME -!! Q.Rodier 01/2019 : support RM17 mixing length -!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution) -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST -USE MODD_PARAM_MFSHALL_n -USE MODD_TURB_n, ONLY : CTURBLEN - -USE MODI_COMPUTE_ENTR_DETR -USE MODI_TH_R_FROM_THL_RT_1D -USE MODI_SHUMAN_MF - -USE MODI_COMPUTE_BL89_ML -USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT - - -IMPLICIT NONE - -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! detrainment,entrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud -! 1.2 Declaration of local variables -! -! -! Mean environment variables at t-dt at flux point -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: & - ZTHM_F,ZRVM_F ! Theta,rv of - ! updraft environnement -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: & - ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure, - ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum - ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point - ZG_O_THVREF, & ! g*ThetaV ref - ZW_UP2, & ! w**2 of the updraft - ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy - ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment - -REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: & - ZSVM_F ! scalar variables - - -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: & - ZTH_UP, & ! updraft THETA - ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture - -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds - -REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav' - -REAL :: ZRDORV ! RD/RV -REAL :: ZRVORD ! RV/RD - - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground - -INTEGER :: ISV ! Number of scalar variables -INTEGER :: JK,JI,JSV ! loop counters - -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL - ! Test if the ascent continue, if LCL or ETL is reached -LOGICAL :: GLMIX - ! To choose upward or downward mixing length -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1 -LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2 - -INTEGER :: ITEST,JLOOP - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI,& - ZPART_DRY - -REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process - -REAL :: ZTMAX,ZRMAX ! control value - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear -! Thresholds for the perturbation of -! theta_l and r_t at the first level of the updraft -ZTMAX=2.0 -ZRMAX=1.E-3 -!------------------------------------------------------------------------ - -! INITIALISATION - -! Initialisation of the constants -ZRDORV = XRD / XRV !=0.622 -ZRVORD = (XRV / XRD) - -ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched -ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed - -! Local variables, internal domain -!number of scalar variables -ISV=SIZE(PSVM,3) - -IF (OENTR_DETR) THEN - ! Initialisation of intersesting Level :LCL,ETL,CTL - KKLCL(:)=KKE - KKETL(:)=KKE - KKCTL(:)=KKE - - ! - ! Initialisation - !* udraft governing variables - PEMF(:,:)=0. - PDETR(:,:)=0. - PENTR(:,:)=0. - - ! Initialisation - !* updraft core variables - PRV_UP(:,:)=0. - PRC_UP(:,:)=0. - PRI_UP(:,:)=0. - PW_UP(:,:)=0. - ZTH_UP(:,:)=0. - PFRAC_UP(:,:)=0. - PTHV_UP(:,:)=0. - - PBUO_INTEG=0. - - PFRAC_ICE_UP(:,:)=0. - PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used - - !cloud/dry air mixture cloud content - ZRC_MIX = 0. - ZRI_MIX = 0. - -END IF - -! Initialisation of environment variables at t-dt -! variables at flux level -ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:)) -ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:)) -ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:)) -ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:)) -ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:)) - -DO JSV=1,ISV - IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE - ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)) -END DO -! -! Initialisation of updraft characteristics -PTHL_UP(:,:)=ZTHLM_F(:,:) -PRT_UP(:,:)=ZRTM_F(:,:) -PU_UP(:,:)=ZUM_F(:,:) -PV_UP(:,:)=ZVM_F(:,:) -PSV_UP(:,:,:)=ZSVM_F(:,:,:) - - -! Computation or initialisation of updraft characteristics at the KKB level -! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF) - -PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) -PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) - - -IF (OENTR_DETR) THEN - ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:)) - ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:)) - ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:)) - ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:)) - - ! thetav at mass and flux levels - ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:))) - ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:))) - - PTHV_UP(:,:)=ZTHVM_F(:,:) - - ZW_UP2(:,:)=0. - ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB)) - - - ! Computation of non conservative variable for the KKB level of the updraft - ! (all or nothing ajustement) - PRC_UP(:,KKB)=0. - PRI_UP(:,KKB)=0. - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), & - PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), & - PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:)) - - ! compute updraft thevav and buoyancy term at KKB level - PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB))) - ! compute mean rsat in updraft - PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB) - - ! Closure assumption for mass flux at KKB level - ! - - ZG_O_THVREF=XG/ZTHVM_F - - ! compute L_up - GLMIX=.TRUE. - ZTKEM_F(:,KKB)=0. - ! - IF(CTURBLEN=='RM17') THEN - ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ)) - ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ)) - ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ) - ELSE - ZSHEAR = 0. !no shear in bl89 mixing length - END IF - ! - CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP) - ZLUP(:)=MAX(ZLUP(:),1.E-10) - - ! Compute Buoyancy flux at the ground - ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ & - (0.61*ZTHM_F(:,KKB))*PSFRV(:) - - ! Mass flux at KKB level (updraft triggered if PSFTH>0.) - IF (LGZ) THEN - ZSURF(:)=TANH(XGZ*SQRT(XDXHAT(1)*XDYHAT(1))/ZLUP) - ELSE - ZSURF(:)=1. - END IF - WHERE (ZWTHVSURF(:)>0.) - PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * & - ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.) - PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX) - ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2 - GTEST(:)=.TRUE. - ELSEWHERE - PEMF(:,KKB) =0. - GTEST(:)=.FALSE. - ENDWHERE -ELSE - GTEST(:)=PEMF(:,KKB+KKL)>0. -END IF - -!-------------------------------------------------------------------------- - -! 3. Vertical ascending loop -! ----------------------- -! -! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F -! -! -GTESTLCL(:)=.FALSE. -GTESTETL(:)=.FALSE. - -! Loop on vertical level -DO JK=KKB,KKE-KKL,KKL - -! IF the updraft top is reached for all column, stop the loop on levels - ITEST=COUNT(GTEST) - IF (ITEST==0) CYCLE - -! Computation of entrainment and detrainment with KF90 -! parameterization in clouds and LR01 in subcloud layer - - -! to find the LCL (check if JK is LCL or not) - - WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL))) - KKLCL(:) = JK - GTESTLCL(:)=.TRUE. - ENDWHERE - -! COMPUTE PENTR and PDETR at mass level JK - IF (OENTR_DETR) THEN - IF(JK/=KKB) THEN - ZRC_MIX(:,JK) = ZRC_MIX(:,JK-KKL) ! guess of Rc of mixture - ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture - ENDIF - CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),& - PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+KKL),& - PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), & - PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), & - PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), & - PRC_UP(:,JK),PRI_UP(:,JK),PTHV_UP(:,JK),& - PRSAT_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), & - PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),& - ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), & - ZPART_DRY(:) ) - PBUO_INTEG(:,JK)=ZBUO_INTEG_DRY(:,JK)+ZBUO_INTEG_CLD(:,JK) - - IF (JK==KKB) THEN - PDETR(:,JK)=0. - ZDETR_CLD(:,JK)=0. - ENDIF - -! Computation of updraft characteristics at level JK+KKL - WHERE(GTEST) - ZMIX1(:)=0.5*(PZZ(:,JK+KKL)-PZZ(:,JK))*(PENTR(:,JK)-PDETR(:,JK)) - PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(2*ZMIX1(:)) - ENDWHERE - ELSE - GTEST(:) = (PEMF(:,JK+KKL)>0.) - END IF - - -! stop the updraft if MF becomes negative - WHERE (GTEST.AND.(PEMF(:,JK+KKL)<=0.)) - PEMF(:,JK+KKL)=0. - KKCTL(:) = JK+KKL - GTEST(:)=.FALSE. - PFRAC_ICE_UP(:,JK+KKL)=PFRAC_ICE_UP(:,JK) - PRSAT_UP(:,JK+KKL)=PRSAT_UP(:,JK) - ENDWHERE - - -! If the updraft did not stop, compute cons updraft characteritics at jk+KKL -! WHERE(GTEST) - DO JLOOP=1,SIZE(GTEST) - IF (GTEST(JLOOP) ) THEN - ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !& - ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !& - ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK) - - !PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) & - ! /(1.+0.5*ZMIX2(JLOOP)) - !PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) & - ! /(1.+0.5*ZMIX2(JLOOP)) - - PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP))) - PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP))) - - END IF - END DO -! ENDWHERE - - - IF(OMIXUV) THEN - IF(JK/=KKB) THEN - WHERE(GTEST) - PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+& - (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+& - (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - ENDWHERE - ELSE - WHERE(GTEST) - PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) & - /(1+0.5*ZMIX2(:)) - PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) & - /(1+0.5*ZMIX2(:)) - ENDWHERE - - ENDIF - ENDIF - DO JSV=1,ISV - IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE - WHERE(GTEST) - PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + & - PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:)) - ENDWHERE - END DO - - IF (OENTR_DETR) THEN - -! Compute non cons. var. at level JK+KKL - ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below - ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), & - PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), & - ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:)) - WHERE(GTEST) - PRC_UP(:,JK+KKL)=ZRC_UP(:) - PRV_UP(:,JK+KKL)=ZRV_UP(:) - PRI_UP(:,JK+KKL)=ZRI_UP(:) - PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL) - ENDWHERE - - -! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL - WHERE(GTEST) - PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL))) - WHERE (ZBUO_INTEG_DRY(:,JK)>0.) - ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG_DRY(:,JK) - ELSEWHERE - ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG_DRY(:,JK) - ENDWHERE - ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK+KKL)*(1.-(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))& - /(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) & - +2.*(XABUO)*ZBUO_INTEG_CLD(:,JK)/(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) - ENDWHERE - - -! Test if the updraft has reach the ETL - GTESTETL(:)=.FALSE. - WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.)) - KKETL(:) = JK+KKL - GTESTETL(:)=.TRUE. - ENDWHERE - -! Test is we have reached the top of the updraft - WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=0.).OR.(PEMF(:,JK+KKL)<=0.))) - ZW_UP2(:,JK+KKL)=0. - PEMF(:,JK+KKL)=0. - GTEST(:)=.FALSE. - PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL) - PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL) - PRC_UP(:,JK+KKL)=0. - PRI_UP(:,JK+KKL)=0. - PRV_UP(:,JK+KKL)=0. - PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL) - PFRAC_UP(:,JK+KKL)=0. - KKCTL(:)=JK+KKL - ENDWHERE - -! compute frac_up at JK+KKL - WHERE (GTEST) - PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)) - ENDWHERE - -! Updraft fraction must be smaller than XFRAC_UP_MAX - WHERE (GTEST) - PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL)) - ENDWHERE - - -! When cloudy and non-buoyant, updraft fraction must decrease - - WHERE ((GTEST.AND.GTESTETL).AND.GTESTLCL) - PFRAC_UP(:,JK+KKL)=MIN(PFRAC_UP(:,JK+KKL),PFRAC_UP(:,JK)) - ENDWHERE - -! Mass flux is updated with the new updraft fraction - - IF (OENTR_DETR) PEMF(:,JK+KKL)=PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL) - - END IF - -ENDDO - -IF(OENTR_DETR) THEN - - PW_UP(:,:)=SQRT(ZW_UP2(:,:)) - - PEMF(:,KKB) =0. - -! Limits the shallow convection scheme when cloud heigth is higher than 3000m. -! To do this, mass flux is multiplied by a coefficient decreasing linearly -! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth). -! This way, all MF fluxes are diminished by this amount. -! Diagnosed cloud fraction is also multiplied by the same coefficient. -! - DO JI=1,SIZE(PTHM,1) - PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) - END DO - - GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) ) - GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) ) - ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2)) - ZCOEF=MIN(MAX(ZCOEF,0.),1.) - WHERE (GWORK2) - PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:) - PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:) - ENDWHERE -ENDIF -END SUBROUTINE COMPUTE_UPDRAFT diff --git a/src/mesonh/turb/compute_updraft_raha.f90 b/src/mesonh/turb/compute_updraft_raha.f90 deleted file mode 100644 index 1cf8c32b22ea103beb7c41b2f79a11e7abb549d6..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/compute_updraft_raha.f90 +++ /dev/null @@ -1,666 +0,0 @@ -!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######spl - MODULE MODI_COMPUTE_UPDRAFT_RAHA -! ########################### -! -INTERFACE -! -! ################################################################# - SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM, PTKEM, & - PEXNM,PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) -! ################################################################# -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt - -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc -REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv -REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction -REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft -REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! detrainment,entrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT_RAHA - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT_RAHA -! -! ######spl - SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM, PTKEM, & - PEXNM,PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH ) - -! ################################################################# -!! -!!**** *COMPUTE_UPDRAF_RAHA* - calculates caracteristics of the updraft -!! -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to build the updraft following Rio et al (2010) -!! Same as compute_updraft_rhcj10 exept the use of Hourdin et al closure -!! -! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! !! REFERENCE -!! --------- -!! Rio et al (2010) (Boundary Layer Meteorol 135:469-483) -!! Hourdin et al (xxxx) -!! -!! AUTHOR -!! ------ -!! Y. Bouteloup (2012) -!! R. Honnert Janv 2013 ==> corection of some coding bugs -!! Y. Bouteloup Janv 2014 ==> Allow the use of loops in the both direction -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ - -USE MODD_CST -USE MODD_PARAM_MFSHALL_n - -USE MODI_TH_R_FROM_THL_RT_1D -USE MODI_SHUMAN_MF - -IMPLICIT NONE - -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt - -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc -REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv -REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction -REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft -REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! detrainment,entrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud -! 1.2 Declaration of local variables -! -! -! Mean environment variables at t-dt at flux point -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of - ! updraft environnement -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure, -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft - -REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables - - - -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA -REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T -REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L -REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM - -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds - -REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav' - -REAL :: ZRDORV ! RD/RV -REAL :: ZRVORD ! RV/RD - - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3 - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness limit for cloud - -INTEGER :: ISV ! Number of scalar variables -INTEGER :: IKU,IIJU ! array size in k -INTEGER :: JK,JI,JJ,JSV ! loop counters - -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL - ! Test if the ascent continue, if LCL or ETL is reached -LOGICAL :: GLMIX - ! To choose upward or downward mixing length -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1 -LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2 - - -INTEGER :: ITEST - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI - -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST_FER -REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI,ZALIM_STAR_TOT -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ -INTEGER, DIMENSION(SIZE(PTHM,1)) :: IALIM - -REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN ! -REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE -REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT -REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft -REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft -REAL, DIMENSION(SIZE(PTHM,1)) :: ZA,ZB,ZQTM,ZQT_UP - -REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process - -REAL :: ZTMAX,ZRMAX, ZEPS ! control value - - -! Thresholds for the perturbation of -! theta_l and r_t at the first level of the updraft - -ZTMAX=2.0 -ZRMAX=1.E-3 -ZEPS=1.E-15 -!------------------------------------------------------------------------ -! INITIALISATION - -! Initialisation of the constants -ZRDORV = XRD / XRV !=0.622 -ZRVORD = (XRV / XRD) - -ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched -ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed - -! Local variables, internal domain -! Internal Domain - -IKU=SIZE(PTHM,2) -IIJU =SIZE(PTHM,1) -!number of scalar variables -ISV=SIZE(PSVM,3) - -! Initialisation of intersesting Level :LCL,ETL,CTL -KKLCL(:)=KKE -KKETL(:)=KKE -KKCTL(:)=KKE - -! -! Initialisation -!* udraft governing variables -PEMF(:,:)=0. -PDETR(:,:)=0. -PENTR(:,:)=0. - -! Initialisation -!* updraft core variables -PRV_UP(:,:)=0. -PRC_UP(:,:)=0. - -PW_UP(:,:)=0. -ZTH_UP(:,:)=0. -PFRAC_UP(:,:)=0. -PTHV_UP(:,:)=0. - -PBUO_INTEG=0. -ZBUO =0. - -!no ice cloud coded yet -PRI_UP(:,:)=0. -PFRAC_ICE_UP(:,:)=0. -PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used - -! Initialisation of environment variables at t-dt - -! variables at flux level -ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:)) -ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:)) -ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:)) -ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:)) -ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:)) - -!DO JSV=1,ISV -! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE -! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV)) -! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV) -!END DO - -! Initialisation of updraft characteristics -PTHL_UP(:,:)=ZTHLM_F(:,:) -PRT_UP(:,:)=ZRTM_F(:,:) -PU_UP(:,:)=ZUM_F(:,:) -PV_UP(:,:)=ZVM_F(:,:) -PSV_UP(:,:,:)=0. -!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then -! PSV_UP(:,:,:)=ZSVM_F(:,:,:) -!ENDIF - -! Computation or initialisation of updraft characteristics at the KKB level -! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF) - -PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) -PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) - -ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB)) -ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA_MF*ZQT_UP(:)) - -ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:)) -ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:)) -ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:)) -ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:)) - -! thetav at mass and flux levels -ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:))) -ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:))) - -PTHV_UP(:,:)= ZTHVM_F(:,:) -PRV_UP (:,:)= ZRVM_F (:,:) - -ZW_UP2(:,:)=ZEPS -ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB)) -GTEST = (ZW_UP2(:,KKB) > ZEPS) - -! Computation of non conservative variable for the KKB level of the updraft -! (all or nothing ajustement) -PRC_UP(:,KKB)=0. -PRI_UP(:,KKB)=0. - -CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), & - PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), & - PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:)) - -! compute updraft thevav and buoyancy term at KKB level -PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB))) -! compute mean rsat in updraft -PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB) - -!Tout est commente pour tester dans un premier temps la s�paration en deux de la -! boucle verticale, une pour w et une pour PEMF - -ZG_O_THVREF=XG/ZTHVM_F - - -! Definition de l'alimentation au sens de la fermeture de Hourdin et al - -ZALIM_STAR(:,:) = 0. -ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR -IALIM(:) = KKB ! <== Top level of the alimentation layer - -DO JK=KKB,KKE-KKL,KKL ! Vertical loop - ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level - ZZZ(:,JK) = MAX(0.,0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ) ! <== Hight of mass levels - ZDTHETASDZ(:,JK) = (ZTHVM_F(:,JK)-ZTHVM_F(:,JK+KKL)) ! <== Delta theta_v - - WHERE ((ZTHVM_F(:,JK+KKL)<ZTHVM_F(:,JK)) .AND. (ZTHVM_F(:,KKB)>=ZTHVM_F(:,JK))) - ZALIM_STAR(:,JK) = SQRT(ZZZ(:,JK))*ZDTHETASDZ(:,JK)/ZZDZ(:,JK) - ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:)+ZALIM_STAR(:,JK)*ZZDZ(:,JK) - IALIM(:) = JK - ENDWHERE -ENDDO - -! Normalization of ZALIM_STAR -DO JK=KKB,KKE-KKL,KKL ! Vertical loop - WHERE (ZALIM_STAR_TOT > ZEPS) - ZALIM_STAR(:,JK) = ZALIM_STAR(:,JK)/ZALIM_STAR_TOT(:) - ENDWHERE -ENDDO -ZALIM_STAR_TOT(:) = 0. - - -! --------- END of alimentation calculation --------------------------------------- - - -!-------------------------------------------------------------------------- - -! 3. Vertical ascending loop -! ----------------------- -! -! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F -! -! -GTESTLCL(:)=.FALSE. -GTESTETL(:)=.FALSE. - -! Loop on vertical level to compute W - -ZW_MAX(:) = 0. -ZZTOP(:) = 0. -ZPHI(:) = 0. - - -DO JK=KKB,KKE-KKL,KKL - -! IF the updraft top is reached for all column, stop the loop on levels - -! ITEST=COUNT(GTEST) -! IF (ITEST==0) CYCLE - -! Computation of entrainment and detrainment with KF90 -! parameterization in clouds and LR01 in subcloud layer - - -! to find the LCL (check if JK is LCL or not) - - WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL))) - KKLCL(:) = JK - GTESTLCL(:)=.TRUE. - ENDWHERE - - -! COMPUTE PENTR and PDETR at mass level JK - - -! Buoyancy is computed on "flux" levels where updraft variables are known - - ! Compute theta_v of updraft at flux level JK - - ZRC_UP(:) = PRC_UP(:,JK) - ZRI_UP(:) = PRI_UP(:,JK) ! guess - ZRV_UP(:) = PRV_UP(:,JK) - ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK)) - PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK)) - - ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) - ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK) - - ZCOE(:) = ZDZ(:) - WHERE (ZTEST(:)>0.) - ZCOE(:) = ZDZ(:)/(1.+ XBETA1) - ENDWHERE - -! Calcul de la vitesse - - ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:)) - ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:)) - - ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) ) - ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL))) - ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK))) - -! Entrainement et detrainement - - PENTR(:,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB)) - - ZDETR_BUO(:) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:)) - ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:)) - PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:) - - -! If the updraft did not stop, compute cons updraft characteritics at jk+1 - WHERE(GTEST) - ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL)) - ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !& - ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !& - - ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK)) - ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA_MF*ZQTM(:)) - ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL)) - PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(:)) - ENDWHERE - - - IF(OMIXUV) THEN - IF(JK/=KKB) THEN - WHERE(GTEST) - PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+& - (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+& - (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - ENDWHERE - ELSE - WHERE(GTEST) - PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) & - /(1+0.5*ZMIX2(:)) - PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) & - /(1+0.5*ZMIX2(:)) - ENDWHERE - - ENDIF - ENDIF -! DO JSV=1,ISV -! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE -! WHERE(GTEST) -! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + & -! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:)) -! ENDWHERE -! ENDDO - - -! Compute non cons. var. at level JK+KKL - ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below - ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below - ZRV_UP(:)=PRV_UP(:,JK) - CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), & - PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), & - ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:)) - WHERE(GTEST) - ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL) - ZCP(:) = XCPD + XCL * ZRC_UP(:) - ZLVOCPEXN(:)=(XLVTT + (XCPV-XCL) * (ZT_UP(:)-XTT) ) / ZCP(:) / PEXNM(:,JK+KKL) - PRC_UP(:,JK+KKL)=MIN(0.5E-3,ZRC_UP(:)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) - PTHL_UP(:,JK+KKL) = PTHL_UP(:,JK+KKL)+ZLVOCPEXN(:)*(ZRC_UP(:)-PRC_UP(:,JK+KKL)) - PRV_UP(:,JK+KKL)=ZRV_UP(:) - PRI_UP(:,JK+KKL)=ZRI_UP(:) - PRT_UP(:,JK+KKL) = PRC_UP(:,JK+KKL) + PRV_UP(:,JK+KKL) - PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL) - ENDWHERE - - -! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 - WHERE(GTEST) -! PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL))) - PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*(1.+0.608*PRV_UP(:,JK+KKL) - PRC_UP(:,JK+KKL)) - ENDWHERE - - -! Test if the updraft has reach the ETL - GTESTETL(:)=.FALSE. - WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.)) - KKETL(:) = JK+KKL - GTESTETL(:)=.TRUE. - ENDWHERE - -! Test is we have reached the top of the updraft - - WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS))) - ZW_UP2(:,JK+KKL)=ZEPS - GTEST(:)=.FALSE. - PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL) - PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL) - PRC_UP(:,JK+KKL)=0. - PRI_UP(:,JK+KKL)=0. - PRV_UP(:,JK+KKL)=0. - PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL) - PFRAC_UP(:,JK+KKL)=0. - KKCTL(:)=JK+KKL - ENDWHERE - -ENDDO - -! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !) -! Hourdin et al 2002 formulation - - -ZZTOP(:) = MAX(ZZTOP(:),ZEPS) - -DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop - WHERE(JK<=IALIM) - ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:) + ZALIM_STAR(:,JK)*ZALIM_STAR(:,JK)*ZZDZ(:,JK)/PRHODREF(:,JK) - ENDWHERE -ENDDO - -WHERE (ZALIM_STAR_TOT*ZZTOP > ZEPS) - ZPHI(:) = ZW_MAX(:)/(XR*ZZTOP(:)*ZALIM_STAR_TOT(:)) -ENDWHERE - -GTEST(:) = .TRUE. -PEMF(:,KKB+KKL) = ZPHI(:)*ZZDZ(:,KKB)*ZALIM_STAR(:,KKB) -! Updraft fraction must be smaller than XFRAC_UP_MAX -PFRAC_UP(:,KKB+KKL)=PEMF(:,KKB+KKL)/(SQRT(ZW_UP2(:,KKB+KKL))*ZRHO_F(:,KKB+KKL)) -PFRAC_UP(:,KKB+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,KKB+KKL)) -PEMF(:,KKB+KKL) = ZRHO_F(:,KKB+KKL)*PFRAC_UP(:,KKB+KKL)*SQRT(ZW_UP2(:,KKB+KKL)) - -DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop - - GTEST = (ZW_UP2(:,JK) > ZEPS) - - WHERE (GTEST) - WHERE(JK<IALIM) - PEMF(:,JK+KKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)*(PENTR(:,JK) - PDETR(:,JK))) - ELSEWHERE - ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK)) - PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:)) - ENDWHERE - -! Updraft fraction must be smaller than XFRAC_UP_MAX - PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)) - PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL)) - PEMF(:,JK+KKL) = ZRHO_F(:,JK+KKL)*PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL)) - ENDWHERE - -ENDDO - -PW_UP(:,:)=SQRT(ZW_UP2(:,:)) -PEMF(:,KKB) =0. - -! Limits the shallow convection scheme when cloud heigth is higher than 3000m. -! To do this, mass flux is multiplied by a coefficient decreasing linearly -! from 1 (for clouds of 3000m of depth) to 0 (for clouds of 4000m of depth). -! This way, all MF fluxes are diminished by this amount. -! Diagnosed cloud fraction is also multiplied by the same coefficient. -! -DO JI=1,SIZE(PTHM,1) - PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) -END DO - -GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) ) -GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU ) -ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU) -ZCOEF=MIN(MAX(ZCOEF,0.),1.) -WHERE (GWORK2) - PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:) - PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:) -ENDWHERE - - -END SUBROUTINE COMPUTE_UPDRAFT_RAHA diff --git a/src/mesonh/turb/mf_turb.f90 b/src/mesonh/turb/mf_turb.f90 deleted file mode 100644 index 2a96b713ab98f74b0fc5fd8128825d6028bacf87..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/mf_turb.f90 +++ /dev/null @@ -1,332 +0,0 @@ -!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_MF_TURB -! ###################### -! -INTERFACE -! ################################################################# - SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL, PTSTEP, & - PDZZ, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, & - PTHLDT,PRTDT,PUDT,PVDT,PSVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, & - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & - PFLXZSVMF ) - -! ################################################################# -! -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise - -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, INTENT(IN) :: PIMPL ! degree of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -! -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! scalar variables at t-dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT -! Tendencies of scalar variables -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT - - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF - -REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF - -END SUBROUTINE MF_TURB - -END INTERFACE -! -END MODULE MODI_MF_TURB - - -! ################################################################# - SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL, PTSTEP, & - PDZZ, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, & - PTHLDT,PRTDT,PUDT,PVDT,PSVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, & - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & - PFLXZSVMF ) - -! ################################################################# -! -! -!!**** *MF_TURB* - computes the MF_turbulent source terms for the prognostic -!! variables. -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to compute the source terms in -!! the evolution equations due to the MF turbulent mixing. -!! The source term is computed as the divergence of the turbulent fluxes. -! -!!** METHOD -!! ------ -!! -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! -!! MODIFICATIONS -!! ------------- -!! 10/2009 (C.Lac) Introduction of different PTSTEP according to the -!! advection schemes -!! 09/2010 (V.Masson) Optimization -!! S. Riette Jan 2012: support for both order of vertical levels -!! suppression of useless initialisations -!! -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_PARAM_MFSHALL_n -! -USE MODI_SHUMAN_MF -USE MODI_TRIDIAG_MASSFLUX -! -IMPLICIT NONE -! -! -!* 0.1 declarations of arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, INTENT(IN) :: PIMPL ! degree of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep -! -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! scalar variables at t-dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT -! Tendencies of scalar variables -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT - - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF - -REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF -! -! -! -!------------------------------------------------------------------------------- -! -! 0.2 declaration of local variables -! - -REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS - -! -INTEGER :: ISV,JSV !number of scalar variables and Loop counter -! -!---------------------------------------------------------------------------- -! -!* 1.PRELIMINARIES -! ------------- -! -! -! number of scalar var -ISV=SIZE(PSVM,3) - -! -PFLXZSVMF = 0. -PSVDT = 0. - -! -!---------------------------------------------------------------------------- -! -!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt -! (equation (3) of Soares et al) -! + THE MEAN FLUX OF THETA_V (buoyancy flux) -! ----------------------------------------------- -! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP ) -! - -PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) - -PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:))) - -PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:))) - -IF (OMIXUV) THEN - PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:))) - PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:))) -ELSE - PFLXZUMF(:,:) = 0. - PFLXZVMF(:,:) = 0. -ENDIF -! -! -!---------------------------------------------------------------------------- -! -!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...) -! (implicit formulation) -! -------------------------------------------- -! - -! -! -! 3.1 Compute the tendency for the conservative potential temperature -! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) -! -CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, & - PDZZ,PRHODJ,ZVARS ) -! compute new flux -PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:))) - -!!! compute THL tendency -! -PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP - -! -! 3.2 Compute the tendency for the conservative mixing ratio -! -CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, & - PDZZ,PRHODJ,ZVARS ) -! compute new flux -PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:))) - -!!! compute RT tendency -PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP -! - -IF (OMIXUV) THEN - ! - ! 3.3 Compute the tendency for the (non conservative but treated as it) zonal momentum - ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) - ! - - CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, & - PDZZ,PRHODJ,ZVARS ) - ! compute new flux - PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:))) - - ! compute U tendency - PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP - - ! - ! - ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing) - ! meridian momentum - ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) - ! - CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, & - PDZZ,PRHODJ,ZVARS ) - ! compute new flux - PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:))) - - ! compute V tendency - PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP -ELSE - PUDT(:,:)=0. - PVDT(:,:)=0. -ENDIF - -DO JSV=1,ISV - - IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE - - !* compute mean flux of scalar variables at time t-dt - ! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP ) - - PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))) - - ! - ! 3.5 Compute the tendency for scalar variables - ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) - ! - CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),& - -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS ) - ! compute new flux - PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS)) - - ! compute Sv tendency - PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP - -ENDDO -! -END SUBROUTINE MF_TURB diff --git a/src/mesonh/turb/mf_turb_expl.f90 b/src/mesonh/turb/mf_turb_expl.f90 deleted file mode 100644 index a22f092c2747410eef8c2728b1966736f8eeed2a..0000000000000000000000000000000000000000 --- a/src/mesonh/turb/mf_turb_expl.f90 +++ /dev/null @@ -1,227 +0,0 @@ -!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_MF_TURB_EXPL -! ###################### -! -INTERFACE -! -! ################################################################# - SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM, & - PTHLDT,PRTDT,PUDT,PVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & - PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) -! ################################################################# -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where - -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT - -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP - -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF - -END SUBROUTINE MF_TURB_EXPL - -END INTERFACE -! -END MODULE MODI_MF_TURB_EXPL -! - -! ######spl - SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, & - PRHODJ, & - PTHLM,PTHVM,PRTM,PUM,PVM, & - PTHLDT,PRTDT,PUDT,PVDT, & - PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & - PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) - -! ################################################################# -! -! -!!**** *MF_TURB_EXPL* - computes the MF_turbulent source terms for the prognostic -!! variables (when PIMPL=0) -!! -!! PURPOSE -!! ------- -!!**** The purpose of this routine is to compute the source terms in -!! the evolution equations due to the MF turbulent mixing. -!! The source term is computed as the divergence of the turbulent fluxes. -! -!!** METHOD -!! ------ -!! -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! -!! MODIFICATIONS -!! ------------- -!! -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ - -USE MODD_PARAM_MFSHALL_n -USE MODI_SHUMAN_MF - -IMPLICIT NONE - - -!* 0.1 declarations of arguments - - -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum - -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size - -! Conservative var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp. -REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where - -! Virtual potential temperature at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM -! Momentum at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM -REAL, DIMENSION(:,:), INTENT(IN) :: PVM -! -! Tendencies of conservative variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT - -REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT - -! Tendencies of momentum -REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT -REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT - -! Updraft characteritics -REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP - -! Fluxes -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF - -REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux -REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT -REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZTHLM_F,ZRTM_F - -INTEGER :: JK ! loop counter - -!---------------------------------------------------------------------------- -! -!* 1.PRELIMINARIES -! ------------- - -PFLXZRMF = 0. -PFLXZTHVMF = 0. -PFLXZTHLMF = 0. -PFLXZUMF = 0. -PFLXZVMF = 0. -PTHLDT = 0. -PRTDT = 0. -PUDT = 0. -PVDT = 0. - -! -!---------------------------------------------------------------------------- -! -!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt -! (equation (3) of Soares et al) -! + THE MEAN FLUX OF THETA_V (buoyancy flux) -! ----------------------------------------------- -! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP ) - -ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM (:,:)) -ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:)) -ZQTM (:,:) = ZRTM_F (:,:)/(1.+ZRTM_F (:,:)) -ZQT_UP (:,:) = PRT_UP (:,:)/(1.+PRT_UP (:,:)) -ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA_MF*ZQT_UP(:,:)) -ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA_MF*ZQTM(:,:)) - -PFLXZTHLMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) ! ThetaL -PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP (:,:)-MZM_MF(KKA,KKU,KKL,PRTM (:,:))) ! Rt -PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:))) ! ThetaV - -ZFLXZTHSMF(:,:) = PEMF(:,:)*(ZTHS_UP(:,:)-ZTHSM(:,:)) ! Theta S flux - -IF (OMIXUV) THEN - PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:))) ! U - PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:))) ! V -ELSE - PFLXZUMF(:,:) = 0. - PFLXZVMF(:,:) = 0. -ENDIF - - -!---------------------------------------------------------------------------- -! -!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...) -! (explicit formulation) -! -------------------------------------------- - -DO JK=KKB,KKE-KKL,KKL -! PTHLDT(:,JK) = (PFLXZTHLMF(:,JK ) - PFLXZTHLMF(:,JK+KKL)) / PRHODJ(:,JK) - PRTDT (:,JK) = (PFLXZRMF (:,JK ) - PFLXZRMF (:,JK+KKL)) / PRHODJ(:,JK) - ZQTDT (:,JK) = PRTDT (:,JK)/(1.+ ZRTM_F (:,JK)*ZRTM_F (:,JK)) - ZTHSDT(:,JK) = (ZFLXZTHSMF(:,JK ) - ZFLXZTHSMF(:,JK+KKL)) / PRHODJ(:,JK) - PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA_MF*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA_MF*ZQTDT(:,JK) -END DO - -IF (OMIXUV) THEN - DO JK=KKB,KKE-KKL,KKL - PUDT(:,JK) = (PFLXZUMF(:,JK ) - PFLXZUMF(:,JK+KKL)) / PRHODJ(:,JK) - PVDT(:,JK) = (PFLXZVMF(:,JK ) - PFLXZVMF(:,JK+KKL)) / PRHODJ(:,JK) - END DO -ENDIF - - -END SUBROUTINE MF_TURB_EXPL diff --git a/src/mesonh/turb/compute_updraft_rhcj10.f90 b/src/mesonh/turb/mode_compute_updraft_rhcj10.f90 similarity index 52% rename from src/mesonh/turb/compute_updraft_rhcj10.f90 rename to src/mesonh/turb/mode_compute_updraft_rhcj10.f90 index a918d05b0021aade1fb26a3458e62a5d7ca027d6..abcbdc1c09192e02db5e837a06c68f79fbb2e77a 100644 --- a/src/mesonh/turb/compute_updraft_rhcj10.f90 +++ b/src/mesonh/turb/mode_compute_updraft_rhcj10.f90 @@ -4,84 +4,11 @@ !MNH_LIC for details. version 1. !----------------------------------------------------------------- ! ######spl - MODULE MODI_COMPUTE_UPDRAFT_RHCJ10 + MODULE MODE_COMPUTE_UPDRAFT_RHCJ10 ! ########################### ! -INTERFACE -! -! ################################################################# - SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, & - OENTR_DETR,OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PZZ,PDZZ, & - PSFTH,PSFRV, & - PPABSM,PRHODREF,PUM,PVM,PTKEM, & - PTHM,PRVM,PTHLM,PRTM, & - PSVM,PTHL_UP,PRT_UP, & - PRV_UP,PRC_UP,PRI_UP,PTHV_UP, & - PW_UP,PU_UP, PV_UP, PSV_UP, & - PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, & - PEMF,PDETR,PENTR, & - PBUO_INTEG,KKLCL,KKETL,KKCTL, & - PDEPTH) -! ################################################################# -! -!* 1.1 Declaration of Arguments -! -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKB ! near ground physical index -INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV -! normal surface fluxes of theta,rv,(u,v) parallel to the orography -! -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt -! -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt - -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties -REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components -REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc - PRI_UP,PTHV_UP,& ! updraft ri, THv - PW_UP,PFRAC_UP,& ! updraft w, fraction - PFRAC_ICE_UP,& ! liquid/solid fraction in updraft - PRSAT_UP ! Rsat - -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var. - -REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux, - ! entrainment, detrainment -REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy -INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL -REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud - - -END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10 - -END INTERFACE -! -END MODULE MODI_COMPUTE_UPDRAFT_RHCJ10 +IMPLICIT NONE +CONTAINS ! SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & OENTR_DETR,OMIXUV, & @@ -99,7 +26,7 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & PDEPTH ) ! ################################################################# !! -!!**** *COMPUTE_UPDRAF_RHCJ10* - calculates caracteristics of the updraft +!!**** *COMPUTE_UPDRAFT_RHCJ10* - calculates caracteristics of the updraft !! !! !! PURPOSE @@ -124,35 +51,37 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, & !! ------ !! Y. Bouteloup (2012) !! R. Honert Janv 2013 ==> corection of some bugs -!! Q.Rodier 01/2019 : support RM17 mixing length +!! R. El Khatib 15-Oct-2014 Optimization +!! Q.Rodier 01/2019 : support RM17 mixing length !! -------------------------------------------------------------------------- ! WARNING ==> This updraft is not yet ready to use scalar variables !* 0. DECLARATIONS ! ------------ - +! USE MODD_CST USE MODD_PARAM_MFSHALL_n USE MODD_TURB_n, ONLY : CTURBLEN -USE MODI_COMPUTE_ENTR_DETR USE MODI_TH_R_FROM_THL_RT_1D -USE MODI_SHUMAN_MF +USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF -USE MODI_COMPUTE_BL89_ML +USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK IMPLICIT NONE !* 1.1 Declaration of Arguments - - +! +! INTEGER, INTENT(IN) :: KKA ! near ground array index INTEGER, INTENT(IN) :: KKB ! near ground physical index INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer @@ -194,13 +123,13 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud ! 1.2 Declaration of local variables - +! ! Mean environment variables at t-dt at flux point REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of ! updraft environnement REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure, REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point +REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F ! interpolated at the flux point REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft @@ -213,22 +142,20 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Bu REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds -REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav' +REAL :: ZWTHVSURF ! Surface w'thetav' -REAL :: ZRDORV ! RD/RV REAL :: ZRVORD ! RV/RD -REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3 +REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2 REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground - INTEGER :: ISV ! Number of scalar variables INTEGER :: IKU,IIJU ! array size in k -INTEGER :: JK,JI,JJ,JSV ! loop counters +INTEGER :: JK,JI,JSV ! loop counters -LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL +LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL ! Test if the ascent continue, if LCL or ETL is reached LOGICAL :: GLMIX ! To choose upward or downward mixing length @@ -239,21 +166,21 @@ INTEGER :: ITEST REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI -REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ,ZZZ +REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN ! REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft -REAL, DIMENSION(SIZE(PTHM,1)) :: ZBETA1 REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process REAL :: ZTMAX,ZRMAX, ZEPS ! control value REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear +REAL(KIND=JPRB) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE) ! Thresholds for the perturbation of ! theta_l and r_t at the first level of the updraft @@ -265,7 +192,6 @@ ZEPS=1.E-15 ! INITIALISATION ! Initialisation of the constants -ZRDORV = XRD / XRV !=0.622 ZRVORD = (XRV / XRD) ! depth are different in compute_updraft (3000. and 4000.) ==> impact is small @@ -273,10 +199,6 @@ ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouche ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed -! Initialisation of ZBETA1 ==> I do not remember why I introduced a KLON array for beta1 ! - -ZBETA1(:) = XBETA1 - ! Local variables, internal domain ! Internal Domain @@ -309,22 +231,27 @@ PTHV_UP(:,:)=0. PBUO_INTEG=0. ZBUO =0. +!no ice cloud coded yet PRI_UP(:,:)=0. PFRAC_ICE_UP(:,:)=0. PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used ! Initialisation of environment variables at t-dt -! variables at flux level -ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:)) -ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:)) -ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:)) -ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:)) -ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:)) +! variables at flux level +ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL) +ZRTM_F (:,:) = MZM_MF(PRTM(:,:), KKA, KKU, KKL) +ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL) +ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL) +ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL) -! This updraft is not yet ready to use scalar variables +! This updraft is not yet ready to use scalar variables !DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE +! *** SR merge AROME/Méso-nh: following two lines come from the AROME version +! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV)) +! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV) +! *** the following single line comes from the Meso-NH version ! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)) !END DO @@ -334,27 +261,32 @@ PRT_UP(:,:)=ZRTM_F(:,:) PU_UP(:,:)=ZUM_F(:,:) PV_UP(:,:)=ZVM_F(:,:) PSV_UP(:,:,:)=0. -! This updraft is not yet ready to use scalar variables +! This updraft is not yet ready to use scalar variables !IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then ! PSV_UP(:,:,:)=ZSVM_F(:,:,:) !ENDIF ! Computation or initialisation of updraft characteristics at the KKB level -! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF) +! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF) -!PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) -!PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT)) -PTHL_UP(:,KKB)= ZTHLM_F(:,KKB) -PRT_UP(:,KKB) = ZRTM_F(:,KKB) +DO JI=1,IIJU + !PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) + !PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) + PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB) + PRT_UP(JI,KKB) = ZRTM_F(JI,KKB) +ENDDO -ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:)) -ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:)) -ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:)) -ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:)) +ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL) +ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL) +ZRHO_F (:,:) = MZM_MF(PRHODREF(:,:), KKA, KKU, KKL) +ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL) ! thetav at mass and flux levels -ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:))) -ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:))) +DO JK=1,IKU + DO JI=1,IIJU + ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK))) + ENDDO +ENDDO PTHV_UP(:,:)= ZTHVM_F(:,:) PRV_UP (:,:)= ZRVM_F (:,:) @@ -371,12 +303,14 @@ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), & PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), & PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:)) -! compute updraft thevav and buoyancy term at KKB level -PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB))) -! compute mean rsat in updraft -PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB) +DO JI=1,IIJU + ! compute updraft thevav and buoyancy term at KKB level + PTHV_UP(JI,KKB) = ZTH_UP(JI,KKB)*((1+ZRVORD*PRV_UP(JI,KKB))/(1+PRT_UP(JI,KKB))) + ! compute mean rsat in updraft + PRSAT_UP(JI,KKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,KKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,KKB) +ENDDO -!Tout est commente pour tester dans un premier temps la séparation en deux de la +!Tout est commente pour tester dans un premier temps la separation en deux de la ! boucle verticale, une pour w et une pour PEMF ZG_O_THVREF=XG/ZTHVM_F @@ -384,8 +318,9 @@ ZG_O_THVREF=XG/ZTHVM_F ! Calcul de la fermeture de Julien Pergaut comme limite max de PHY DO JK=KKB,KKE-KKL,KKL ! Vertical loop - ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level - ZZZ(:,JK) = 0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ! <== Hight of mass levels + DO JI=1,IIJU + ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level + ENDDO ENDDO ! compute L_up @@ -393,8 +328,8 @@ GLMIX=.TRUE. ZTKEM_F(:,KKB)=0. ! IF(CTURBLEN=='RM17') THEN - ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ)) - ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ)) + ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL) + ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL) ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ) ELSE ZSHEAR = 0. !no shear in bl89 mixing length @@ -404,20 +339,23 @@ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) ZLUP(:)=MAX(ZLUP(:),1.E-10) -! Compute Buoyancy flux at the ground -ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ & - (0.61*ZTHM_F(:,KKB))*PSFRV(:) - -! Mass flux at KKB level (updraft triggered if PSFTH>0.) -WHERE (ZWTHVSURF(:)>0.010) ! <== Not 0 Important to have stratocumulus !!!!! - PEMF(:,KKB) = XCMF * ZRHO_F(:,KKB) * ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.) - PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX) - ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2 - GTEST(:)=.TRUE. -ELSEWHERE - PEMF(:,KKB) =0. - GTEST(:)=.FALSE. -ENDWHERE +DO JI=1,IIJU + ! Compute Buoyancy flux at the ground + ZWTHVSURF = (ZTHVM_F(JI,KKB)/ZTHM_F(JI,KKB))*PSFTH(JI)+ & + (0.61*ZTHM_F(JI,KKB))*PSFRV(JI) + + ! Mass flux at KKB level (updraft triggered if PSFTH>0.) + IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!! + PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF*ZLUP(JI))**(1./3.) + PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX) + + ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2 + GTEST(JI)=.TRUE. + ELSE + PEMF(JI,KKB) =0. + GTEST(JI)=.FALSE. + ENDIF +ENDDO !-------------------------------------------------------------------------- @@ -429,21 +367,19 @@ ENDWHERE ! ! GTESTLCL(:)=.FALSE. -GTESTETL(:)=.FALSE. ! Loop on vertical level to compute W ZW_MAX(:) = 0. ZZTOP(:) = 0. -ZPHI(:) = 0. DO JK=KKB,KKE-KKL,KKL ! IF the updraft top is reached for all column, stop the loop on levels - ITEST=COUNT(GTEST) -! IF (ITEST==0) CYCLE ! <== I do not remember why I removed this ... + !ITEST=COUNT(GTEST) + !IF (ITEST==0) CYCLE ! <== I do not remember why I removed this ... ! Computation of entrainment and detrainment with KF90 ! parameterization in clouds and LR01 in subcloud layer @@ -451,10 +387,12 @@ DO JK=KKB,KKE-KKL,KKL ! to find the LCL (check if JK is LCL or not) - WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL))) - KKLCL(:) = JK - GTESTLCL(:)=.TRUE. - ENDWHERE + DO JI=1,IIJU + IF ((PRC_UP(JI,JK)+PRI_UP(JI,JK)>0.).AND.(.NOT.(GTESTLCL(JI)))) THEN + KKLCL(JI) = JK + GTESTLCL(JI)=.TRUE. + ENDIF + ENDDO ! COMPUTE PENTR and PDETR at mass level JK @@ -471,67 +409,84 @@ DO JK=KKB,KKE-KKL,KKL PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),& ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:)) - WHERE (GTEST) - PTHV_UP (:,JK) = ZTH_UP(:,JK)*(1.+ZRVORD*ZRV_UP(:))/(1.+PRT_UP(:,JK)) - ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK)) - PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK)) + DO JI=1,IIJU + IF (GTEST(JI)) THEN + PTHV_UP (JI,JK) = ZTH_UP(JI,JK)*(1.+ZRVORD*ZRV_UP(JI))/(1.+PRT_UP(JI,JK)) + ZBUO (JI,JK) = ZG_O_THVREF(JI,JK)*(PTHV_UP(JI,JK) - ZTHVM_F(JI,JK)) + PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+KKL)-PZZ(JI,JK)) - ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) - ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK) - - ZCOE(:) = ZDZ(:) - WHERE (ZTEST(:)>0.) - ZCOE(:) = ZDZ(:)/(1.+ ZBETA1(:)) - ENDWHERE - -! Convective Vertical speed computation - - ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:)) - ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:)) - -! Second Rachel bug correction (XA1 has been forgotten ... not yet tested ...) -! ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + ZBUO(:,JK)*ZBUCOE(:) ) - ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) ) - ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL))) - ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK))) + ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) + ZTEST(JI) = XA1*ZBUO(JI,JK) - XB*ZW_UP2(JI,JK) + + ! Ancien calcul de la vitesse + ZCOE(JI) = ZDZ(JI) + IF (ZTEST(JI)>0.) THEN + ZCOE(JI) = ZDZ(JI)/(1.+ XBETA1) + ENDIF + + ! Convective Vertical speed computation + ZWCOE(JI) = (1.-XB*ZCOE(JI))/(1.+XB*ZCOE(JI)) + ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+XB*ZCOE(JI)) + + ! Second Rachel bug correction (XA1 has been forgotten ... not yet tested ...) + !ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + ZBUO(JI,JK)*ZBUCOE(JI) ) + ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + XA1*ZBUO(JI,JK)*ZBUCOE(JI) ) + ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+KKL))) + ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+KKL)+ZW_UP2(JI,JK))) -! Entrainement and detrainement + ! Entrainement and detrainement -! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small) - PENTR(:,JK) = MAX(0.,(ZBETA1(:)/(1.+ZBETA1(:)))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB)) - ZDETR_BUO(:) = MAX(0., -(ZBETA1(:)/(1.+ZBETA1(:)))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:)) - ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:)) - PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:) + ! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small) + PENTR(JI,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-XB)) + ZDETR_BUO(JI) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)) + ZDETR_RT(JI) = XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI)) + PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI) -! If the updraft did not stop, compute cons updraft characteritics at jk+1 - - ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL)) - ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !& - ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !& + ! If the updraft did not stop, compute cons updraft characteritics at jk+1 + ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL)) + ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !& - PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) & - /(1.+0.5*ZMIX2(:)) - ENDWHERE ! GTEST + PTHL_UP(JI,JK+KKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) & + /(1.+0.5*ZMIX2(JI)) + PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & + /(1.+0.5*ZMIX2(JI)) + ENDIF ! GTEST + ENDDO IF(OMIXUV) THEN - WHERE(GTEST) - PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+& - (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ & - 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*& - ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+& - (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) & - /(1+0.5*ZMIX2(:)) - ENDWHERE + IF(JK/=KKB) THEN + DO JI=1,IIJU + IF(GTEST(JI)) THEN + PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)+& + (PUM(JI,JK)-PUM(JI,JK-KKL))/PDZZ(JI,JK)) ) & + /(1+0.5*ZMIX2(JI)) + PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)+& + (PVM(JI,JK)-PVM(JI,JK-KKL))/PDZZ(JI,JK)) ) & + /(1+0.5*ZMIX2(JI)) + ENDIF + ENDDO + ELSE + DO JI=1,IIJU + IF(GTEST(JI)) THEN + PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)) ) & + /(1+0.5*ZMIX2(JI)) + PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)) ) & + /(1+0.5*ZMIX2(JI)) + ENDIF + ENDDO + ENDIF ENDIF -! This updraft is not yet ready to use scalar variables +! This updraft is not yet ready to use scalar variables ! DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE ! WHERE(GTEST) @@ -548,53 +503,58 @@ DO JK=KKB,KKE-KKL,KKL CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), & PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), & ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:)) - WHERE(GTEST) - PRC_UP(:,JK+KKL)=ZRC_UP(:) - PRV_UP(:,JK+KKL)=ZRV_UP(:) - PRI_UP(:,JK+KKL)=ZRI_UP(:) - PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL) - ENDWHERE - - -! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 - WHERE(GTEST) - PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL))) - ENDWHERE - - WHERE(GTEST) - ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK)) - PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:)) -! Updraft fraction must be smaller than XFRAC_UP_MAX - PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)) - PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL)) - ENDWHERE + DO JI=1,IIJU + IF(GTEST(JI)) THEN + PRC_UP(JI,JK+KKL)=ZRC_UP(JI) + PRV_UP(JI,JK+KKL)=ZRV_UP(JI) + PRI_UP(JI,JK+KKL)=ZRI_UP(JI) + PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL) + + ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 + PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*((1+ZRVORD*PRV_UP(JI,JK+KKL))/(1+PRT_UP(JI,JK+KKL))) + ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK)) + ENDIF + ENDDO + + DO JI=1,IIJU + IF(GTEST(JI)) THEN + PEMF(JI,JK+KKL)=PEMF(JI,JK)*EXP(ZMIX1(JI)) + ENDIF + ENDDO + + DO JI=1,IIJU + IF(GTEST(JI)) THEN + ! Updraft fraction must be smaller than XFRAC_UP_MAX + PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX, & + &PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL))) + ENDIF + ENDDO ! Test if the updraft has reach the ETL - GTESTETL(:)=.FALSE. - WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.)) - KKETL(:) = JK+KKL - GTESTETL(:)=.TRUE. - ENDWHERE + DO JI=1,IIJU + IF (GTEST(JI) .AND. (PBUO_INTEG(JI,JK)<=0.)) THEN + KKETL(JI) = JK+KKL + ENDIF + ENDDO ! Test is we have reached the top of the updraft - - WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS).OR.(PEMF(:,JK+KKL)<=ZEPS))) - ZW_UP2 (:,JK+KKL)=ZEPS - PEMF (:,JK+KKL)=0. - GTEST (:) =.FALSE. - PTHL_UP (:,JK+KKL)=ZTHLM_F(:,JK+KKL) - PRT_UP (:,JK+KKL)=ZRTM_F(:,JK+KKL) - PRC_UP (:,JK+KKL)=0. - PRI_UP (:,JK+KKL)=0. - PRV_UP (:,JK+KKL)=ZRVM_F (:,JK+KKL) - PTHV_UP (:,JK+KKL)=ZTHVM_F(:,JK+KKL) - PFRAC_UP (:,JK+KKL)=0. - KKCTL (:) =JK+KKL - - ENDWHERE - + DO JI=1,IIJU + IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+KKL)<=ZEPS).OR.(PEMF(JI,JK+KKL)<=ZEPS))) THEN + ZW_UP2 (JI,JK+KKL)=ZEPS + PEMF (JI,JK+KKL)=0. + GTEST (JI) =.FALSE. + PTHL_UP (JI,JK+KKL)=ZTHLM_F(JI,JK+KKL) + PRT_UP (JI,JK+KKL)=ZRTM_F(JI,JK+KKL) + PRC_UP (JI,JK+KKL)=0. + PRI_UP (JI,JK+KKL)=0. + PRV_UP (JI,JK+KKL)=ZRVM_F (JI,JK+KKL) + PTHV_UP (JI,JK+KKL)=ZTHVM_F(JI,JK+KKL) + PFRAC_UP (JI,JK+KKL)=0. + KKCTL (JI) =JK+KKL + ENDIF + ENDDO ENDDO ! Fin de la boucle verticale @@ -607,19 +567,24 @@ PEMF(:,KKB) =0. ! This way, all MF fluxes are diminished by this amount. ! Diagnosed cloud fraction is also multiplied by the same coefficient. ! -DO JI=1,SIZE(PTHM,1) +DO JI=1,IIJU PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) -END DO +ENDDO GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) ) GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU ) ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU) -ZCOEF=MIN(MAX(ZCOEF,0.),1.) -WHERE (GWORK2) - PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:) - PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:) -ENDWHERE - -END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10 +ZCOEF(:,:)=MIN(MAX(ZCOEF(:,:),0.),1.) +DO JK=1, IKU + DO JI=1,IIJU + IF (GWORK2(JI,JK)) THEN + PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK) + PFRAC_UP(JI,JK) = PFRAC_UP(JI,JK) * ZCOEF(JI,JK) + ENDIF + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',1,ZHOOK_HANDLE) +END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10 +END MODULE MODE_COMPUTE_UPDRAFT_RHCJ10 diff --git a/src/mesonh/turb/shallow_mf.f90 b/src/mesonh/turb/shallow_mf.f90 index 5e6713851534228a4f6413aec2bb5b3912ede4b8..91a8a93972bcfcefa02c5455bd81a7fe901d4b27 100644 --- a/src/mesonh/turb/shallow_mf.f90 +++ b/src/mesonh/turb/shallow_mf.f90 @@ -3,110 +3,6 @@ !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- -! ######spl - MODULE MODI_SHALLOW_MF -! ###################### -! -INTERFACE -! ################################################################# - SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, & - HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL_MF, PTSTEP, & - PDZZ, PZZ, & - PRHODJ, PRHODREF, & - PPABSM, PEXNM, & - PSFTH,PSFRV, & - PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, & - PDUDT_MF,PDVDT_MF, & - PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, & - PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, & - PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & - PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & - PU_UP, PV_UP, PTHV_UP, PW_UP, & - PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, & - PFRAC_UP,PEMF,PDETR,PENTR, & - KKLCL,KKETL,KKCTL ) -! ################################################################# -!! -! -!* 1.1 Declaration of Arguments -! -! -INTEGER, INTENT(IN) :: KKA ! near ground array index -INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index -INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise -INTEGER, INTENT(IN) :: KRR ! number of moist var. -INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. -INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme - ! 'NONE' if no parameterization -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud - ! scheme -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme -LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum -LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer -INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer -INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer -REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness -REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep - -REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point -REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size -REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the - ! reference state -REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1 -REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt - -REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv -REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt - -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt - -REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme -REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme -REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme -REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme -REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme - -REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF -REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics - -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics - -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction -REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux -REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment -REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment -INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL - - -END SUBROUTINE SHALLOW_MF - -END INTERFACE -! -END MODULE MODI_SHALLOW_MF ! ################################################################ SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, & HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, & @@ -116,16 +12,15 @@ END MODULE MODI_SHALLOW_MF PRHODJ, PRHODREF, & PPABSM, PEXNM, & PSFTH,PSFRV, & - PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, & + PTHM,PRM,PUM,PVM,PTKEM,PSVM, & PDUDT_MF,PDVDT_MF, & PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, & PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, & PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & PU_UP, PV_UP, PTHV_UP, PW_UP, & - PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, & PFRAC_UP,PEMF,PDETR,PENTR, & - KKLCL,KKETL,KKCTL ) + KKLCL,KKETL,KKCTL,PDX,PDY ) ! ################################################################# !! @@ -165,6 +60,7 @@ END MODULE MODI_SHALLOW_MF !! R.Honnert 07/2012 : MF gray zone !! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF !! R.Honnert 10/2016 : Update with Arome +!! S. Riette Nov 2016: HFRAC_ICE support !! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.) !! Q.Rodier 01/2019 : support RM17 mixing length !! R.Honnert 1/2019 : remove SURF @@ -178,22 +74,18 @@ END MODULE MODI_SHALLOW_MF USE MODD_CST USE MODD_PARAMETERS, ONLY: JPVEXT USE MODD_PARAM_MFSHALL_n -USE MODD_TURB_n, ONLY: CTURBLEN USE MODI_THL_RT_FROM_TH_R_MF -USE MODI_COMPUTE_UPDRAFT -USE MODI_COMPUTE_UPDRAFT_RHCJ10 -USE MODI_COMPUTE_UPDRAFT_RAHA -USE MODI_MF_TURB -USE MODI_MF_TURB_EXPL -USE MODI_MF_TURB_GREYZONE -USE MODI_COMPUTE_MF_CLOUD -USE MODI_SHUMAN_MF -! -USE MODI_COMPUTE_BL89_ML -USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT -USE MODD_REF_n, ONLY : XTHVREF -USE MODE_MSG +USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT +USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10 +USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA +USE MODE_MF_TURB, ONLY: MF_TURB +USE MODE_MF_TURB_EXPL, ONLY: MF_TURB_EXPL +USE MODE_COMPUTE_MF_CLOUD, ONLY: COMPUTE_MF_CLOUD +USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE +USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL +USE PARKIND1, ONLY : JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK ! IMPLICIT NONE @@ -207,11 +99,11 @@ INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from grou INTEGER, INTENT(IN) :: KRR ! number of moist var. INTEGER, INTENT(IN) :: KRRL ! number of liquid water var. INTEGER, INTENT(IN) :: KRRI ! number of ice water var. -CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme +CHARACTER(LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme ! 'NONE' if no parameterization -CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud +CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud ! scheme -CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme +CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer @@ -230,7 +122,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt -REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt +REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt @@ -252,13 +144,6 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics - -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics -REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics - REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics @@ -268,6 +153,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL +REAL, INTENT(IN) :: PDX, PDY ! ! 0.2 Declaration of local variables ! @@ -281,27 +167,21 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: & ZSV_UP,& ! updraft scalar var. - ZSV_DO,& ! updraft scalar var. ZFLXZSVMF ! Flux REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness of cloud REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRSAT_UP ! Rsat in updraft -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ !vertical wind shear LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux INTEGER :: IKB ! near ground physical index INTEGER :: IKE ! uppest atmosphere physical index -! pour bouttle et al. -REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF,PTHVREF -REAL, DIMENSION(SIZE(PTHM,1)) :: ZRESOL_NORM, ZRESOL_GRID,& ! normalized grid - ZLUP, ZPLAW -! Test if the ascent continue, if LCL or ETL is reached -LOGICAL :: GLMIX -INTEGER :: JI,JJ,JK ! loop counter INTEGER, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: IERR +! +REAL(KIND=JPRB) :: ZHOOK_HANDLE !------------------------------------------------------------------------ !!! 1. Initialisation +IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE) ! vertical boundaries IKB=KKA+KKL*JPVEXT @@ -347,8 +227,9 @@ IF (HMF_UPDRAFT == 'EDKF') THEN PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, & PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, & PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,& - PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH ) -ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN + PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH,& + PDX,PDY) +ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN GENTR_DETR = .TRUE. CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,& ONOMIXLG,KSV_LGBEG,KSV_LGEND, & @@ -378,7 +259,7 @@ ELSEIF (HMF_UPDRAFT == 'RAHA') THEN ELSEIF (HMF_UPDRAFT == 'DUAL') THEN !Updraft characteristics are already computed and received by interface ELSE - call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) ) + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//TRIM(HMF_UPDRAFT) ) ENDIF !!! 5. Compute diagnostic convective cloud fraction and content @@ -400,30 +281,27 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,& !!! ------------------------------------------------------------------------ ! ZEMF_O_RHODREF=PEMF/PRHODREF -IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN - IF ( PIMPL_MF > 1.E-10 ) THEN - CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, & - ONOMIXLG,KSV_LGBEG,KSV_LGEND, & - PIMPL_MF, PTSTEP, & - PDZZ, & - PRHODJ, & - ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, & - PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, & - ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,& - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & - ZFLXZSVMF ) - ELSE - CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, & - PRHODJ, & - ZTHLM,ZTHVM,ZRTM,PUM,PVM, & - PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, & - ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & - PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) - ENDIF + +IF ( PIMPL_MF > 1.E-10 ) THEN + CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, & + ONOMIXLG,KSV_LGBEG,KSV_LGEND, & + PIMPL_MF, PTSTEP, & + PDZZ, & + PRHODJ, & + ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, & + PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, & + ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,& + PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, & + ZFLXZSVMF ) ELSE - call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) ) -END IF - + CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, & + PRHODJ, & + ZTHLM,ZTHVM,ZRTM,PUM,PVM, & + PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, & + ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, & + PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF) +ENDIF + ! security in the case HMF_UPDRAFT = 'DUAL' ! to be modified if 'DUAL' is evolving (momentum mixing for example) IF( HMF_UPDRAFT == 'DUAL') THEN @@ -434,6 +312,7 @@ IF( HMF_UPDRAFT == 'DUAL') THEN ! PDVDT_MF=0. ENDIF ! +IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',1,ZHOOK_HANDLE) CONTAINS INCLUDE "compute_frac_ice.func.h" !