init_teb_gardenn.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 init_teb_garden_n (DTCO, UG, U, DMTO, TOP, IO, DTV, K, P, PEK, &
                              DK, DEK, DECK, DMK, HPROGRAM, HINIT, KI, KSW, PSW_BANDS, KPATCH)
!#############################################################
!
!!****  *INIT_TEB_GARDEN_n* - routine to initialize ISBA
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_n, ONLY : diag_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_diag_misc_teb_options_n, ONLY : diag_misc_teb_options_t
USE modd_teb_option_n, ONLY : teb_options_t
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_n, ONLY : isba_p_t, isba_k_t, isba_pe_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
!
USE modd_type_date_surf
USE modd_type_snow
!
USE modd_data_cover_par,  ONLY: nvegtype
USE modd_surf_par,        ONLY: xundef, nundef

USE modd_surf_atm,        ONLY: lcpl_arp
!
USE modi_get_luout
USE modi_allocate_teb_veg
USE modi_abor1_sfx
USE modi_read_teb_garden_n
USE modi_init_veg_n
USE modi_soil_albedo
USE modi_init_from_data_teb_veg_n
USE modi_avg_albedo_emis_teb_veg
USE modi_diag_teb_veg_init_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(diag_misc_teb_options_t), INTENT(INOUT) :: DMTO
TYPE(teb_options_t), INTENT(INOUT) :: TOP
!
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(data_isba_t), INTENT(INOUT) :: DTV
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(isba_p_t), INTENT(INOUT) :: P
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
TYPE(diag_t), INTENT(INOUT) :: DK
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEK
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DECK
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMK
!
 CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=3),                   INTENT(IN)  :: HINIT     ! choice of fields to initialize
INTEGER,                            INTENT(IN)  :: KI        ! number of points
INTEGER,                            INTENT(IN)  :: KSW       ! number of short-wave spectral bands
REAL,             DIMENSION(KSW),   INTENT(IN)  :: PSW_BANDS ! middle wavelength of each band
INTEGER,                            INTENT(IN)  :: KPATCH
!
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: ILUOUT   ! unit of output listing file
!
INTEGER           :: IDECADE  ! decade of simulation
!
 CHARACTER(LEN=3) :: YPATCH ! patch identificator
!
REAL, DIMENSION(KI)               :: ZWG1 ! work array for surface water content
REAL, DIMENSION(KI)               :: ZTG1 ! work array for surface temperature
REAL, DIMENSION(KI,KSW)           :: ZDIR_ALB  ! direct albedo for each band
REAL, DIMENSION(KI,KSW)           :: ZSCA_ALB  ! diffuse albedo for each band
REAL, DIMENSION(KI)               :: ZEMIS     ! emissivity
REAL, DIMENSION(KI)               :: ZTSRAD    ! radiative temperature
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
io%CRAIN = "DEF"
!
!-------------------------------------------------------------------------------
!
 CALL allocate_teb_veg(pek, ki, io%NGROUND_LAYER, io%NNBIOMASS)  
!
!-------------------------------------------------------------------------------
!
IF( io%CCPSURF=='DRY' .AND. lcpl_arp ) THEN
  CALL abor1_sfx('CCPSURF=DRY must not be used with LCPL_ARP')
ENDIF
!
!-------------------------------------------------------------------------------
!
IF (hinit/='ALL') THEN
  IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',1,zhook_handle)      
  RETURN
ENDIF
!
!-------------------------------------------------------------------------------
! Variables needed to run isba
!
ALLOCATE(k%XFFLOOD (ki))
ALLOCATE(k%XFF     (ki))
ALLOCATE(k%XFFG    (ki))
ALLOCATE(k%XFFV    (ki))
ALLOCATE(k%XFFROZEN(ki))
ALLOCATE(k%XALBF   (ki))
ALLOCATE(k%XEMISF  (ki))
k%XFFLOOD  = 0.0
k%XFF      = 0.0
k%XFFG     = 0.0
k%XFFV     = 0.0
k%XFFROZEN = 0.0
k%XALBF    = 0.0
k%XEMISF   = 0.0
!
ALLOCATE(k%XFSAT(ki))  
k%XFSAT(:) = 0.0
!
!-------------------------------------------------------------------------------
!
!*      10.     Prognostic and semi-prognostic fields
!               -------------------------------------
!
!* allocation of urban green area variables
!
!
ypatch='   '
IF (top%NTEB_PATCH>1) WRITE(ypatch,fmt='(A,I1,A)') 'T',kpatch,'_'
!
 CALL read_teb_garden_n(dtco, u, io, p, pek, hprogram,ypatch)
!
dtv%LIMP_VEG  = .false.
dtv%LIMP_Z0   = .false.
dtv%LIMP_EMIS = .false.
!
p%NSIZE_P = ki
 CALL init_veg_n(io, k, p, pek, dtv, dmto%LSURF_DIAG_ALBEDO, zdir_alb, zsca_alb, zemis, ztsrad )
!
zwg1(:) = pek%XWG(:,1)
ztg1(:) = pek%XTG(:,1)
!
IF (.NOT. io%LPAR) THEN
  CALL soil_albedo(io%CALBEDO, k%XWSAT(:,1),zwg1, k, pek, "ALL" )  
ELSE
  IF (top%TTIME%TDATE%MONTH /= nundef) THEN
    idecade = 3 * ( top%TTIME%TDATE%MONTH - 1 ) + min(top%TTIME%TDATE%DAY-1,29) / 10 + 1
  ELSE
    idecade = 1
  END IF
  CALL init_from_data_teb_veg_n(dtv, k, p, pek, idecade, .false., .false., .false., .true. )  
END IF
!

WHERE (pek%XALBNIR_SOIL(:)==xundef)
  pek%XALBNIR_SOIL(:)=0.225
  pek%XALBVIS_SOIL(:)=0.15
  pek%XALBUV_SOIL (:)=0.07965
ENDWHERE  
!
 CALL avg_albedo_emis_teb_veg(pek, io%CALBEDO,  ztg1, psw_bands, zdir_alb, zsca_alb, zemis,ztsrad )  
!
 CALL diag_teb_veg_init_n(dk, dek, deck, dmk, ki, pek%TSNOW%NLAYER)
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE init_teb_garden_n