cotwoinitn.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 cotwoinit_n (I, &
                              hphoto,pvegtype,pgmes,pco2,pgc,pdmax,            &
                            pabc,ppoi,panmax,                                 &
                            pfzero,pepso,pgamm,pqdgamm,pqdgmes,pt1gmes,       &
                            pt2gmes,pamax,pqdamax,pt1amax,pt2amax,pah,pbh,    &
                            ptau_wood                                         )  
!     #######################################################################
!
!!****  *COTWOINIT*  
!!
!!    PURPOSE
!!    -------
!
!     Initialize model to calculate net assimilation of 
!     CO2 and leaf conductance.
!              
!!**  METHOD
!!    ------
!     Calvet at al (1998) [from model of Jacobs(1994)]
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    USE MODD_CO2V_PAR
!!    USE MODI_COTWO  
!!
!!    REFERENCE
!!    ---------
!!
!!    Calvet et al. (1998)
!!      
!!    AUTHOR
!!    ------
!!
!!      A. Boone           * Meteo-France *
!!      (following Belair)
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    27/10/97
!!      (V. Rivalland) 10/04/02  Add: PAH and PBH coefficients for
!!                               herbaceous water stress response
!!      (P. LeMoigne) 03/2004:   computation of zgmest in SI units
!!      (P. LeMoigne) 10/2004:   possibility of 2 different FZERO
!!      (L. Jarlan)   10/2004:   initialization of DMAX
!!      P Le Moigne   09/2005    AGS modifs of L. Jarlan
!!      S. Lafont     03/2009    change unit of AMAX
!!      A.L. Gibelin  04/2009    TAU_WOOD for NCB option 
!!      A.L. Gibelin  04/2009    Suppress useless GPP and RDK arguments 
!!      A.L. Gibelin  07/2009    Suppress PPST and PPSTF as outputs
!!      B. Decharme   05/2012    Optimization
!!      R. Alkama     05/2012    add 7 new vegtype (19  instead 12)
!!      C. Delire     01/2014    Define a dummy LAI from top and total lai for Dark respiration 
!!
!-------------------------------------------------------------------------------
!
!
USE modd_isba_n, ONLY : isba_t
!
USE modd_data_cover_par, ONLY : nvegtype, nvt_c3, nvt_c4, nvt_irr, nvt_trog,     &
                                nvt_tebd, nvt_bone, nvt_trbe, nvt_trbd, nvt_tebe,&
                                nvt_tene, nvt_bobd, nvt_bond, nvt_shrb, nvt_gras
USE modd_csts,           ONLY : xmd
USE modd_co2v_par,       ONLY : xtopt, xfzero1, xfzero2, xfzerotrop, xepso, xgamm, xqdgamm, &
                                  xqdgmes, xt1gmes, xt2gmes, xamax,               &
                                  xqdamax, xt1amax, xt2amax, xah, xbh,            &
                                  xdspopt, xiaopt, xaw, xbw, xmco2, xmc, xtau_wood  
! 
USE mode_cotwo,          ONLY : gauleg
USE modi_cotwo  
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
TYPE(isba_t), INTENT(INOUT) :: i
!
 CHARACTER(LEN=3),   INTENT(IN)   :: hphoto      ! type of photosynthesis
REAL,DIMENSION(:,:),INTENT(IN)   :: pvegtype
!                                     PVEGTYPE = fraction of each
!                                     vegetation classification index;
!                                     C3 =>1, C4 => 2
!
REAL,DIMENSION(:),INTENT(IN)  :: pgmes, pco2
!                                     PGMES     = mesophyll conductance (m s-1)
!                                     PCO2      = atmospheric CO2 concentration
!
REAL,DIMENSION(:),INTENT(IN)   :: pdmax, pgc    
!                                     PDMAX     = maximum air saturation deficit tolerate
!                                                 by vegetation
!                                     PGC       = cuticular conductance (m s-1)
!
REAL, DIMENSION(:), INTENT(OUT)  :: pabc, ppoi
!                                     ZABC      = abscissa needed for integration
!                                     of net assimilation and stomatal conductance
!                                     over canopy depth
!                                     ZPOI      = Gaussian weights (as above)
!
REAL,DIMENSION(:),INTENT(OUT)  :: panmax
!                                     PANMAX    = maximum net assimilation
!
REAL,DIMENSION(:),INTENT(OUT)  :: pfzero, pepso, pgamm, pqdgamm, pqdgmes,  &
                                    pt1gmes, pt2gmes, pamax, pqdamax,       &
                                    pt1amax, pt2amax, ptau_wood  
!                                     PFZERO    = ideal value of F, no photorespiration or 
!                                                 saturation deficit
!                                     PEPSO     = maximum initial quantum use efficiency 
!                                                 (kgCO2 kgAir-1 J-1 PAR)
!                                     PGAMM     = CO2 conpensation concentration (kgCO2 kgAir-1)
!                                     PQDGAMM   = Log of Q10 function for CO2 conpensation 
!                                                 concentration
!                                     PQDGMES   = Log of Q10 function for mesophyll conductance 
!                                     PT1GMES   = reference temperature for computing 
!                                                 compensation concentration function for 
!                                                 mesophyll conductance: minimum temperature 
!                                     PT2GMES   = reference temperature for computing 
!                                                 compensation concentration function for 
!                                                 mesophyll conductance: maximum temperature
!                                     PAMAX     = leaf photosynthetic capacity (Units of kgCO2 kgAir-1 m s-1)
!                                     PQDAMAX   = Log of Q10 function for leaf photosynthetic capacity
!                                     PT1AMAX   = reference temperature for computing 
!                                                 compensation concentration function for leaf 
!                                                 photosynthetic capacity: minimum temperature
!                                     PT2AMAX   = reference temperature for computing 
!                                                 compensation concentration function for leaf 
!                                                 photosynthetic capacity: maximum temperature
!                                     PTAU_WOOD = residence time in woody biomass (s)
!
REAL,DIMENSION(:),INTENT(OUT)  :: pah, pbh
!                                     PAH       = coeficient of universal relationship for herbaceous
!                                     PBH       = coeficient of universal relationship for herbaceous
!
!*      0.2    declaration of local variables
!
INTEGER                           :: jclass    ! indexes for loops
INTEGER                           :: iclass    ! indexes for loops
INTEGER                           :: ico2type  ! type of CO2 vegetation
INTEGER                           :: irad      ! with or without new radiative transfer
!
REAL, DIMENSION(SIZE(PANMAX))     :: zgs, zgammt, ztopt, zanmax, zgmest, zgpp, zrdk, zepso
!                                    ZTOPT     = optimum  temperature for compensation 
!                                                point
!                                    ZANMAX    = maximum photosynthesis rate
!                                    ZGS       = leaf conductance
!                                    ZGAMMT    = temperature compensation point
!                                    ZGPP      = gross primary production
!                                    ZRDK      = dark respiration
!
!
REAL, DIMENSION(SIZE(PANMAX))     :: zco2init3, zco2init4, zco2init5, zco2init2,zco2init1
!                                    working arrays for initializing surface 
!                                    temperature, saturation deficit, global radiation,
!                                    optimum temperature for determining maximum 
!                                    photosynthesis rate, and soil water stress (none)
REAL, DIMENSION(SIZE(PDMAX))      :: zdmax
REAL, DIMENSION(SIZE(PDMAX))      :: zwork
!                                    Local variable in order to initialise DMAX
!                                    following Calvet, 2000 (AST or LST cases)
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COTWOINIT_N',0,zhook_handle)
!
ztopt(:) = 0.
pfzero(:) = 0.
pepso(:) = 0.
pgamm(:) = 0.
pqdgamm(:) = 0.
pqdgmes(:) = 0.
pt1gmes(:) = 0.
pt2gmes(:) = 0.
pamax(:) = 0.
pqdamax(:) = 0.
pt1amax(:) = 0.
pt2amax(:) = 0.
ptau_wood(:) = 0.
!
pah(:) = 0.
pbh(:) = 0.
!
zepso(:) = 0.
zgpp(:) = 0.
zrdk(:) = 0.
zgammt(:) = 0.
zanmax(:) = 0.
zgmest(:) = 0.
zco2init3(:) = 0.
zco2init4(:) = 0.
zco2init5(:) = 0.
!
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
!
! DETERMINE GAUSSIAN WEIGHTS NEEDED FOR CO2 MODEL 
! -----------------------------------------------
!
 CALL gauleg(0.0,1.0,pabc,ppoi,SIZE(pabc))
!
!
! INITIALIZE VARIOUS PARAMETERS FOR CO2 MODEL:
! --------------------------------------------
! as a function of CO2 vegetation class, C3=>1, C4=>2
!
DO jclass=1,nvegtype
  !
  IF (jclass==nvt_c4 .OR. jclass==nvt_irr .OR. jclass==nvt_trog) THEN
    ico2type = 2   ! C4 type
  ELSE
    ico2type = 1   ! C3 type
  END IF
  IF(i%LAGRI_TO_GRASS.AND.(jclass==nvt_c4 .OR. jclass==nvt_irr)) ico2type = 1
  IF (i%LTR_ML) THEN
    irad = 1   ! running with new radiative transfer
  ELSE
    irad = 2
  ENDIF
  !
  ztopt(:) = ztopt(:) + xtopt(ico2type) * pvegtype(:,jclass)
  IF (hphoto == 'AGS' .OR. hphoto == 'LAI') THEN
     pfzero(:) = pfzero(:) + xfzero1(ico2type) * pvegtype(:,jclass)
  ELSE
     IF((jclass==nvt_tebd) .OR. (jclass==nvt_bone) .OR.                         &
        (jclass==nvt_trbd) .OR. (jclass==nvt_tebe) .OR. (jclass==nvt_tene) .OR. &
        (jclass==nvt_bobd) .OR. (jclass==nvt_bond) .OR. (jclass==nvt_shrb)) THEN
        pfzero(:) = pfzero(:) + ((xaw - log(pgmes(:)*1000.0))/xbw)*pvegtype(:,jclass)
     ELSE IF (jclass==nvt_trbe) THEN
        pfzero(:) = pfzero(:) + xfzerotrop(irad) * pvegtype(:,jclass)
     ELSE
        pfzero(:) = pfzero(:) + xfzero2(ico2type) * pvegtype(:,jclass)
     ENDIF
  ENDIF
  !
  pepso(:) = pepso(:) + xepso(ico2type) * pvegtype(:,jclass)
  pgamm(:) = pgamm(:) + xgamm(ico2type) * pvegtype(:,jclass)
  pqdgamm(:) = pqdgamm(:) + xqdgamm(ico2type) * pvegtype(:,jclass)
  pqdgmes(:) = pqdgmes(:) + xqdgmes(ico2type) * pvegtype(:,jclass)
  pt1gmes(:) = pt1gmes(:) + xt1gmes(ico2type) * pvegtype(:,jclass)
  pt2gmes(:) = pt2gmes(:) + xt2gmes(ico2type) * pvegtype(:,jclass)
  pqdamax(:) = pqdamax(:) + xqdamax(ico2type) * pvegtype(:,jclass)
  pt1amax(:) = pt1amax(:) + xt1amax(ico2type) * pvegtype(:,jclass)
  pt2amax(:) = pt2amax(:) + xt2amax(ico2type) * pvegtype(:,jclass)
  pah(:) = pah(:) + xah(ico2type) * pvegtype(:,jclass)
  pbh(:) = pbh(:) + xbh(ico2type) * pvegtype(:,jclass)
  !
  IF(i%LAGRI_TO_GRASS.AND.(jclass==nvt_c3 .OR. jclass==nvt_c4 .OR. jclass==nvt_irr))THEN
    iclass=nvt_gras
  ELSE
    iclass=jclass
  ENDIF    
  !
  ptau_wood(:) = ptau_wood(:) + xtau_wood(iclass) * pvegtype(:,jclass)
  pamax(:) = pamax(:) + xamax(iclass) * pvegtype(:,jclass)
  !
END DO
!
pqdgamm(:)=log(pqdgamm(:))
pqdgmes(:)=log(pqdgmes(:))
pqdamax(:)=log(pqdamax(:))
!
!
! INITIALIZE VARIOUS VARIABLES FOR CO2 MODEL:
! -------------------------------------------
!
!
! compute temperature responses:
!
!before optimization (with non log PQDGAMM) : 
!ZGAMMT(:) = PGAMM(:)*(PQDGAMM(:)**(0.1*(ZTOPT(:)-25.0)))
zwork(:) = (0.1*(ztopt(:)-25.0)) * pqdgamm(:)
zgammt(:) = pgamm(:)*exp(zwork(:))
!
!before optimization (with non log PQDAMAX) :
!ZANMAX(:) = ( PAMAX(:)*PQDAMAX(:)**(0.1*(ZTOPT(:)-25.0)) ) / ...
zwork(:) = (0.1*(ztopt(:)-25.0)) * pqdamax(:)
zanmax(:) = ( pamax(:)*exp(zwork(:)) )                   &
               /( (1.0+exp(0.3*(pt1amax(:)-ztopt(:))))*  &
                  (1.0+exp(0.3*(ztopt(:)-pt2amax(:)))) )  
!
!before optimization (with non log PQDGMES) :
!ZGMEST(:) = ( PGMES(:)*PQDGMES(:)**(0.1*(ZTOPT(:)-25.0)) )    &
zwork(:) = (0.1*(ztopt(:)-25.0)) * pqdgmes(:)
zgmest(:) = ( pgmes(:)*exp(zwork(:)) )                   &
               /( (1.0+exp(0.3*(pt1gmes(:)-ztopt(:))))*  &
                  (1.0+exp(0.3*(ztopt(:)-pt2gmes(:)))) )  
!
!
! initialize other variables: (using optimum values for some variables)
!
zco2init3(:) = xdspopt
zco2init4(:) = xiaopt
zco2init5(:) = 1.0
!
! Define a dummy LAI from top (zco2init2=0.1) and total lai (zco2init=1) for Dark respiration extinction parameterization 
!
zco2init2(:) = 0.1
zco2init1(:) = 1.0
!
! Add soil moisture stress effect to leaf conductance:
!
zgmest(:) = zgmest(:)*zco2init5(:)
!
! Initialise DMAX following Calvet (2000) in the case of 'AST' or 'LST' photosynthesis option
!
IF((hphoto=='AST').OR.(hphoto=='LST').OR.(hphoto=='NIT').OR.(hphoto=='NCB')) THEN
   zdmax(:) = exp((log(zgmest(:)*1000.)-pah(:))/pbh(:))/1000.
ELSE
   zdmax(:) = pdmax(:)
ENDIF
!
! Compute maximum/initial/optimum net assimilation of CO2:
!
! Unit conversion with a constant value of 1.2 for PRHOA as it is not known here
! ZANMAX and ZEPSO from kgCO2/m2/s to kgCO2/kgair m/s by dividing by RHOA (kgair/m3)
! ZGAMMT from ppm to kgCO2/kgair
zanmax(:)=zanmax(:)/1.2
zepso(:)=pepso(:)/1.2
zgammt(:)=zgammt(:)*xmco2/xmd*1e-6
!
 CALL cotwo(pco2, zco2init5, zco2init4, zco2init3, zgammt, &
           pfzero, zepso, zanmax, zgmest, pgc, zdmax,     &
           panmax, zgs, zrdk, zco2init2, zco2init1        )                     
! change by sebastien PEPSO change into ZEPSO for units consistency
!
!
!
IF (lhook) CALL dr_hook('COTWOINIT_N',1,zhook_handle)
!
END SUBROUTINE cotwoinit_n