Newer
Older
!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(D, CST, CSTURB, PARAMMF, OSTATNW, &

RODIER Quentin
committed
KRR, KRRL, KRRI, &
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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
! ------------
!

RIETTE Sébastien
committed
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t

RIETTE Sébastien
committed
USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
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
IMPLICIT NONE
!* 1.1 Declaration of Arguments
!
!
!

RIETTE Sébastien
committed
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(CSTURB_t), INTENT(IN) :: CSTURB

RIETTE Sébastien
committed
TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
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.
LOGICAL, INTENT(IN) :: OSTATNW ! cloud scheme inclues convect. covar. contrib
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHV_UP ! updraft thetaV
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PZZ
INTEGER, DIMENSION(D%NIJT), INTENT(IN) :: KKLCL ! index of updraft condensation level
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM, PRHODREF ! environement
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDEPTH ! Deepness of cloud
!
! 1.2 Declaration of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
! 1. INITIALISATION
!
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',0,ZHOOK_HANDLE)
!
! 2.1 Internal domain
PRC_MF = 0.
PRI_MF = 0.
PCF_MF = 0.
PSIGMF = 0.

RODIER Quentin
committed
IF (PARAMMF%CMF_CLOUD == 'DIRE') THEN
!Direct cloud scheme

RIETTE Sébastien
committed
CALL COMPUTE_MF_CLOUD_DIRECT(D, PARAMMF, &
&KKLCL(:), PFRAC_UP(:,:), PRC_UP(:,:), PRI_UP(:,:),&
&PRC_MF(:,:), PRI_MF(:,:), PCF_MF(:,:))
!

RODIER Quentin
committed
ELSEIF (PARAMMF%CMF_CLOUD == 'STAT') THEN
!Statistical scheme using the PDF proposed by Bougeault (81, 82) and
!Bechtold et al (95).
CALL COMPUTE_MF_CLOUD_STAT(D, CST, CSTURB, PARAMMF, &
&KRR, KRRL, KRRI, OSTATNW, &
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
&PDZZ, PTHM, PEXNM,&
&PEMF, PTHL_UP, PRT_UP,&
&PSIGMF)

RODIER Quentin
committed
ELSEIF (PARAMMF%CMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.

RIETTE Sébastien
committed
CALL COMPUTE_MF_CLOUD_BIGAUS(D, CST, PARAMMF,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
&PDZZ, PZZ, PRHODREF,&
&PRC_MF, PRI_MF, PCF_MF)
!

RODIER Quentin
committed
ELSEIF (PARAMMF%CMF_CLOUD == 'NONE') THEN
! No CONVECTIVE CLOUD SCHEME
! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero
ELSE

RODIER Quentin
committed
CALL PRINT_MSG(NVERB_FATAL, &
'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: PARAMMF%CMF_CLOUD='//TRIM(PARAMMF%CMF_CLOUD))
ENDIF
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_MF_CLOUD
END MODULE MODE_COMPUTE_MF_CLOUD