greenroof.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 greenroof (DTCO, G, T, TOP, TIR, DTV, GB, DK, DEK, DMK, GRO, S, K, P, PEK,    &
                          HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF,  &
                          PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,       &
                          PTSTEP, PZREF, PUREF, PTA, PQA, PEXNS, PEXNA, PRHOA,      &
                          PCO2, PPS, PRR, PSR, PZENITH, PSW, PLW, PVMOD,            &
                          PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &                
                          PRN, PH, PLE, PGFLUX, PSFCO2, PEVAP, PUW, PRUNOFF, PDRAIN,&
                          PAC, PQSAT, PTSRAD, PAC_AGG, PHU_AGG, PDEEP_FLUX, PIRRIG )  
!   ##################################################################################
!
!!****  *GREENROOF*  
!!
!!    PURPOSE
!!    -------
!!
!!    call the vegetation scheme (ISBA) inside TEB for greenroofs
!!     
!!**  METHOD
!!     ------
!!    based on subroutine "garden" 
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!    Based on subroutine "garden"
!!      
!!    AUTHOR
!!    ------
!!
!!      C. de Munck & A. Lemonsu          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!     Original    09/2011 
!     C. de Munck   02/2013  irrigation (drip irrigation)
!     B. decharme 04/2013 : Variables required in TEB to allow coupling with AROME/ALADIN/ARPEGE
!                           phasing call isba
!                           calculation of vegetation CO2 flux
!                           dummy for water table / surface coupling
!!    P. Samuelsson  10/2014  Introduced dummy variables in call to ISBA for MEB
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_sfx_grid_n, ONLY : grid_t
USE modd_sso_n, ONLY : sso_t, sso_init
USE modd_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_teb_irrig_n, ONLY : teb_irrig_t
!
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_gr_biog_n, ONLY : gr_biog_t
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_k_t, isba_p_t, isba_pe_t
!
USE modd_agri_n, ONLY : agri_t, agri_init
!
USE modd_surf_par,             ONLY: xundef
USE modd_type_date_surf,       ONLY: date_time
USE modd_csts,                 ONLY: xcpd
!
USE modi_isba
USE modi_vegetation_update
USE modi_vegetation_evol
USE modi_carbon_evol
USE mode_thermos
USE modi_roof_impl_coef
USE modi_teb_irrig
USE modi_flag_teb_veg_n
!
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(grid_t), INTENT(INOUT) :: G
TYPE(teb_t), INTENT(INOUT) :: T
TYPE(teb_options_t), INTENT(INOUT) :: TOP
TYPE(teb_irrig_t), INTENT(INOUT) :: TIR
!
TYPE(data_isba_t), INTENT(INOUT) :: DTV
TYPE(gr_biog_t), INTENT(INOUT) :: GB
!
TYPE(diag_t), INTENT(INOUT) :: DK
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEK
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMK
!
TYPE(isba_options_t), INTENT(INOUT) :: GRO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(isba_p_t), INTENT(INOUT) :: P
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
 CHARACTER(LEN=*),     INTENT(IN)  :: HIMPLICIT_WIND   ! wind implicitation option
!                                                     ! 'OLD' = direct
!                                                     ! 'NEW' = Taylor serie, order 1
TYPE(date_time)     , INTENT(IN)    :: TPTIME             ! current date and time from teb
REAL, DIMENSION(:)  , INTENT(IN)    :: PTSUN              ! solar time      (s from midnight)
REAL, DIMENSION(:)  , INTENT(IN)    :: PPEW_A_COEF        ! implicit coefficients
REAL, DIMENSION(:)  , INTENT(IN)    :: PPEW_B_COEF        ! for wind coupling
REAL, DIMENSION(:)  , INTENT(IN)    :: PPEQ_A_COEF        ! implicit coefficients
REAL, DIMENSION(:)  , INTENT(IN)    :: PPEQ_B_COEF        ! for humidity
REAL, DIMENSION(:)  , INTENT(IN)    :: PPET_A_COEF        ! implicit coefficients
REAL, DIMENSION(:)  , INTENT(IN)    :: PPET_B_COEF        ! for temperature
REAL                , INTENT(IN)    :: PTSTEP             ! time step
REAL, DIMENSION(:)  , INTENT(IN)    :: PZREF              ! height of the first atmospheric level
REAL, DIMENSION(:)  , INTENT(IN)    :: PUREF              ! reference height for the wind
REAL, DIMENSION(:)  , INTENT(IN)    :: PTA                ! temperature at first atm. level 
REAL, DIMENSION(:)  , INTENT(IN)    :: PQA                ! specific humidity at first atm. level
REAL, DIMENSION(:)  , INTENT(IN)    :: PPS                ! pressure at the surface
REAL, DIMENSION(:)  , INTENT(IN)    :: PEXNA              ! Exner function at first atm. level
REAL, DIMENSION(:)  , INTENT(IN)    :: PEXNS              ! surface Exner function
REAL, DIMENSION(:)  , INTENT(IN)    :: PRHOA              ! air density at the lowest level
REAL, DIMENSION(:)  , INTENT(IN)    :: PCO2               ! CO2 concentration in the air    (kg/m3)
REAL, DIMENSION(:)  , INTENT(IN)    :: PRR                ! rain rate
REAL, DIMENSION(:)  , INTENT(IN)    :: PSR                ! snow rate
REAL, DIMENSION(:)  , INTENT(IN)    :: PZENITH            ! solar zenithal angle
REAL, DIMENSION(:)  , INTENT(IN)    :: PSW                ! incoming total solar rad on an horizontal surface
REAL, DIMENSION(:)  , INTENT(IN)    :: PLW                ! atmospheric infrared radiation
REAL, DIMENSION(:)  , INTENT(IN)    :: PVMOD              ! module of horizontal wind near first atm. level
REAL, DIMENSION(:)  , INTENT(IN)    :: PALBNIR_TVEG       ! nearIR  veg tot albedo
REAL, DIMENSION(:)  , INTENT(IN)    :: PALBVIS_TVEG       ! visible veg tot albedo
REAL, DIMENSION(:)  , INTENT(IN)    :: PALBNIR_TSOIL      ! nearIR  soil tot albedo
REAL, DIMENSION(:)  , INTENT(IN)    :: PALBVIS_TSOIL      ! visible soil tot albedo
!
REAL, DIMENSION(:)  , INTENT(OUT)   :: PRN         ! net radiation over greenroofs
REAL, DIMENSION(:)  , INTENT(OUT)   :: PH          ! sensible heat flux over greenroofs
REAL, DIMENSION(:)  , INTENT(OUT)   :: PLE         ! latent heat flux over greenroofs
REAL, DIMENSION(:)  , INTENT(OUT)   :: PGFLUX      ! flux through the greenroofs
REAL, DIMENSION(:)  , INTENT(OUT)   :: PSFCO2      ! flux of greenroof CO2       (m/s*kg_CO2/kg_air)
REAL, DIMENSION(:)  , INTENT(OUT)   :: PEVAP       ! total evaporation over greenroofs (kg/m2/s)
REAL, DIMENSION(:)  , INTENT(OUT)   :: PUW         ! friction flux (m2/s2)
REAL, DIMENSION(:)  , INTENT(OUT)   :: PRUNOFF     ! greenroof surface runoff
REAL, DIMENSION(:)  , INTENT(OUT)   :: PDRAIN      ! greenroof surface drainage
REAL, DIMENSION(:)  , INTENT(OUT)   :: PAC         ! greenroof aerodynamical conductance
REAL, DIMENSION(:)  , INTENT(OUT)   :: PQSAT       ! saturation humidity
REAL, DIMENSION(:)  , INTENT(OUT)   :: PTSRAD      ! greenroof radiative surface temp. (snow free)
REAL, DIMENSION(:)  , INTENT(OUT)   :: PAC_AGG     ! aggreg. aeodynamic resistance for greenroofs for latent heat flux
REAL, DIMENSION(:)  , INTENT(OUT)   :: PHU_AGG     ! aggreg. relative humidity for greenroofs for latent heat flux
REAL, DIMENSION(:)  , INTENT(OUT)   :: PDEEP_FLUX  ! Heat Flux at the bottom layer of the greenroof
REAL, DIMENSION(:)  , INTENT(OUT)   :: PIRRIG      ! greenroof summer irrigation rate
!
!
!*      0.2    Declarations of local variables
!
TYPE(sso_t) :: YSS
TYPE(agri_t) :: YAG
!
REAL, DIMENSION(SIZE(PPS)) :: ZDIRCOSZW           ! orography slope cosine (=1 in TEB)
REAL, DIMENSION(SIZE(PPS),GRO%NNBIOMASS) :: ZRESP_BIOMASS_INST       ! instantaneous biomass respiration (kgCO2/kgair m/s)
REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR
!
!  temperatures
!
REAL, DIMENSION(SIZE(PPS)) :: ZTA ! estimate of air temperature at future time
!                                 ! step as if modified by ISBA flux alone.
!
!  surfaces relative fractions
!  for flood
REAL, DIMENSION(SIZE(PPS)) :: ZEMISF
!
!  variables for deep soil temperature
REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_A
!
! Dummy variables for MEB:
REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, ZPALPHAN, ZZ0G_WITHOUT_SNOW, &
                              ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
                              ZZ0H_MEBN, ZZ0EFF_MEBN
!
!
INTEGER                    :: ILU
LOGICAL :: GUPDATED, GALB
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!*      1.     various initialisations
!              -----------------------
!
IF (lhook) CALL dr_hook('GREENROOF',0,zhook_handle)
ilu = SIZE(pps)
!
zdircoszw = 1.
!
 CALL sso_init(yss)
!
 CALL agri_init(yag)
!
!* automatic summer irrigation 
!
pirrig(:) = 0.
!
!* deep soil implicitation with roof
!
 CALL roof_impl_coef(t, ptstep, ztdeep_a, k%XTDEEP)
!
!-------------------------------------------------------------------------------
!
!*      9.     Treatment of green areas
!              ------------------------
!
!radiative temperature diagnostic
!-------------------------------
!
!*      9.1    Summer irrigation 
!              ------------------
!
!* irrigation automatique de type goutte à goutte (arrosage du sol seulement)
!
 CALL teb_irrig(tir%LPAR_GR_IRRIG, ptstep, tptime%TDATE%MONTH, ptsun,         &
               tir%XGR_START_MONTH, tir%XGR_END_MONTH, tir%XGR_START_HOUR,   &
               tir%XGR_END_HOUR, tir%XGR_24H_IRRIG, pirrig     )
!
! --------------------------------------------------------------------------------------
! Vegetation update (in case of non-interactive vegetation):
! --------------------------------------------------------------------------------------
!
s%TTIME = tptime
!
gupdated=.false.
galb = .false. 
IF (gro%CPHOTO=='NIT'.OR.gro%CPHOTO=='NCB') galb = .true.
!
  CALL vegetation_update(dtco, dtv, g%NDIM, gro, k, p, pek, 1,              &
                         ptstep, s%TTIME, top%XCOVER, top%LCOVER,  .false., &
                         'GNR', galb, yss, gupdated, oabsent=(t%XGREENROOF==0.)  )
!
!*      9.2    Call ISBA for greenroofs
!              ------------------------
!
dk%XZ0(:) = pek%XZ0(:)
dk%XZ0H(:) = pek%XZ0(:) / p%XZ0_O_Z0H(:)
!
dk%XZ0EFF(:) =  pek%XZ0(:)
!
ALLOCATE(gb%XIACAN(SIZE(pps),SIZE(s%XABC)))
!
 CALL isba(gro, k, p, pek, g, yag, dk, dek, dmk,                                  &
           tptime, s%XPOI, s%XABC, gb%XIACAN, .false., ptstep,                    &
           himplicit_wind, pzref, puref, zdircoszw, pta, pqa, pexna, prhoa, pps,  &
           pexns, prr, psr, pzenith, zp_meb_sca_sw, psw, plw, pvmod, ppew_a_coef, &
           ppew_b_coef, ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef,       &
           palbnir_tveg, palbvis_tveg, palbnir_tsoil, palbvis_tsoil, zpalphan,    &
           zz0g_without_snow, zz0_mebv, zz0h_mebv, zz0eff_mebv, zz0_mebn,         &
           zz0h_mebn, zz0eff_mebn, ztdeep_a, pco2, k%XFFG(:), k%XFFV(:),          &
           zemisf, zustar, pac_agg, phu_agg, zresp_biomass_inst, pdeep_flux, pirrig )
!
IF (pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') pek%TSNOW%TS(:) = dmk%XSNOWTEMP(:,1)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Diagnostic of respiration carbon fluxes and soil carbon evolution
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Vegetation evolution for interactive LAI
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!
IF (gro%CPHOTO=='NIT') THEN
  CALL vegetation_evol(gro, dtv, p, pek, .false., ptstep, tptime%TDATE%MONTH, tptime%TDATE%DAY,     &
                       tptime%TIME, g%XLAT, prhoa, pco2, yss, zresp_biomass_inst )          
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
psfco2(:) = 0.
dek%XRESP_ECO (:) = 0.
dek%XRESP_AUTO(:) = 0.
!
IF (gro%CPHOTO/='NON' .AND. gro%CRESPSL/='NON' .AND. any(pek%XLAI(:)/=xundef)) THEN
  ! faire intervenir le type de vegetation du greenroof ? (CTYP_GR)
  CALL carbon_evol(gro, k, p, pek, dek, ptstep, prhoa, zresp_biomass_inst  )
  ! calculation of vegetation CO2 flux
  ! Positive toward the atmosphere
  psfco2(:) = dek%XRESP_ECO(:) - dek%XGPP(:)
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!*      4.     Set undefined values for points where there is no garden
!              --------------------------------------------------------
!
! This way, these points are clearly flaged, and one will not try to interpret
! the values for those points
!
 CALL flag_teb_veg_n(pek, gro, t%XGREENROOF, 2)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!*      9.     Fields required for TEB
!              -----------------------
!
WHERE (t%XGREENROOF/=0.)
  !
  ! energy balance
  !
  dk%XLE(:) = pek%XLE(:)
  !
  ! Estimate of green area aerodynamic conductance recomputed from heat flux,
  ! surface (radiative) temp. and forcing air temperature (estimated at future time step)
  zta = ppet_b_coef + ppet_a_coef * dk%XH
  pac = 0.
  WHERE (dk%XTSRAD /= zta)
    pac(:)   = max(dk%XH(:) / xcpd / prhoa(:) / (dk%XTSRAD - zta) , 0.)
  ENDWHERE
  !
  ! Humidity of saturation for green areas
  pqsat(:) = qsat(pek%XTG(:,1),pps(:))
  !
  !* friction flux
  puw(:)    = -zustar(:)**2
  !
ELSEWHERE
  !
  dk%XRN    (:) = xundef
  dk%XH     (:) = xundef
  dk%XLE    (:) = xundef
  dk%XGFLUX (:) = xundef
  dk%XEVAP  (:) = xundef
  !
  pac(:) = xundef
  pqsat(:) = xundef
  puw(:) = xundef  
  !
END WHERE
!
!
ptsrad(:) = dk%XTSRAD(:)
!
prn(:) = dk%XRN     (:) 
ph(:) = dk%XH      (:) 
ple(:) = dk%XLE     (:) 
pgflux(:) = dk%XGFLUX  (:) 
pevap(:) = dk%XEVAP   (:) 
prunoff(:) =dek%XRUNOFF(:)
pdrain(:) =dek%XDRAIN (:)
!
IF (lhook) CALL dr_hook('GREENROOF',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE greenroof