diag_teb_initn.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 diag_teb_init_n (DGO, D, DUT, HPROGRAM,KLU,KSW)
!     #####################
!
!!****  *DIAG_TEB_INIT_n* - routine to initialize TEB diagnostic variables
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!!       V. Masson  10/2013 Adds integrated UTCI diagnostics
!       B. decharme 04/2013 : Add DIAG_TS
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE mode_diag
!
USE modd_diag_n, ONLY : diag_t, diag_options_t
USE modd_diag_utci_teb_n, ONLY : diag_utci_teb_t
!
USE modd_surf_par,   ONLY : xundef
USE modd_type_date_surf
!
USE modd_utci,              ONLY : nutci_stress

!
USE modi_read_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
TYPE(diag_options_t), INTENT(IN) :: DGO
TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_utci_teb_t), INTENT(INOUT) :: DUT
!
INTEGER, INTENT(IN) :: KLU   ! size of arrays
INTEGER, INTENT(IN) :: KSW   ! spectral bands
 CHARACTER(LEN=6), INTENT(IN):: HPROGRAM  ! program calling
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=12) :: YREC           ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!* surface energy budget
!
IF (lhook) CALL dr_hook('DIAG_TEB_INIT_N',0,zhook_handle)
!
 CALL alloc_bud(dgo,d,klu,ksw)
!
IF (dgo%LSURF_BUDGET) THEN
  ALLOCATE(d%XSFCO2(klu))
  d%XSFCO2   = xundef
ELSE
  ALLOCATE(d%XSFCO2(0))  
END IF
!
!* miscellaneous fields
!
IF (dgo%N2M>0 .AND. dut%LUTCI) THEN
  !
  ALLOCATE(dut%XUTCI_IN       (klu))
  ALLOCATE(dut%XUTCI_OUTSUN   (klu))
  ALLOCATE(dut%XUTCI_OUTSHADE (klu))
  ALLOCATE(dut%XTRAD_SUN      (klu))
  ALLOCATE(dut%XTRAD_SHADE    (klu))
  ALLOCATE(dut%XUTCIC_IN      (klu,nutci_stress))
  ALLOCATE(dut%XUTCIC_OUTSUN  (klu,nutci_stress))
  ALLOCATE(dut%XUTCIC_OUTSHADE(klu,nutci_stress))
  !
  dut%XUTCI_IN        = xundef
  dut%XUTCI_OUTSUN    = xundef
  dut%XUTCI_OUTSHADE  = xundef
  dut%XTRAD_SUN       = xundef
  dut%XTRAD_SHADE     = xundef
  dut%XUTCIC_IN       = 0.
  dut%XUTCIC_OUTSUN   = 0.
  dut%XUTCIC_OUTSHADE = 0.
  !  
ELSE
  ALLOCATE(dut%XUTCI_IN       (0))
  ALLOCATE(dut%XUTCI_OUTSUN   (0))
  ALLOCATE(dut%XUTCI_OUTSHADE (0))
  ALLOCATE(dut%XTRAD_SUN      (0))
  ALLOCATE(dut%XTRAD_SHADE    (0))        
  ALLOCATE(dut%XUTCIC_IN      (0,0))
  ALLOCATE(dut%XUTCIC_OUTSUN  (0,0))
  ALLOCATE(dut%XUTCIC_OUTSHADE(0,0))
ENDIF
!
IF (lhook) CALL dr_hook('DIAG_TEB_INIT_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE diag_teb_init_n