ccetr.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 ccetr(PXIA,PIA,PXMUS,PABC,PLAI)
!
!!***   *CCETR* ***
!!
!!    PURPOSE
!!    -------
!!    Calculates radiative transfer within the canopy
!!
!!**  METHOD
!!    ------
!!    Calvet et al. 1998 Forr. Agri. Met. 
!!    [from model of Jacobs(1994) and Roujean(1996)]
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------      
!!    USE MODD_CO2V_PAR
!!
!!    REFERENCE
!!    ---------
!!    Calvet et al. 1998 Forr. Agri. Met. 
!!      
!!    AUTHOR
!!    ------
!!      A. Boone           * Meteo-France *
!!      (following Belair)
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    27/10/97 
!!
!-------------------------------------------------------------------------------
!
USE modd_co2v_par, ONLY : xdifracf, xxgt, xxbomega
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, INTENT(IN)               :: pabc
!                                 PABC = abscissa needed for integration
!                                        of net assimilation and stomatal 
!                                        conductance over canopy depth
!
REAL, DIMENSION(:), INTENT(IN) :: pia,pxmus,plai
!                                 PIA   = absorbed PAR
!                                 PXMUS = cosine of solar zenith angle
!                                 PLAI  = leaf area index
!
REAL, DIMENSION(:), INTENT(OUT):: pxia
!                                 PXIA  = incident radiation after diffusion
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PIA,1)) :: zxfd,zxslai,zxidf,zxidr
!                               ZXFD   = fraction of diffusion
!                               ZXSLAI = LAI of upper layer 
!                                ZXIDF  = interception of diffusion
!                              ZXIDR  = direct interception
!
REAL(KIND=JPRB) :: zhook_handle
!
!----------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CCETR',0,zhook_handle)
!
pxia(:) = 0.
!
WHERE (pia(:)>0.)
!
! diffusion fraction
!
! fraction of diffusion
!
  zxfd(:)   = xdifracf/(xdifracf + pxmus(:))                 
!
! LAI of upper layer
!
  zxslai(:) = plai(:)*(1.0-pabc)                             
!
! interception of diffusion
!
  zxidf(:)  = zxfd(:)*(1.0-exp(-0.8*zxslai(:)*xxbomega)) 
  !ZXIDF(:)  = 0.8*XXBOMEGA*EXP(-0.8*ZXSLAI(:)*XXBOMEGA) 
!
! direct interception
!
  zxidr(:)  = (1.0-zxfd(:))*(1.0-exp(-xxgt*zxslai(:)*xxbomega/pxmus(:)))     
  !ZXIDR(:) = XXGT*XXBOMEGA/PXMUS(:)*EXP(-XXGT*ZXSLAI(:)*XXBOMEGA/PXMUS(:))
!
! Adjusted radiation:
!
  pxia(:)   = pia(:)*(1.0-zxidf(:)-zxidr(:))
  !PXIA(:) = PIA(:)*(ZXFD(:)*ZXIDF(:) + (1 - ZXFD(:))*ZXIDR(:))
!
END WHERE
!
IF (lhook) CALL dr_hook('CCETR',1,zhook_handle)
!
END SUBROUTINE ccetr