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 (SSCP, 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_sso_canopy_n, ONLY : sso_canopy_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_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(sso_canopy_t), INTENT(INOUT) :: sscp
TYPE(surf_atm_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),SSCP%NLVL) :: zt
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zq
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zlmo
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zlm
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zleps
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zp
REAL, DIMENSION(SIZE(PU))     :: zsflux_t
REAL, DIMENSION(SIZE(PU))     :: zsflux_q
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zforc_t
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zdforc_tdt
REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: zforc_q
REAL, DIMENSION(SIZE(PU),SSCP%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), SSCP%NLVL) :: zforc_u      ! tendency due to drag force for wind
REAL,    DIMENSION(SIZE(PU), SSCP%NLVL) :: zdforc_udu   ! formal derivative of
!                                                  ! tendency due to drag force for wind
REAL,    DIMENSION(SIZE(PU), SSCP%NLVL) :: zforc_e      ! tendency due to drag force for TKE
REAL,    DIMENSION(SIZE(PU), SSCP%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,sscp%NLVL,zh,puref,sscp%XZ,sscp%XZF,sscp%XDZ,sscp%XDZF)
!
!*      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(sscp%XU(:,sscp%NLVL)==xundef)) THEN
  DO jlayer=1,sscp%NLVL
     DO ji=1,ini
        sscp%XU  (ji,jlayer) = max( zwind(ji) + sqrt(-zsflux_u(ji)) / xkarman      &
                                  * log(sscp%XZ(ji,jlayer)/sscp%XZ(ji,sscp%NLVL))   , 0.)
        sscp%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, &
                     ini,sscp%NLVL,sscp%XZ,zsso_stdev,sscp%XU,zforc_u,zdforc_udu )
!
DO jlayer=1,sscp%NLVL
   DO ji=1,ini
      zforc_u(ji,sscp%NLVL) = zforc_u(ji,sscp%NLVL) * (1.0-psea(ji))
      zdforc_udu(ji,sscp%NLVL) = zdforc_udu(ji,sscp%NLVL) * (1.0-psea(ji))
   ENDDO
ENDDO
!
!-------------------------------------------------------------------------------------
!
!*      3.    Computes coefficients for implicitation
!             ---------------------------------------
!
zta(:) = xundef
zqa(:) = xundef
zpa(:) = xundef
zsflux_t(:) = xundef
zsflux_q(:) = xundef
zt(:,:) = xundef
zq(:,:) = xundef
zlmo(:,:) = xundef
zp(:,:) = xundef
zforc_t(:,:) = xundef
zdforc_tdt(:,:) = xundef 
zforc_q(:,:) = xundef
zdforc_qdq(:,:) = xundef
!
 CALL canopy_evol(ini, sscp%NLVL, ptstep, 2, sscp%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,                &
                 sscp%XZ, sscp%XZF, sscp%XDZ, sscp%XDZF, sscp%XU, sscp%XTKE, zt, zq, zlmo, zlm,         &
                 zleps, zp, 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