vegetation_update.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 vegetation_update (DTCO, DTV, KDIM, IO, KK, PK, PEK, KPATCH,  &
                                  PTSTEP, TTIME ,PCOVER, OCOVER,             &
                                  OAGRIP, HSFTYPE, OALB, ISSK, ODUPDATED, OABSENT  )
!   ###############################################################
!!****  *VEGETATION EVOL*
!!
!!    PURPOSE
!!    -------
!
!     performs the time evolution of vegetation parameters
!       at UTC midnight for prescribed parameters, with effective change each ten days
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/03/03 
!!
!!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
!!      P Samuelsson 10/2014 MEB
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_k_t, isba_p_t, isba_pe_t
USE modd_sso_n, ONLY : sso_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_options_n, ONLY : isba_options_t
!
USE modd_data_cover_par, ONLY : nvt_snow
USE modd_type_date_surf
!
USE modi_init_isba_mixpar
USE modi_convert_patch_isba
USE modi_init_from_data_teb_veg_n
USE modi_subscale_z0eff
USE modi_albedo
USE modi_update_data_cover
!
!
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(data_isba_t), INTENT(INOUT) :: DTV
INTEGER, INTENT(IN) :: KDIM
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_k_t), INTENT(INOUT) :: KK
TYPE(isba_p_t), INTENT(INOUT) :: PK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
INTEGER, INTENT(IN) :: KPATCH
!
REAL,                 INTENT(IN)    :: PTSTEP  ! time step
TYPE(date_time),      INTENT(IN)    :: TTIME   ! UTC time
REAL,   DIMENSION(:,:), INTENT(IN)  :: PCOVER  ! cover types
LOGICAL, DIMENSION(:), INTENT(IN)   :: OCOVER
LOGICAL,              INTENT(IN)    :: OAGRIP
 CHARACTER(LEN=*),     INTENT(IN)    :: HSFTYPE ! nature / garden
!
LOGICAL, INTENT(IN) :: OALB
!
TYPE(sso_t), INTENT(INOUT) :: ISSK
!
LOGICAL,              INTENT(OUT)   :: ODUPDATED  ! T if parameters are being reset
LOGICAL,DIMENSION(:), INTENT(IN), OPTIONAL :: OABSENT ! T where field is not defined
!
!*      0.2    declarations of local variables
!
INTEGER :: IDECADE, IDECADE2, JI, ISNOWPATCH  ! decade of simulation
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE',0,zhook_handle)
!
!*      2.     Non-interactive vegetation
!              --------------------------
!
!*      2.1    Decade
!              ------
!
idecade = 3 * ( ttime%TDATE%MONTH - 1 ) + min(ttime%TDATE%DAY-1,29) / 10 + 1
idecade2 = idecade
odupdated=.false.
!
!*      2.2    From ecoclimap
!              --------------
!
!* new decade?
IF ( mod(min(ttime%TDATE%DAY,30),10)==1 .AND. ttime%TIME - ptstep < 0.) THEN
  !
  odupdated=.true.
  !
  !* time varying parameters
  IF (io%LECOCLIMAP .OR. hsftype=='NAT') THEN
    !
    !* new year ? --> recomputes data LAI and derivated parameters (usefull in case of ecoclimap2)
    IF (kpatch==1) CALL update_data_cover(dtco, dtv, kdim, io%NPATCH, io%LMEB_PATCH, ttime%TDATE%YEAR)  
    !
    IF (hsftype=='NAT') THEN
      !
      IF (kpatch==1) THEN
        CALL init_isba_mixpar(dtco, dtv, kdim, io, idecade,idecade2,pcover,ocover,hsftype)
      ELSE
        idecade2 = idecade
        IF (dtv%NTIME==2) idecade2 = idecade2 + 10 
        idecade2 = (idecade2-1) * dtv%NTIME / 36 + 1
        IF (dtv%NTIME==2 .AND. idecade2==3) idecade2 = 1
      ENDIF
      !
      CALL convert_patch_isba(dtco, dtv, io, idecade, idecade2, pcover, ocover,&
                              oagrip, hsftype, kpatch, kk, pk, pek, &
                              .false., .true., .true., .true., .false., oalb)
      !
    ELSE
      CALL convert_patch_isba(dtco, dtv, io, idecade, idecade2, pcover, ocover,&
                              oagrip, hsftype, kpatch, kk, pk, pek, &
                             .false., .true., .false., .false., .false., oalb)
    ENDIF
    !
    IF ( io%CALBEDO=='CM13') THEN
      CALL convert_patch_isba(dtco, dtv, io, idecade, idecade2, pcover, ocover,&
                              oagrip, hsftype, kpatch, kk, pk, pek, &
                             .false., .false., .false., .false., .true., .false.)
    ENDIF
    !
  ELSEIF (.NOT.oalb .AND. (hsftype=='GRD'.OR.hsftype=='GNR') ) THEN
    !
    CALL init_from_data_teb_veg_n(dtv, kk, pk, pek, idecade, .false., .false., .true., .false. )
    !
  ENDIF
  !
  !* default values to avoid problems in physical routines
  !  for points where there is no vegetation or soil to be simulated by ISBA.
  IF (PRESENT(oabsent) .AND. .NOT.oalb) THEN
    !
    WHERE (oabsent(:))
      pek%XVEG       (:) = 0.
      pek%XLAI       (:) = 0.
      pek%XRSMIN     (:) = 40.
      pek%XGAMMA     (:) = 0.
      pek%XWRMAX_CF  (:) = 0.2
      pek%XRGL       (:) = 100.
      pek%XCV        (:) = 2.e-5
      pek%XZ0        (:) = 0.013
      pek%XALBNIR_VEG(:) = 0.30
      pek%XALBVIS_VEG(:) = 0.30
      pek%XALBUV_VEG (:) = 0.06
      pek%XEMIS      (:) = 0.94                
    END WHERE
    IF (io%CPHOTO/='NON') THEN
      WHERE (oabsent(:))
        pek%XGMES      (:) = 0.020
        pek%XBSLAI     (:) = 0.36
        pek%XLAIMIN    (:) = 0.3
        pek%XSEFOLD    (:) = 90*86400.
        pek%XGC        (:) = 0.00025                  
      END WHERE
      WHERE (oabsent(:)) pek%XF2I(:) = 0.3
      IF (io%CPHOTO=='NIT' .OR. io%CPHOTO=='NCB') THEN
        WHERE (oabsent(:))
          pek%XCE_NITRO  (:) = 7.68
          pek%XCF_NITRO  (:) = -4.33
          pek%XCNA_NITRO (:) = 1.3                      
        END WHERE
      ENDIF
    ENDIF
    !
  ENDIF
  !
  IF (hsftype=='NAT') THEN
    !* albedo
    CALL albedo(io%CALBEDO, pek )
    !
    !* effective roughness length
    IF (.NOT.oalb) CALL subscale_z0eff(issk,pek%XZ0,.false.  )  
    !
  ENDIF
  !
END IF
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE',1,zhook_handle)
!
!-----------------------------------------------------------------
!
END SUBROUTINE vegetation_update