pgd_teb_veg.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 pgd_teb_veg (DTCO, UG, U, USS, GDM, GRM, TOP, TG, &
                              hprogram)
!     ##############################################################
!
!!**** *PGD_TEB_VEG* monitor for averaging and interpolations of physiographic fields
!!                   for natural covers of TEB
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    03/2010
!!
!!    J.Escobar   11/2013   Add USE MODI_PGD_TEB_GREENROOF
!!    V. Masson   04/2014   Adds Irrigation
!!    P. Samuelsson 02/2014 Introduced dummy variable in call to READ_NAM_PGD_ISBA for MEB
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
!
USE modd_surfex_n, ONLY : teb_garden_model_t
USE modd_surfex_n, ONLY : teb_greenroof_model_t
!
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_teb_grid_n, ONLY : teb_grid_t
!
USE modd_pgd_grid,          ONLY : nl
USE modd_data_cover_par,    ONLY : nvegtype
!
USE modd_surf_par,       ONLY : xundef, nundef
USE modd_isba_par,       ONLY : noptimlayer, xoptimgrid
!
USE modi_get_luout
USE modi_read_nam_pgd_isba
USE modi_pgd_field
USE modi_test_nam_var_surf
!
USE modi_pgd_teb_greenroof
USE modi_pgd_teb_garden_par
USE modi_pgd_teb_irrig
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(teb_grid_t), INTENT(INOUT) :: tg
!
 CHARACTER(LEN=6), INTENT(IN)  :: hprogram   ! Type of program
!                                           ! F if all parameters must be specified
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                  :: iluout    ! output listing logical unit
INTEGER                  :: jlayer    ! loop counter
!
!*    0.3    Declaration of namelists
!            ------------------------
!
INTEGER                  :: ipatch           ! number of patches
INTEGER                  :: iground_layer    ! number of soil layers
 CHARACTER(LEN=3)         :: yisba            ! ISBA option
 CHARACTER(LEN=4)         :: ypedotf          ! Pedo-transfert function for DIF
 CHARACTER(LEN=3)         :: yphoto           ! photosynthesis option
LOGICAL                  :: gtr_ml           ! new radiative transfert
REAL                     :: zrm_patch        ! threshold to remove little fractions of patches
 CHARACTER(LEN=28)        :: ysand            ! file name for sand fraction
 CHARACTER(LEN=28)        :: yclay            ! file name for clay fraction
 CHARACTER(LEN=28)        :: ycti             ! file name for topographic index
 CHARACTER(LEN=28)        :: yrunoffb         ! file name for runoffb parameter
 CHARACTER(LEN=28)        :: ywdrain          ! file name for wdrain parameter
 CHARACTER(LEN=6)         :: ysandfiletype    ! sand data file type
 CHARACTER(LEN=6)         :: yclayfiletype    ! clay data file type
 CHARACTER(LEN=6)         :: yctifiletype     ! topographic index data file type
 CHARACTER(LEN=6)         :: yrunoffbfiletype ! subgrid runoff data file type
 CHARACTER(LEN=6)         :: ywdrainfiletype  ! subgrid drainage data file type
REAL                     :: xunif_sand       ! uniform value of sand fraction
REAL                     :: xunif_clay       ! uniform value of clay fraction
REAL                     :: xunif_runoffb    ! uniform value of subgrid runoff coefficient
REAL                     :: xunif_wdrain     ! uniform subgrid drainage parameter
LOGICAL                  :: limp_sand        ! Imposed maps of Sand
LOGICAL                  :: limp_clay        ! Imposed maps of Clay
LOGICAL                  :: limp_cti         ! Imposed maps of topographic index statistics
REAL, DIMENSION(150)     :: zsoilgrid        ! Soil layer thickness for DIF
!
! Not used in TEB garden
!
 CHARACTER(LEN=28)        :: ysoc_top      ! file name for organic carbon
 CHARACTER(LEN=28)        :: ysoc_sub      ! file name for organic carbon
 CHARACTER(LEN=28)        :: yperm         ! file name for permafrost distribution
 CHARACTER(LEN=28)        :: ygw               ! file name for groundwater map
 CHARACTER(LEN=6)         :: ysocfiletype  ! organic carbon data file type
 CHARACTER(LEN=6)         :: ypermfiletype ! permafrost distribution data file type
 CHARACTER(LEN=6)         :: ygwfiletype      ! groundwater distribution data file type
REAL                     :: xunif_soc_top ! uniform value of organic carbon top soil (kg/m2)
REAL                     :: xunif_soc_sub ! uniform value of organic carbon sub soil (kg/m2)
REAL                     :: xunif_perm    ! uniform permafrost distribution
REAL                     :: xunif_gw         ! uniform groundwater distribution
LOGICAL                  :: limp_soc      ! Imposed maps of organic carbon
LOGICAL                  :: limp_perm     ! Imposed maps of permafrost distribution
LOGICAL                  :: gmeb          ! Multi-energy balance (MEB)
LOGICAL                  :: limp_gw          ! Imposed maps of groundwater distribution
 CHARACTER(LEN=28)        :: yph           ! file name for pH
 CHARACTER(LEN=28)        :: yfert         ! file name for fertilisation rate
 CHARACTER(LEN=6)         :: yphfiletype   ! pH data file type
 CHARACTER(LEN=6)         :: yfertfiletype ! fertilisation data file type
REAL                     :: xunif_ph      ! uniform value of pH
REAL                     :: xunif_fert    ! uniform value of fertilisation rate
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PGD_TEB_VEG',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
!*    1.      Reading of namelist NAM_ISBA for general options of vegetation
!             --------------------------------------------------------------
!
gdm%TGDO%NGROUND_LAYER = 0
gdm%TVG%CISBA         = '   '
gdm%TVG%CPEDOTF       = '   '
gdm%TVG%CPHOTO        = '   '
!
 CALL read_nam_pgd_isba(hprogram, ipatch, iground_layer,                         &
                       yisba, ypedotf, yphoto,  gtr_ml, zrm_patch,              &
                       yclay, yclayfiletype, xunif_clay, limp_clay,             &
                       ysand, ysandfiletype, xunif_sand, limp_sand,             &
                       ysoc_top, ysoc_sub, ysocfiletype, xunif_soc_top,         &
                       xunif_soc_sub, limp_soc, ycti, yctifiletype, limp_cti,   &
                       yperm, ypermfiletype, xunif_perm, limp_perm, gmeb,       &                     
                       ygw, ygwfiletype, xunif_gw, limp_gw,                     &                     
                       yrunoffb, yrunoffbfiletype, xunif_runoffb,               &
                       ywdrain,  ywdrainfiletype , xunif_wdrain, zsoilgrid,     &
                       yph, yphfiletype, xunif_ph, yfert, yfertfiletype,        &
                       xunif_fert                                               )  
!
gdm%TGDO%NGROUND_LAYER = iground_layer
gdm%TVG%CISBA         = yisba
gdm%TVG%CPEDOTF       = ypedotf
gdm%TVG%CPHOTO        = yphoto
gdm%TVG%LTR_ML        = gtr_ml
!
!-------------------------------------------------------------------------------
!
!*    2.      Coherence of options
!             --------------------
!
  CALL test_nam_var_surf(iluout,'CISBA',gdm%TVG%CISBA,'2-L','3-L','DIF')
  CALL test_nam_var_surf(iluout,'CPEDOTF',gdm%TVG%CPEDOTF,'CH78','CO84')
  CALL test_nam_var_surf(iluout,'CPHOTO',gdm%TVG%CPHOTO,'NON','AGS','LAI','AST','LST','NIT','NCB')
  !
  IF (gdm%TVG%CPHOTO=='NCB') THEN
    gdm%TVG%CPHOTO = 'NIT'
    WRITE(iluout,*) '****************************************************************'
    WRITE(iluout,*) '* FOR GARDENS, AGS OPTION HAS BEEN CHANGED FROM "NCB" TO "NIT" *'
    WRITE(iluout,*) '****************************************************************'
  END IF
!
  SELECT CASE (gdm%TVG%CISBA)
    CASE ('2-L')
      gdm%TGDO%NGROUND_LAYER = 2
      gdm%TVG%CPEDOTF       ='CH78'       
      WRITE(iluout,*) '*****************************************'
      WRITE(iluout,*) '* With option CISBA = ',gdm%TVG%CISBA,'         *'
      WRITE(iluout,*) '* the number of soil layers is set to 2 *'
      WRITE(iluout,*) '* theta(psi) function = Brook and Corey *'
      WRITE(iluout,*) '* Pedo transfert function = CH78        *'          
      WRITE(iluout,*) '*****************************************'
    CASE ('3-L')
      gdm%TGDO%NGROUND_LAYER = 3
      gdm%TVG%CPEDOTF       ='CH78'         
      WRITE(iluout,*) '*****************************************'
      WRITE(iluout,*) '* With option CISBA = ',gdm%TVG%CISBA,'         *'
      WRITE(iluout,*) '* the number of soil layers is set to 3 *'
      WRITE(iluout,*) '* theta(psi) function = Brook and Corey *'
      WRITE(iluout,*) '* Pedo transfert function = CH78        *'        
      WRITE(iluout,*) '*****************************************'
    CASE ('DIF')
      IF(gdm%TGDO%NGROUND_LAYER==nundef)THEN
        IF(top%LECOCLIMAP)THEN
          gdm%TGDO%NGROUND_LAYER=noptimlayer
        ELSE
          WRITE(iluout,*) '****************************************'
          WRITE(iluout,*) '* Number of ground layer not specified *'
          WRITE(iluout,*) '****************************************'
          CALL abor1_sfx('PGD_TEB_GARDEN: NGROUND_LAYER MUST BE DONE IN NAM_ISBA')
        ENDIF
      ENDIF
! 
      ALLOCATE(gdm%TGDO%XSOILGRID(gdm%TGDO%NGROUND_LAYER))
      gdm%TGDO%XSOILGRID(:)=xundef
      gdm%TGDO%XSOILGRID(:)=zsoilgrid(1:gdm%TGDO%NGROUND_LAYER) 
      IF(all(zsoilgrid(:)==xundef))THEN
        IF(top%LECOCLIMAP) &
                gdm%TGDO%XSOILGRID(1:gdm%TGDO%NGROUND_LAYER)=xoptimgrid(1:gdm%TGDO%NGROUND_LAYER)
      ELSEIF(count(gdm%TGDO%XSOILGRID/=xundef)/=gdm%TGDO%NGROUND_LAYER)THEN
        WRITE(iluout,*) '********************************************************'
        WRITE(iluout,*) '* Soil grid reference values /= number of ground layer *'
        WRITE(iluout,*) '********************************************************'
        CALL abor1_sfx('PGD_TEB_GARDEN: XSOILGRID must be coherent with NGROUND_LAYER in NAM_ISBA')            
      ENDIF
!
      WRITE(iluout,*) '*****************************************'
      WRITE(iluout,*) '* Option CISBA            = ',gdm%TVG%CISBA
      WRITE(iluout,*) '* Pedo transfert function = ',gdm%TVG%CPEDOTF    
      WRITE(iluout,*) '* Number of soil layers   = ',gdm%TGDO%NGROUND_LAYER
      IF(top%LECOCLIMAP)THEN
        WRITE(iluout,*) '* Soil layers grid (m)    = ',gdm%TGDO%XSOILGRID(1:gdm%TGDO%NGROUND_LAYER)
      ENDIF
      WRITE(iluout,*) '*****************************************' 

  END SELECT
!
  SELECT CASE (gdm%TVG%CPHOTO)
    CASE ('AGS','LAI','AST','LST')
      gdm%TVG%NNBIOMASS = 1
    CASE ('NIT')
      gdm%TVG%NNBIOMASS = 3
  END SELECT
  WRITE(iluout,*) '*****************************************'
  WRITE(iluout,*) '* With option CPHOTO = ',gdm%TVG%CPHOTO,'               *'
  WRITE(iluout,*) '* the number of biomass pools is set to ', gdm%TVG%NNBIOMASS
  WRITE(iluout,*) '*****************************************'
!
!-------------------------------------------------------------------------------
!
!*    3.      Sand fraction
!             -------------
!
ALLOCATE(gdm%TGDP%XSAND(tg%NDIM,gdm%TGDO%NGROUND_LAYER))
!
IF(limp_sand)THEN
!
  CALL abor1_sfx('PGD_TEB_VEG: LIMP_SAND IS NOT CONSISTENT WITH TEB_GARDEN')
!
ELSE
!
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'sand fraction','TWN',ysand,ysandfiletype,xunif_sand,gdm%TGDP%XSAND(:,1))
ENDIF
!
DO jlayer=1,gdm%TGDO%NGROUND_LAYER
  gdm%TGDP%XSAND(:,jlayer) = gdm%TGDP%XSAND(:,1)
END DO
!-------------------------------------------------------------------------------
!
!*    4.      Clay fraction
!             -------------
!
ALLOCATE(gdm%TGDP%XCLAY(tg%NDIM,gdm%TGDO%NGROUND_LAYER))
!
IF(limp_clay)THEN
!
  CALL abor1_sfx('PGD_TEB_VEG: LIMP_SAND IS NOT CONSISTENT WITH TEB_GARDEN')
!
ELSE
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'clay fraction','TWN',yclay,yclayfiletype,xunif_clay,gdm%TGDP%XCLAY(:,1))
ENDIF
!
DO jlayer=1,gdm%TGDO%NGROUND_LAYER
  gdm%TGDP%XCLAY(:,jlayer) = gdm%TGDP%XCLAY(:,1)
END DO
!-------------------------------------------------------------------------------
!
!*    5.      Subgrid runoff 
!             --------------
!
ALLOCATE(gdm%TGDP%XRUNOFFB(tg%NDIM))
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'subgrid runoff','TWN',yrunoffb,yrunoffbfiletype,xunif_runoffb,gdm%TGDP%XRUNOFFB(:))
!
!-------------------------------------------------------------------------------
!
!*    6.      Drainage coefficient
!             --------------------
!
ALLOCATE(gdm%TGDP%XWDRAIN(tg%NDIM))
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'subgrid drainage','TWN',ywdrain,ywdrainfiletype,xunif_wdrain,gdm%TGDP%XWDRAIN(:))
!
!-------------------------------------------------------------------------------
!
!*    7.      Interpolation of GARDEN physiographic fields
!             --------------------------------------------
!
gdm%DTGD%NTIME = 12
 CALL pgd_teb_garden_par(dtco, ug, u, uss, tg, gdm, &
                         hprogram)
!
!-------------------------------------------------------------------------------
!
!*    8.      Case of greenroofs
!             ------------------
!
IF (top%LGREENROOF) CALL pgd_teb_greenroof(dtco, ug, u, uss, grm, tg, &
                                           hprogram)
!
!-------------------------------------------------------------------------------
!
!*    9.      Irrigation of gardens and greenroofs
!             ------------------------------------
!
 CALL pgd_teb_irrig(dtco, ug, u, uss, tg, gdm%TIR, &
                   hprogram)
!
!-------------------------------------------------------------------------------
!
!*    9.      Case of urban hydrology
!             -----------------------
!
IF (top%LHYDRO) print*," CALL PGD_TEB_URBHYDRO(HPROGRAM,LECOCLIMAP)"
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PGD_TEB_GARDEN',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE pgd_teb_veg