albedo_veg_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 albedo_veg_update (DTCO, DTI, IG, I, &
                                  ptstep,ttime,pcover,ocover,          &
                       hisba,oecoclimap,hphoto,oagrip,otr_ml,hsftype, &
                       pveg,palbnir,palbvis,palbuv,                   &
                       halbedo, palbnir_veg, palbvis_veg, palbuv_veg, &
                       palbnir_soil, palbvis_soil, palbuv_soil        )  
!   ###############################################################
!!****  *ALBEDO_VEG_UPDATE*
!!
!!    PURPOSE
!!    -------
!
!     performs the time evolution of albedo for vegetation and soil
!     at UTC midnight, with effective change each ten days
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      B. Decharme          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    02/02/13 
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_t
!
USE modd_type_date_surf
!
USE modi_init_isba_mixpar
USE modi_convert_patch_isba
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(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
!
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) :: pveg    ! vegetation fraction
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
!
 CHARACTER(LEN=4),     INTENT(IN)    :: halbedo ! albedo type
!                                              ! 'CM13' 
!                                              ! '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 !
!
!*      0.2    declarations of local variables
!
INTEGER                                  :: idecade, idecade2  ! decade of simulation
REAL(KIND=JPRB) :: zhook_handle
!-----------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ALBEDO_VEG_UPDATE',0,zhook_handle)
!
idecade = 3 * ( ttime%TDATE%MONTH - 1 ) + min(ttime%TDATE%DAY-1,29) / 10 + 1
idecade2 = idecade
!
IF ( mod(min(ttime%TDATE%DAY,30),10)==1 .AND. ttime%TIME - ptstep < 0.) THEN
    CALL update_data_cover(dtco, dti, ig, i, &
                           ttime%TDATE%YEAR)  
    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, &
                           palbnir_veg=palbnir_veg,              &
                           palbvis_veg=palbvis_veg,              &
                           palbuv_veg=palbuv_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                   
    CALL albedo(halbedo,                                   &
                palbvis_veg,palbnir_veg,palbuv_veg,pveg,   &
                palbvis_soil,palbnir_soil,palbuv_soil,     &
                palbvis ,palbnir, palbuv                   )  

END IF
!
IF (lhook) CALL dr_hook('ALBEDO_VEG_UPDATE',1,zhook_handle)
!
!-----------------------------------------------------------------
!
END SUBROUTINE albedo_veg_update