sso_be04_frictionn.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 sso_be04_friction_n (SB, USS, PTSTEP,PSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
!     ###############################################################################
!
!!****  *SSO_BE04_FRICTION_n * - Computes subgrid-scale orography friction
!                                  according to several options:
!                                CROUGH='Z01D' : orographic roughness length
!                                CROUGH='Z04D' : orographic roughness length
!                                                variable with wind direction
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    05/2010
!----------------------------------------------------------------
!
!
!
USE modd_canopy_n, ONLY : canopy_t
USE modd_sso_n, ONLY : sso_t
!
USE modd_surf_par,       ONLY : xundef
USE modd_canopy_turb,    ONLY : xalpsbl
USE modd_csts,           ONLY : xkarman
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_canopy_evol
USE modi_canopy_grid_update
USE modi_sso_beljaars04
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(canopy_t), INTENT(INOUT) :: SB
TYPE(sso_t), INTENT(INOUT) :: USS
!
REAL,               INTENT(IN)    :: PTSTEP    ! time step
REAL, DIMENSION(:), INTENT(IN)    :: PSEA      ! Sea fraction                          (-)
REAL, DIMENSION(:), INTENT(IN)    :: PUREF     ! Wind forcing height                   (m)
REAL, DIMENSION(:), INTENT(IN)    :: PRHOA     ! air density                           (kg/m3)
REAL, DIMENSION(:), INTENT(IN)    :: PU        ! zonal wind                            (m/s)
REAL, DIMENSION(:), INTENT(IN)    :: PV        ! meridian wind                         (m/s)
REAL, DIMENSION(:), INTENT(INOUT) :: PSFU      ! zonal momentum flux                   (Pa)
REAL, DIMENSION(:), INTENT(INOUT) :: PSFV      ! meridian momentum flux                (Pa)
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PU))    :: ZWIND   ! wind strength (m/s)
REAL, DIMENSION(SIZE(PU))    :: ZSSO_STDEV! SSO standard deviation (m)
REAL, DIMENSION(SIZE(PU))    :: ZUSTAR  ! friction velocity
!
!* canopy variables
!
REAL, DIMENSION(SIZE(PU))     :: ZTA      ! temperature                                   (K)
REAL, DIMENSION(SIZE(PU))     :: ZQA      ! specific humidity                             (kg/m3)
REAL, DIMENSION(SIZE(PU))     :: ZPA      ! pressure                                      (Pa)
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZLM
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZLEPS
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZP
REAL, DIMENSION(SIZE(PU))     :: ZSFLUX_T
REAL, DIMENSION(SIZE(PU))     :: ZSFLUX_Q
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZFORC_T
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZDFORC_TDT
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZFORC_Q
REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZDFORC_QDQ
REAL, DIMENSION(SIZE(PU)) :: ZALFATH
REAL, DIMENSION(SIZE(PU)) :: ZBETATH
REAL, DIMENSION(SIZE(PU)) :: ZALFAQ
REAL, DIMENSION(SIZE(PU)) :: ZBETAQ
!
REAL,    DIMENSION(SIZE(PU), SB%NLVL) :: ZFORC_U      ! tendency due to drag force for wind
REAL,    DIMENSION(SIZE(PU), SB%NLVL) :: ZDFORC_UDU   ! formal derivative of
!                                                  ! tendency due to drag force for wind
REAL,    DIMENSION(SIZE(PU), SB%NLVL) :: ZFORC_E      ! tendency due to drag force for TKE
REAL,    DIMENSION(SIZE(PU), SB%NLVL) :: ZDFORC_EDE   ! formal derivative of
!                                                  ! tendency due to drag force for TKE
INTEGER                            :: INI          ! number of points
INTEGER                            :: JI           ! number of points loop counter
INTEGER                            :: JLAYER       ! vertical loop counter
REAL,    DIMENSION(SIZE(PU))       :: ZH        ! Canopy height     (m)
REAL,    DIMENSION(SIZE(PU))       :: ZSFLUX_U  ! Surface flux u'w' (m2/s2)
REAL,    DIMENSION(SIZE(PU))       :: ZALFAU   ! V+(1) = alfa u'w'(1) + beta ! not used
REAL,    DIMENSION(SIZE(PU))       :: ZBETAU   ! V+(1) = alfa u'w'(1) + beta ! not used
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
!
!*      1.     Initializations
!              ---------------
!
!*      1.1    Grid definition
!              ---------------
IF (lhook) CALL dr_hook('SSO_BE04_FRICTION_N',0,zhook_handle)
ini = SIZE(pu)
!
zh = 0.
 CALL canopy_grid_update(ini,zh,puref,sb)
!
!*      1.2    Wind
!              ----
!
zwind    = sqrt(pu**2+pv**2)
!
zsflux_u = - sqrt(psfu**2+psfv**2)
!
!
!*      1.3    Canopy profiles at first time step (neutral case)
!              ----------------------------------
!
IF (any(sb%XU(:,sb%NLVL)==xundef)) THEN
  DO jlayer=1,sb%NLVL
     DO ji=1,ini
        sb%XU  (ji,jlayer) = max( zwind(ji) + sqrt(-zsflux_u(ji)) / xkarman      &
                                  * log(sb%XZ(ji,jlayer)/sb%XZ(ji,sb%NLVL))   , 0.)
        sb%XTKE(ji,jlayer) = - xalpsbl * zsflux_u(ji)
     ENDDO
  ENDDO
ENDIF
!
!
!-------------------------------------------------------------------------------------
!
!*      2.    Subgrid-scale orographic drag (Beljaars et al 2004)
!             -----------------------------
!
zsso_stdev = uss%XSSO_STDEV
WHERE (zsso_stdev==xundef) zsso_stdev=0.
!
zforc_u(:,:)= 0.
zdforc_udu(:,:)= 0.
zforc_e(:,:) = 0.
zdforc_ede(:,:) = 0.
!
!* computes tendencies on wind and Tke due to subgridscale orography
 CALL sso_beljaars04(uss, sb, ini, zsso_stdev, zforc_u, zdforc_udu )
!
DO jlayer=1,sb%NLVL
   DO ji=1,ini
      zforc_u(ji,sb%NLVL) = zforc_u(ji,sb%NLVL) * (1.0-psea(ji))
      zdforc_udu(ji,sb%NLVL) = zdforc_udu(ji,sb%NLVL) * (1.0-psea(ji))
   ENDDO
ENDDO
!
!-------------------------------------------------------------------------------------
!
!*      3.    Computes coefficients for implicitation
!             ---------------------------------------
!
zta(:) = xundef
zqa(:) = xundef
zpa(:) = xundef
zsflux_t(:) = xundef
zsflux_q(:) = xundef
zp(:,:) = xundef
zforc_t(:,:) = xundef
zdforc_tdt(:,:) = xundef 
zforc_q(:,:) = xundef
zdforc_qdq(:,:) = xundef
!
 CALL canopy_evol(sb, ini, ptstep, 2, sb%XZ, zwind, zta, zqa, zpa, prhoa, &
                  zsflux_u, zsflux_t, zsflux_q, zforc_u, zdforc_udu, &
                  zforc_e, zdforc_ede, zforc_t, zdforc_tdt, &
                  zforc_q, zdforc_qdq, zlm, zleps, zustar,  &
                  zalfau, zbetau, zalfath, zbetath, zalfaq, zbetaq, &
                  oneutral=.true.                 )
!
!-------------------------------------------------------------------------------------
!
!
! Momentum fluxes if canopy is used
!
WHERE (zwind>0.)
  psfu(:) = - pu(:)/zwind(:) * zustar(:)**2 * prhoa(:)
  psfv(:) = - pv(:)/zwind(:) * zustar(:)**2 * prhoa(:)
END WHERE
!
IF (lhook) CALL dr_hook('SSO_BE04_FRICTION_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE sso_be04_friction_n