Skip to content
Snippets Groups Projects
compute_mf_cloud_stat.F90 4.86 KiB
Newer Older
  • Learn to ignore specific revisions
  • !     ######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_CMFSHALL, ONLY :  XTAUSIGMF
    USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
    !
    
    USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
    
    USE MODE_COMPUTE_FUNCTION_THERMO_MF, ONLY: COMPUTE_FUNCTION_THERMO_MF
    
    !
    USE PARKIND1, ONLY : JPRB
    USE YOMHOOK , ONLY : LHOOK, DR_HOOK
    !
    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
    REAL(KIND=JPRB) :: ZHOOK_HANDLE
    !
    !*                    0.2 initialisation
    !
    IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',0,ZHOOK_HANDLE)
    !
    !----------------------------------------------------------------------------
    !
    !*      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(PTHLM(:,:), KKA, KKU, KKL)) * &
                          GZ_M_W_MF(PTHLM(:,:),PDZZ(:,:), KKA, KKU, KKL)
    
    !
    !   Avoid negative values
        ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
    
    
    
        PSIGMF(:,:) = MZF_MF(ZFLXZ(:,:), KKA, KKU, KKL) * ZATHETA(:,:)**2
    
        ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(PRTM(:,:), KKA, KKU, KKL)) * &
                          GZ_M_W_MF(PRTM(:,:),PDZZ(:,:), KKA, KKU, KKL)
    
    !
    !   Avoid negative values
        ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
    !
    
    
        PSIGMF(:,:) = PSIGMF(:,:) + ZAMOIST(:,:) **2 * MZF_MF(ZFLXZ(:,:), KKA, KKU, KKL)
    
    !
    !        1.3  Vertical part of Sigma_s
    !
      PSIGMF(:,:) =  SQRT( MAX (PSIGMF(:,:) , 0.) )
    ELSE
      PSIGMF(:,:) = 0.
    END IF
    !
    IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',1,ZHOOK_HANDLE)
    !
    END SUBROUTINE COMPUTE_MF_CLOUD_STAT