prep_teb_buffer.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_teb_buffer(HPROGRAM,HSURF,KLUOUT,PFIELD)
!     #################################################################################
!
!!****  *PREP_TEB_BUFFER* - prepares TEB field from operational BUFFER
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     S. Malardel 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005
!!------------------------------------------------------------------
!

!
USE modd_type_date_surf
!
USE modi_prep_buffer_grid
USE mode_read_buffer
USE modi_interp_grid
!
USE modd_prep,       ONLY : cinterp_type
USE modd_grid_buffer,  ONLY : nni
USE modd_prep_teb,   ONLY : xgrid_road, xgrid_wall, xgrid_roof, xgrid_floor, &
                            xti_bld, xti_road, xhui_bld, xti_bld_def
USE modd_surf_par,   ONLY : xundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=7),   INTENT(IN)  :: hsurf     ! type of field
INTEGER,            INTENT(IN)  :: kluout    ! logical unit of output listing
REAL,DIMENSION(:,:), POINTER    :: pfield    ! field to interpolate horizontally
!
!*      0.2    declarations of local variables
!
TYPE (date_time)                :: tztime_buf    ! current date and time
 CHARACTER(LEN=6)                :: yinmodel ! model from which BUFFER originates
REAL, DIMENSION(:),   POINTER   :: zfield1d ! 1D field read
REAL, DIMENSION(:,:), POINTER   :: zfield   ! field read
REAL, DIMENSION(:,:), POINTER   :: zd             ! depth of field in the soil
REAL                            :: zti_bld  ! internal building temperature
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
!*      1.     Reading of grid
!              ---------------
!
IF (lhook) CALL dr_hook('PREP_TEB_BUFFER',0,zhook_handle)
 CALL prep_buffer_grid(kluout,yinmodel,tztime_buf)
!
IF (hsurf=='T_FLOOR' .OR. hsurf=='T_WALL' .OR. hsurf=='T_ROOF' .OR.  hsurf=='T_WIN2' .OR. hsurf=='TI_BLD') THEN
   zti_bld = xti_bld_def
   IF (xti_bld/=xundef) zti_bld=xti_bld
ENDIF
!---------------------------------------------------------------------------------------
SELECT CASE(hsurf)
!---------------------------------------------------------------------------------------
!
!*     2.      Orography
!              ---------
!
  CASE('ZS     ')
    SELECT CASE (yinmodel)
      CASE ('ALADIN')
        CALL read_buffer_zs(kluout,yinmodel,zfield1d)
        ALLOCATE(pfield(nni,1))
        pfield(:,1) = zfield1d(:)
        DEALLOCATE(zfield1d)
    END SELECT
!
!*      3.     Profile of temperatures in roads
!              --------------------------------
!
  CASE('T_ROAD')
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
       CASE('ALADIN')
         CALL read_buffer_tg(kluout,yinmodel,zfield,zd)
     END SELECT
     !* if deep road temperature is prescribed
     IF (xti_road/=xundef) THEN
       zfield(:,2:) = xti_road 
     END IF
     CALL teb_profile_buffer(xgrid_road)
!
!*      3.bis     Profile of temperatures in floors
!                 --------------------------------

  CASE('T_FLOOR')
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
       CASE('ALADIN')
         CALL read_buffer_tf_teb(kluout,yinmodel,zti_bld,zfield,zd)
     END SELECT
     !* if deep road temperature is prescribed
     IF (xti_road/=xundef) THEN
       zfield(:,2:) = xti_road 
     END IF
     CALL teb_profile_buffer(xgrid_floor)

!*      4.     Profile of temperatures in walls
!              --------------------------------

  CASE('T_WALLA','T_WALLB')
     CALL read_buffer_t_teb(kluout,yinmodel,zti_bld,zfield,zd)
     CALL teb_profile_buffer(xgrid_wall)
        
  CASE('T_WIN1')
    SELECT CASE (yinmodel)
      CASE ('ALADIN')
        CALL read_buffer_ts(kluout,yinmodel,zfield1d)
        ALLOCATE(pfield(nni,1))
        pfield(:,1) = zfield1d(:)
        DEALLOCATE(zfield1d)
    END SELECT

!*      5.     Profile of temperatures in roofs
!              --------------------------------

  CASE('T_ROOF')    
     CALL read_buffer_t_teb(kluout,yinmodel,zti_bld,zfield,zd)
     CALL teb_profile_buffer(xgrid_roof)

!*      5.bis    Profile of temperatures in thermal mass
!              -----------------------------------------
!    
  CASE('T_MASS')
     ALLOCATE(pfield(nni,3))
     pfield(:,:) = zti_bld
     CALL teb_profile_buffer(xgrid_floor)
!
!*      6.     Canyon air temperature
!              ----------------------
!
  CASE('T_CAN  ')
    SELECT CASE (yinmodel)
      CASE ('ALADIN')
        CALL read_buffer_t2(kluout,yinmodel,zfield1d)
        ALLOCATE(pfield(nni,1))
        pfield(:,1) = zfield1d(:)
        DEALLOCATE(zfield1d)
    END SELECT
!
!*      7.      Canyon air humidity
!               -------------------
!
  CASE('Q_CAN  ')
    SELECT CASE (yinmodel)
      CASE ('ALADIN')
        ALLOCATE(pfield(nni,1))
        pfield(:,1) = 0.01
    END SELECT

!
!*      9.     Deep road temperature
!              ---------------------

  CASE('TI_ROAD')    
     IF (xti_road==xundef) THEN
       CALL read_buffer_t2(kluout,yinmodel,zfield1d)
       ALLOCATE(pfield(nni,1))
       pfield(:,1) = zfield1d(:)
       DEALLOCATE(zfield1d)
     ELSE
       ALLOCATE(pfield(nni,1))
       pfield = xti_road
     END IF


!*      9.     Building temperatures/moisture
!              --------------------

  CASE('TI_BLD ')    
     ALLOCATE(pfield(nni,1))
     pfield(:,:) = zti_bld
!
  CASE('T_WIN2')
     ALLOCATE(pfield(nni,1))
     pfield(:,:) = zti_bld

  CASE('QI_BLD ')
     ALLOCATE(pfield(nni,1))
     pfield(:,1) = xundef

!*     10.     Other quantities (water reservoirs)
!              ----------------

  CASE default
    ALLOCATE(pfield(nni,1))
    pfield = 0.

END SELECT
!
!*      4.     Interpolation method
!              --------------------
!
 cinterp_type='BUFFER'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_TEB_BUFFER',1,zhook_handle)
 CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
SUBROUTINE teb_profile_buffer(PGRID)
!-------------------------------------------------------------------------------------
!
REAL, DIMENSION(:),   INTENT(IN)  :: pgrid  ! destination grid
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
!* interpolation on fine vertical grid
IF (lhook) CALL dr_hook('TEB_PROFILE_BUFFER',0,zhook_handle)
ALLOCATE(pfield(SIZE(zfield,1),SIZE(pgrid)))
 CALL interp_grid(zd,zfield,pgrid,pfield)
!
!* end
DEALLOCATE(zfield)
DEALLOCATE(zd)
IF (lhook) CALL dr_hook('TEB_PROFILE_BUFFER',1,zhook_handle)

END SUBROUTINE teb_profile_buffer
!
!-------------------------------------------------------------------------------------
END SUBROUTINE prep_teb_buffer