rmc01_surf.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE rmc01_surf(PZ, PLMO, PLK, PLEPS, ONEUTRAL)
!     ##############################################################
!
!!****  *RMC01_SURF* -
!!
!!    PURPOSE
!!    -------
!!    This routine modifies the mixing and dissipative length near the SBL.
!!    (Redelsperger, Mahe and Carlotti, 2001)
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      Book 2
!!
!!    AUTHOR
!!    ------
!!
!!      V. Masson  - Meteo-France -
!!
!!    MODIFICATIONS
!!    -------------
!!     Original     07/2006
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surf_par,    ONLY : xundef
USE modd_csts,        ONLY : xkarman
USE modd_canopy_turb, ONLY : xalpsbl, xcmfs, xced
!
USE mode_sbls
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declaration of arguments
!              ------------------------
!
REAL, DIMENSION(:,:),   INTENT(IN)  :: pz   ! altitude of full levels
REAL, DIMENSION(:,:),   INTENT(IN)  :: plmo ! Monin Obuhkov length
REAL, DIMENSION(:,:),   INTENT(OUT) :: plk  ! Mixing length
REAL, DIMENSION(:,:),   INTENT(OUT) :: pleps! Dissipative length
LOGICAL, OPTIONAL,      INTENT(IN)  :: oneutral
!
!*       0.2   Declaration of local variables
!              ------------------------------
!
LOGICAL :: gneutral
!
INTEGER :: jk        ! loop counter
!
REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2)) :: zz_o_lmo ! height / LMO
REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2)) :: zphim    ! MO function
                                                   ! for stress
REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2)) :: zphie    ! MO function
                                                   ! for TKE
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
gneutral = .false.
IF (present(oneutral)) gneutral = oneutral
!
!*     1. MO quantities
!         -------------
!
! z/LMO
IF (lhook) CALL dr_hook('RMC01_SURF',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!*     2. Modification of the mixing length
!         ---------------------------------
!
plk(:,:) = xkarman/sqrt(xalpsbl)/xcmfs * pz(:,:)  
!
!-------------------------------------------------------------------------------
!
!*     3. Modification of the dissipative length
!         --------------------------------------
!
pleps(:,:) = xkarman*(xalpsbl**1.5)*xced * pz(:,:)
!
!-------------------------------------------------------------------------------
!
IF (gneutral) THEN
  IF (lhook) CALL dr_hook('RMC01_SURF',1,zhook_handle)
  RETURN
ENDIF
!
!-------------------------------------------------------------------------------
!
WHERE (plmo(:,:)==xundef)
  zz_o_lmo(:,:)=0.
ELSEWHERE
  zz_o_lmo(:,:)=pz(:,:)/plmo(:,:)
END WHERE
zz_o_lmo(:,:) = max(zz_o_lmo(:,:),-10.)
zz_o_lmo(:,:) = min(zz_o_lmo(:,:), 10.)
!
!
! MO function for stress
zphim(:,:) = businger_phim(zz_o_lmo(:,:))
!
! MO function for TKE
zphie(:,:) = businger_phie(zz_o_lmo(:,:))
!
!-------------------------------------------------------------------------------
!
!*     2. Modification of the mixing length
!         ---------------------------------
!
plk(:,:) = plk(:,:) / (zphim(:,:)**2*sqrt(zphie(:,:)))  
!
!-------------------------------------------------------------------------------
!
!*     3. Modification of the dissipative length
!         --------------------------------------
!
pleps(:,:) = pleps(:,:) / (zphim(:,:)**2*sqrt(zphie(:,:))) 
!
WHERE (zz_o_lmo(:,:)<0.)
  pleps(:,:) = pleps(:,:)/(1.-1.9*zz_o_lmo(:,:))
ELSEWHERE
  pleps(:,:) = pleps(:,:)/(1.-0.3*sqrt(zz_o_lmo(:,:)))
ENDWHERE
!
IF (lhook) CALL dr_hook('RMC01_SURF',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE rmc01_surf