modd_teb_garden_pgd_evoln.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.
!##################
MODULE modd_teb_garden_pgd_evol_n
!##################
!
!!****  *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original       01/2011
!!      V. Masson      06/2013 splits module in 4
!!
!-------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!             ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE

!-------------------------------------------------------------------------------
TYPE teb_garden_pgd_evol_1p_t
!!-------------------------------------------------------------------------------
!
! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', or 'NIT') or prescribed (YPHOTO='NON', 'AGS' or 'LST')
!
  REAL, POINTER, DIMENSION(:) :: XLAI          ! Leaf Area Index                         (m2/m2)
  REAL, POINTER, DIMENSION(:) :: XVEG          ! vegetation cover fraction               (-)
  REAL, POINTER, DIMENSION(:) :: XALBNIR       ! near-infra-red albedo                   (-)
  REAL, POINTER, DIMENSION(:) :: XALBVIS       ! visible albedo                          (-)
  REAL, POINTER, DIMENSION(:) :: XALBUV        ! UV albedo                               (-)
  REAL, POINTER, DIMENSION(:) :: XEMIS         ! surface emissivity                      (-)
  REAL, POINTER, DIMENSION(:) :: XZ0           ! surface roughness length                (m)
!
!-------------------------------------------------------------------------------
END TYPE teb_garden_pgd_evol_1p_t
!
TYPE teb_garden_pgd_evol_t
  !
  TYPE(teb_garden_pgd_evol_1p_t), POINTER :: ALP(:) => NULL()
  TYPE(teb_garden_pgd_evol_1p_t), POINTER :: CUR => NULL()
  !
END TYPE teb_garden_pgd_evol_t
!


 CONTAINS
!
!
SUBROUTINE teb_garden_pgd_evol_goto_patch(YTEB_GARDEN_PGD_EVOL,KTO_PATCH)
TYPE(teb_garden_pgd_evol_t), INTENT(INOUT) :: yteb_garden_pgd_evol
INTEGER, INTENT(IN) :: kto_patch
REAL(KIND=JPRB) :: zhook_handle
!
! Current patch is set to patch KTO_PATCH
IF (lhook) CALL dr_hook('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_PATCH',0,zhook_handle)

yteb_garden_pgd_evol%CUR => yteb_garden_pgd_evol%ALP(kto_patch)

IF (lhook) CALL dr_hook('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_PATCH',1,zhook_handle)
!
END SUBROUTINE teb_garden_pgd_evol_goto_patch
!
SUBROUTINE teb_garden_pgd_evol_init(YTEB_GARDEN_PGD_EVOL,KPATCH)
TYPE(teb_garden_pgd_evol_t), INTENT(INOUT) :: yteb_garden_pgd_evol
INTEGER, INTENT(IN) :: kpatch
INTEGER :: jp
REAL(KIND=JPRB) :: zhook_handle
IF (lhook) CALL dr_hook("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_INIT",0,zhook_handle)
 ALLOCATE(yteb_garden_pgd_evol%ALP(kpatch))
 yteb_garden_pgd_evol%CUR => yteb_garden_pgd_evol%ALP(1)
DO jp=1,kpatch
  nullify(yteb_garden_pgd_evol%ALP(jp)%XALBNIR)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XALBVIS)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XALBUV)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XEMIS)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XZ0)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XVEG)
  nullify(yteb_garden_pgd_evol%ALP(jp)%XLAI)
ENDDO 
IF (lhook) CALL dr_hook("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_INIT",1,zhook_handle)
END SUBROUTINE teb_garden_pgd_evol_init




END MODULE modd_teb_garden_pgd_evol_n