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, DTI, DTGD, DTGR, IG, I, TGRO, &
                                  ptstep,ttime,pcover,ocover,          &
                       hisba,oecoclimap, hphoto, oagrip, otr_ml,      &
                       hsftype, plai,pveg,pz0,                        &
                       palbnir,palbvis,palbuv,pemis,                  &
                       prsmin,pgamma,pwrmax_cf,                       &
                       prgl,pcv,                                      &
                       pgmes,pbslai,plaimin,psefold,pgc,pdmax,        &
                       pf2i,ostress,                                  &
                       paosip,paosim,paosjp,paosjm,                   &
                       pho2ip,pho2im,pho2jp,pho2jm,                   &
                       pz0effip,pz0effim,pz0effjp,pz0effjm,           &
                       halbedo, palbnir_veg, palbvis_veg, palbuv_veg, &
                       palbnir_soil, palbvis_soil, palbuv_soil,       &
                       pce_nitro, pcf_nitro, pcna_nitro,              &
                       tpseed, tpreap, pwatsup, pirrig,               &
                       pgndlitter, prglgv,pgammagv,                   &
                       prsmingv, pwrmax_cfgv,                         &
                       ph_veg, plaigv, pz0litter,                     &
                       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_data_cover_n, ONLY : data_cover_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_data_teb_garden_n, ONLY : data_teb_garden_t
USE modd_data_teb_greenroof_n, ONLY : data_teb_greenroof_t
USE modd_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_t
USE modd_teb_greenroof_option_n, ONLY : teb_greenroof_options_t
!
USE modd_type_date_surf
!
USE modi_init_isba_mixpar
USE modi_convert_patch_isba
USE modi_init_from_data_grdn_n
USE modi_init_from_data_greenroof_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) :: dti
TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
TYPE(data_teb_greenroof_t), INTENT(INOUT) :: dtgr
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(teb_greenroof_options_t), INTENT(INOUT) :: tgro
!
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
 CHARACTER(LEN=*),     INTENT(IN)    :: hisba   ! type of soil (Force-Restore OR Diffusion)
 CHARACTER(LEN=*),     INTENT(IN)    :: hphoto  ! type of photosynthesis
LOGICAL,              INTENT(IN)    :: oagrip
LOGICAL,              INTENT(IN)    :: otr_ml
 CHARACTER(LEN=*),     INTENT(IN)    :: hsftype ! nature / garden
LOGICAL,              INTENT(IN)    :: oecoclimap ! T if ecoclimap is used
!
REAL,   DIMENSION(:,:), INTENT(INOUT) :: plai    ! leaf area index (LAI) 
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pveg    ! vegetation fraction
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pz0     ! roughness length: momentum
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbnir ! snow-free near-infra-red albedo
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbvis ! snow-free visible albedo
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbuv  ! snow-free UV albedo
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pemis   ! snow-free emissivity
!
REAL,   DIMENSION(:,:), INTENT(INOUT) :: prsmin  ! minimal stomatal resistance
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pgamma  ! 
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pwrmax_cf ! 
REAL,   DIMENSION(:,:), INTENT(INOUT) :: prgl
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pcv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pgmes
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pce_nitro
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pcf_nitro
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pcna_nitro
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pbslai
REAL,   DIMENSION(:,:), INTENT(INOUT) :: plaimin
REAL,   DIMENSION(:,:), INTENT(INOUT) :: psefold
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pgc
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pf2i
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pdmax
LOGICAL,DIMENSION(:,:), INTENT(INOUT) :: ostress
!
! MEB stuff
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pgndlitter
REAL,   DIMENSION(:,:), INTENT(INOUT) :: prglgv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pgammagv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: prsmingv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pwrmax_cfgv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: ph_veg
REAL,   DIMENSION(:,:), INTENT(INOUT) :: plaigv
REAL,   DIMENSION(:,:), INTENT(INOUT) :: pz0litter
!
 CHARACTER(LEN=4),     INTENT(IN)    :: halbedo ! albedo type
!                                              ! 'DRY ' 
!                                              ! 'EVOL' 
!                                              ! 'WET ' 
!                                              ! 'USER'
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbvis_veg ! visible, near infra-red and UV
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbnir_veg ! albedo of the vegetation
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbuv_veg  !
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbvis_soil! visible, near infra-red and UV
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbnir_soil! soil albedo
REAL,   DIMENSION(:,:), INTENT(INOUT) :: palbuv_soil !

REAL, DIMENSION(:), INTENT(IN)  :: paosip  ! A/S for increasing x
REAL, DIMENSION(:), INTENT(IN)  :: paosim  ! A/S for decreasing x
REAL, DIMENSION(:), INTENT(IN)  :: paosjp  ! A/S for increasing y
REAL, DIMENSION(:), INTENT(IN)  :: paosjm  ! A/S for decreasing y
REAL, DIMENSION(:), INTENT(IN)  :: pho2ip  ! h/2 for increasing x
REAL, DIMENSION(:), INTENT(IN)  :: pho2im  ! h/2 for decreasing x
REAL, DIMENSION(:), INTENT(IN)  :: pho2jp  ! h/2 for increasing y
REAL, DIMENSION(:), INTENT(IN)  :: pho2jm  ! h/2 for decreasing y
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: pz0effip! roughness length for increasing x
REAL, DIMENSION(:,:), INTENT(INOUT) :: pz0effim! roughness length for decreasing x
REAL, DIMENSION(:,:), INTENT(INOUT) :: pz0effjp! roughness length for increasing y
REAL, DIMENSION(:,:), INTENT(INOUT) :: pz0effjm! roughness length for decreasing y
!
TYPE(date_time), DIMENSION(:,:), INTENT(INOUT) :: tpseed   ! seeding date
TYPE(date_time), DIMENSION(:,:), INTENT(INOUT) :: tpreap   ! seeding date
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: pwatsup  ! water supply during irrigation
REAL, DIMENSION(:,:), INTENT(INOUT) :: pirrig   ! irrigated fraction
!
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  ! decade of simulation
REAL(KIND=JPRB) :: zhook_handle
!-----------------------------------------------------------------
!
!*      2.     Non-interactive vegetation
!              --------------------------
!
!*      2.1    Decade
!              ------
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE',0,zhook_handle)
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 (oecoclimap .OR. hsftype=='NAT') THEN
!* new year ? --> recomputes data LAI and derivated parameters (usefull in case of ecoclimap2)
      CALL update_data_cover(dtco, dti, ig, i, &
                             ttime%TDATE%YEAR)  
      IF (hsftype=='NAT') CALL init_isba_mixpar(dtco, dti, ig, i, &
                                                hisba,idecade,idecade2,pcover,ocover,hphoto,hsftype)
      CALL convert_patch_isba(dtco, dti, i, &
                              hisba,idecade,idecade2,pcover,ocover,&
                           hphoto,oagrip,.false.,otr_ml,hsftype, &
                           pveg=pveg,plai=plai,prsmin=prsmin,    &
                           pgamma=pgamma, pwrmax_cf=pwrmax_cf,   &
                           prgl=prgl,pcv=pcv,pz0=pz0,            &
                           palbnir_veg=palbnir_veg,              &
                           palbvis_veg=palbvis_veg,              &
                           palbuv_veg=palbuv_veg,                &
                           pemis_eco=pemis,pgmes=pgmes,          &
                           pbslai=pbslai,                        &
                           plaimin=plaimin,psefold=psefold,      &
                           pgc=pgc,pf2i=pf2i,                    &
                           ostress=ostress,pce_nitro=pce_nitro,  &
                           pcf_nitro=pcf_nitro,                  &
                           pcna_nitro=pcna_nitro,                &
                           tpseed=tpseed, tpreap=tpreap,         &
                           pwatsup=pwatsup,pirrig=pirrig,        &
                           pgndlitter=pgndlitter,                &
                           prglgv=prglgv,pgammagv=pgammagv,      &
                           prsmingv=prsmingv,                    &
                           pwrmax_cfgv=pwrmax_cfgv,              &
                           plaigv=plaigv,pz0litter=pz0litter,    &
                           ph_veg=ph_veg                         )
      IF ( halbedo=='CM13') THEN
        CALL convert_patch_isba(dtco, dti, i, &
                              hisba,idecade,idecade2,pcover,ocover,&
                              hphoto,oagrip,.false.,otr_ml,hsftype, &
                              palbnir_soil=palbnir_soil, &
                              palbvis_soil=palbvis_soil, &
                              palbuv_soil=palbuv_soil )
      ENDIF
    ELSEIF (hsftype=='GRD') THEN
      CALL init_from_data_grdn_n(dtgd, &
                                 idecade,hphoto,                                      &
                       pveg=pveg(:,1),plai=plai(:,1),pz0=pz0(:,1),pemis=pemis(:,1)    )  
     
    ELSEIF (hsftype=='GNR') THEN
      CALL init_from_data_greenroof_n(dtgr, tgro, &
                                      idecade,hphoto,                                 &
                       pveg=pveg(:,1),plai=plai(:,1),pz0=pz0(:,1),pemis=pemis(:,1)    )  

    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)) THEN
        WHERE (oabsent(:))
          pveg(:,1) = 0.
          plai(:,1) = 0.
          prsmin(:,1) = 40.
          pgamma(:,1) = 0.
          pwrmax_cf(:,1) = 0.2
          prgl(:,1) = 100.
          pcv(:,1) = 2.e-5
          pz0(:,1) = 0.013
          palbnir_veg(:,1) = 0.30
          palbvis_veg(:,1) = 0.30
          palbuv_veg(:,1) = 0.06
          pemis(:,1) = 0.94                
        END WHERE
        IF (hphoto/='NON') THEN
          WHERE (oabsent(:))
            pgmes(:,1) = 0.020
            pbslai(:,1) = 0.36
            plaimin(:,1) = 0.3
            psefold(:,1) = 90*86400.
            pgc(:,1) = 0.00025                  
          END WHERE
          IF (hphoto/='AGS' .AND. hphoto/='LAI') THEN
            WHERE (oabsent(:)) pf2i(:,1) = 0.3
            IF (hphoto=='NIT' .OR. hphoto=='NCB') THEN
              WHERE (oabsent(:))
                pce_nitro(:,1) = 7.68
                pcf_nitro(:,1) = -4.33
                pcna_nitro(:,1) = 1.3                      
              END WHERE
            ENDIF
          ENDIF
        ENDIF
    ENDIF

    IF (hsftype=='NAT') THEN
!* albedo
      CALL albedo(halbedo,                                 &
                  palbvis_veg,palbnir_veg,palbuv_veg,pveg,   &
                  palbvis_soil,palbnir_soil,palbuv_soil,     &
                  palbvis ,palbnir, palbuv                   )  
!
!* effective roughness length
      CALL subscale_z0eff(paosip,paosim,paosjp,paosjm,       &
                          pho2ip,pho2im,pho2jp,pho2jm,pz0,     &
                          pz0effip,pz0effim,pz0effjp,pz0effjm  )  
    ENDIF

  END IF
IF (lhook) CALL dr_hook('VEGETATION_UPDATE',1,zhook_handle)
!
!*      2.3    Prescribed vegetation
!              ---------------------
!
!-----------------------------------------------------------------
!
END SUBROUTINE vegetation_update