prep_ver_teb.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 prep_ver_teb (B, T, TOP)
!     #################################################################################
!
!!****  *PREP_VER_TEB* - change in TEB variables due to altitude change
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!------------------------------------------------------------------
!

!
!
USE modd_bem_n, ONLY : bem_t
USE modd_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
!
USE modd_prep,   ONLY : xzs_ls, xt_clim_grad
USE modd_csts,   ONLY : xrd, xg, xp00
!
USE mode_thermos
USE modi_prep_ver_snow
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!*      0.2    declarations of local variables
!
!
TYPE(bem_t), INTENT(INOUT) :: b
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_options_t), INTENT(INOUT) :: top
!
INTEGER                         :: jl        ! loop counter
REAL, DIMENSION(:), ALLOCATABLE :: zt0       ! estimated temperature at sea level
REAL, DIMENSION(:), ALLOCATABLE :: zp_ls     ! estimated pressure at XZS_LS
REAL, DIMENSION(:), ALLOCATABLE :: zt_ls     ! temperature at XZS_LS
REAL, DIMENSION(:), ALLOCATABLE :: zp        ! estimated pressure at XZS
REAL, DIMENSION(:,:), ALLOCATABLE :: zgrid   ! wall or roof grid
REAL, DIMENSION(:),   ALLOCATABLE :: zd      ! wall or roof total thickness
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
!*      1.1    Water reservoirs
!
!* nothing done
!
!*      1.2    Building temperature
!
!* nothing done
!
!*      1.3    Road deep temperature
!
IF (lhook) CALL dr_hook('PREP_VER_TEB',0,zhook_handle)
t%CUR%XTI_ROAD = t%CUR%XTI_ROAD  + xt_clim_grad  * (top%XZS - xzs_ls)
!
!*      1.4    Road Temperature profile
!
DO jl=1,SIZE(t%CUR%XT_ROAD,2)
  t%CUR%XT_ROAD(:,jl) = t%CUR%XT_ROAD(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls)
END DO
!
!*      1.5    Wall Temperature profile
!
!* wall grid
ALLOCATE(zd(SIZE(t%CUR%XD_WALL,1)))
ALLOCATE(zgrid(SIZE(t%CUR%XD_WALL,1),SIZE(t%CUR%XD_WALL,2)))
zgrid(:,:) = 0.
zd(:)   = 0.
!
DO jl=1,SIZE(t%CUR%XD_WALL,2)
  zgrid(:,jl) = zd(:) + t%CUR%XD_WALL(:,jl)/2.
  zd(:)    = zd(:) + t%CUR%XD_WALL(:,jl)
END DO
!
!* surface temperature shift is given by climatological gradient
!* shift of temperatures within the wall is attenuated
!* shift is zero from internal wall to half of wall
DO jl=1,SIZE(t%CUR%XT_WALL_A,2)
  t%CUR%XT_WALL_A(:,jl) = t%CUR%XT_WALL_A(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls) &
                                     * max(1.-2.*zgrid(:,jl)/zd(:),0.)  
  t%CUR%XT_WALL_B(:,jl) = t%CUR%XT_WALL_B(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls) &
                                     * max(1.-2.*zgrid(:,jl)/zd(:),0.)  
END DO
!
DEALLOCATE(zd)
DEALLOCATE(zgrid)
!
!*      1.6    Roof Temperature profile
!
!* roof grid
ALLOCATE(zd(SIZE(t%CUR%XD_ROOF,1)))
ALLOCATE(zgrid(SIZE(t%CUR%XD_ROOF,1),SIZE(t%CUR%XD_ROOF,2)))
zgrid(:,:) = 0.
zd(:)   = 0.
!
DO jl=1,SIZE(t%CUR%XD_ROOF,2)
  zgrid(:,jl) = zd(:) + t%CUR%XD_ROOF(:,jl)/2.
  zd(:)    = zd(:) + t%CUR%XD_ROOF(:,jl)
END DO
!
!* surface temperature shift is given by climatological gradient
!* shift of temperatures within the wall is attenuated
!* shift is zero from internal wall to half of wall
DO jl=1,SIZE(t%CUR%XT_ROOF,2)
  t%CUR%XT_ROOF(:,jl) = t%CUR%XT_ROOF(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls) &
                                   * max(1.-2.*zgrid(:,jl)/zd(:),0.)  
END DO
!
DEALLOCATE(zd)
DEALLOCATE(zgrid)
!
!
IF (top%CBEM=='BEM') THEN
  !
  !*      1.6bis Floor Temperature profile
  !
  !* Floor grid
  ALLOCATE(zd(SIZE(b%CUR%XD_FLOOR,1)))
  ALLOCATE(zgrid(SIZE(b%CUR%XD_FLOOR,1),SIZE(b%CUR%XD_FLOOR,2)))
  zgrid(:,:) = 0.
  zd(:)   = 0.
  !
  DO jl=1,SIZE(b%CUR%XD_FLOOR,2)
    zgrid(:,jl) = zd(:) + b%CUR%XD_FLOOR(:,jl)/2.
    zd(:)    = zd(:) + b%CUR%XD_FLOOR(:,jl)
  END DO
  !
  !* deep ground temperature shift is given by climatological gradient
  !* shift of temperatures within the floor is attenuated
  !* shift is zero from internal floor layer to half of floor
  DO jl=1,SIZE(b%CUR%XT_FLOOR,2)
    b%CUR%XT_FLOOR(:,jl) = b%CUR%XT_FLOOR(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls) &
                                   * max(2.*zgrid(:,jl)/zd(:)-1.,0.)
  END DO
  !
  DEALLOCATE(zd)
  DEALLOCATE(zgrid)
  !
  !*      1.6bis Mass Temperature profile
  !
  !* mass grid
  ALLOCATE(zd(SIZE(b%CUR%XD_FLOOR,1)))
  ALLOCATE(zgrid(SIZE(b%CUR%XD_FLOOR,1),SIZE(b%CUR%XD_FLOOR,2)))
  zgrid(:,:) = 0.
  zd(:)   = 0.
  !
  DO jl=1,SIZE(b%CUR%XD_FLOOR,2)
    zgrid(:,jl) = zd(:) + b%CUR%XD_FLOOR(:,jl)/2.
    zd(:)    = zd(:) + b%CUR%XD_FLOOR(:,jl)
  END DO
  !
  !* deep ground temperature shift is given by climatological gradient
  !* shift of temperatures within the floor is attenuated
  !* shift is zero from internal floor layer to half of floor
  DO jl=1,SIZE(b%CUR%XT_MASS,2)
    b%CUR%XT_MASS(:,jl) = b%CUR%XT_MASS(:,jl) + xt_clim_grad  * (top%XZS - xzs_ls) &
                                   * max(2.*zgrid(:,jl)/zd(:)-1.,0.)
  END DO
  !
  DEALLOCATE(zd)
  DEALLOCATE(zgrid)
  !
ENDIF
!
!*      1.7    Snow variables
!
 CALL prep_ver_snow(t%CUR%TSNOW_ROOF,xzs_ls,top%XZS)
 CALL prep_ver_snow(t%CUR%TSNOW_ROAD,xzs_ls,top%XZS)
!
!
!*      1.8    Canyon air temperature
!
!* estimation of temperature at sea level
!
ALLOCATE(zt0(SIZE(t%CUR%XQ_CANYON)))
zt0 = t%CUR%XT_CANYON - xt_clim_grad * xzs_ls
!
!* shift of canyon air temperature
!
ALLOCATE(zt_ls(SIZE(t%CUR%XQ_CANYON)))
zt_ls = t%CUR%XT_CANYON
!
t%CUR%XT_CANYON = t%CUR%XT_CANYON  + xt_clim_grad  * (top%XZS - xzs_ls)
!
!*      1.9    Canyon air humidity
!
!
!
!* estimation of pressure at large-scale orography
!
ALLOCATE(zp_ls(SIZE(t%CUR%XQ_CANYON)))
zp_ls = xp00 * exp(-(xg/xrd/zt0)*xzs_ls +(xg*xt_clim_grad/(2.*xrd*zt0**2))*xzs_ls**2)
!
!* estimation of pressure at output orography
!
ALLOCATE(zp(SIZE(t%CUR%XQ_CANYON)))
zp    = xp00 * exp(-(xg/xrd/zt0)*top%XZS   +(xg*xt_clim_grad/(2.*xrd*zt0**2))*top%XZS   **2)
!
!* conservation of estimated relative humidity
!
t%CUR%XQ_CANYON = t%CUR%XQ_CANYON * qsat(t%CUR%XT_CANYON,zp) / qsat(zt_ls,zp_ls)
!
DEALLOCATE(zp_ls)
DEALLOCATE(zp   )
DEALLOCATE(zt0  )
DEALLOCATE(zt_ls)
IF (lhook) CALL dr_hook('PREP_VER_TEB',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE prep_ver_teb