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, GDO, GDK, DTGD, GDIR, &
                              GRO, GRS, GRK, DTGR, TOP, KDIM, 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
!!    B. Decharme     08/16 : soil grdi optimization key
!!
!----------------------------------------------------------------------------
!
!*    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_sso_n, ONLY : sso_t
!
USE modd_teb_option_n, ONLY : teb_options_t
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_k_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_teb_irrig_n, ONLY : teb_irrig_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(sso_t), INTENT(INOUT) :: USS
TYPE(isba_options_t), INTENT(INOUT) :: GDO
TYPE(isba_k_t), INTENT(INOUT) :: GDK
TYPE(data_isba_t), INTENT(INOUT) :: DTGD
TYPE(teb_irrig_t), INTENT(INOUT) :: GDIR
TYPE(isba_options_t), INTENT(INOUT) :: GRO
TYPE(isba_s_t), INTENT(INOUT) :: GRS
TYPE(isba_k_t), INTENT(INOUT) :: GRK
TYPE(data_isba_t), INTENT(INOUT) :: DTGR
TYPE(teb_options_t), INTENT(INOUT) :: TOP
!
INTEGER, INTENT(IN) :: KDIM
!
 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
 CHARACTER(LEN=4)         :: YALBEDO
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=6)         :: YSOCFILETYPE  ! organic carbon data file type
 CHARACTER(LEN=6)         :: YPERMFILETYPE ! permafrost 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
LOGICAL                  :: LIMP_SOC      ! Imposed maps of organic carbon
LOGICAL                  :: LIMP_PERM     ! Imposed maps of permafrost distribution
LOGICAL                  :: GMEB          ! Multi-energy balance (MEB)
 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)
!
!-------------------------------------R-----------------------------------------
!
!*    1.      Reading of namelist NAM_ISBA for general options of vegetation
!             --------------------------------------------------------------
!
 CALL read_nam_pgd_isba(hprogram, ipatch, iground_layer,                         &
                       yisba, ypedotf, yphoto,  gtr_ml, yalbedo, 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,       & 
                       yrunoffb, yrunoffbfiletype, xunif_runoffb,               &
                       ywdrain,  ywdrainfiletype , xunif_wdrain, zsoilgrid,     &
                       yph, yphfiletype, xunif_ph, yfert, yfertfiletype,        &
                       xunif_fert                                               )  
!
gdo%NPATCH = 1
gdo%NGROUND_LAYER = iground_layer
gdo%CISBA         = yisba
gdo%CPEDOTF       = ypedotf
gdo%CPHOTO        = yphoto
gdo%LTR_ML        = gtr_ml
gdo%CALBEDO       = yalbedo
!
!-------------------------------------------------------------------------------
!
!*    2.      Coherence of options
!             --------------------
!
  CALL test_nam_var_surf(iluout,'CISBA',gdo%CISBA,'2-L','3-L','DIF')
  CALL test_nam_var_surf(iluout,'CPEDOTF',gdo%CPEDOTF,'CH78','CO84')
  CALL test_nam_var_surf(iluout,'CPHOTO',gdo%CPHOTO,'NON','AST','NIT','NCB')
  !
  IF (gdo%CPHOTO=='NCB') THEN
    gdo%CPHOTO = 'NIT'
    WRITE(iluout,*) '****************************************************************'
    WRITE(iluout,*) '* FOR GARDENS, AGS OPTION HAS BEEN CHANGED FROM "NCB" TO "NIT" *'
    WRITE(iluout,*) '****************************************************************'
  END IF
!
  SELECT CASE (gdo%CISBA)
    CASE ('2-L')
      gdo%NGROUND_LAYER = 2
      gdo%CPEDOTF       ='CH78'       
      WRITE(iluout,*) '*****************************************'
      WRITE(iluout,*) '* With option CISBA = ',gdo%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')
      gdo%NGROUND_LAYER = 3
      gdo%CPEDOTF       ='CH78'         
      WRITE(iluout,*) '*****************************************'
      WRITE(iluout,*) '* With option CISBA = ',gdo%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(gdo%NGROUND_LAYER==nundef)THEN
        IF(top%LECOCLIMAP)THEN
          gdo%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(gdo%XSOILGRID(gdo%NGROUND_LAYER))
      gdo%XSOILGRID(:)=xundef
      gdo%XSOILGRID(:)=zsoilgrid(1:gdo%NGROUND_LAYER) 
      IF(all(zsoilgrid(:)==xundef))THEN
        IF(top%LECOCLIMAP) &
                gdo%XSOILGRID(1:gdo%NGROUND_LAYER)=xoptimgrid(1:gdo%NGROUND_LAYER)
      ELSEIF(count(gdo%XSOILGRID/=xundef)/=gdo%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            = ',gdo%CISBA
      WRITE(iluout,*) '* Pedo transfert function = ',gdo%CPEDOTF    
      WRITE(iluout,*) '* Number of soil layers   = ',gdo%NGROUND_LAYER
      IF(top%LECOCLIMAP)THEN
        WRITE(iluout,*) '* Soil layers grid (m)    = ',gdo%XSOILGRID(1:gdo%NGROUND_LAYER)
      ENDIF
      WRITE(iluout,*) '*****************************************' 

  END SELECT
!
  SELECT CASE (gdo%CPHOTO)
    CASE ('AST')
      gdo%NNBIOMASS = 1
    CASE ('NIT')
      gdo%NNBIOMASS = 3
  END SELECT
  WRITE(iluout,*) '*****************************************'
  WRITE(iluout,*) '* With option CPHOTO = ',gdo%CPHOTO,'               *'
  WRITE(iluout,*) '* the number of biomass pools is set to ', gdo%NNBIOMASS
  WRITE(iluout,*) '*****************************************'
!
!-------------------------------------------------------------------------------
!
!*    3.      Sand fraction
!             -------------
!
ALLOCATE(gdk%XSAND(kdim,gdo%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,gdk%XSAND(:,1))
ENDIF
!
DO jlayer=1,gdo%NGROUND_LAYER
  gdk%XSAND(:,jlayer) = gdk%XSAND(:,1)
END DO
!-------------------------------------------------------------------------------
!
!*    4.      Clay fraction
!             -------------
!
ALLOCATE(gdk%XCLAY(kdim,gdo%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,gdk%XCLAY(:,1))
ENDIF
!
DO jlayer=1,gdo%NGROUND_LAYER
  gdk%XCLAY(:,jlayer) = gdk%XCLAY(:,1)
END DO
!-------------------------------------------------------------------------------
!
!*    5.      Subgrid runoff 
!             --------------
!
ALLOCATE(gdk%XRUNOFFB(kdim))
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'subgrid runoff','TWN',yrunoffb,yrunoffbfiletype,xunif_runoffb,gdk%XRUNOFFB(:))
!
!-------------------------------------------------------------------------------
!
!*    6.      Drainage coefficient
!             --------------------
!
ALLOCATE(gdk%XWDRAIN(kdim))
 CALL pgd_field(dtco, ug, u, uss, &
                hprogram,'subgrid drainage','TWN',ywdrain,ywdrainfiletype,xunif_wdrain,gdk%XWDRAIN(:))
!
!-------------------------------------------------------------------------------
!
!*    7.      Interpolation of GARDEN physiographic fields
!             --------------------------------------------
!
dtgd%NTIME = 12
 CALL pgd_teb_garden_par(dtco, ug, u, uss, kdim, gdo, dtgd, hprogram)
!
!-------------------------------------------------------------------------------
!
!*    8.      Case of greenroofs
!             ------------------
!
IF (top%LGREENROOF) CALL pgd_teb_greenroof(dtco, ug, u, uss, gro, grs, grk, dtgr, kdim, hprogram)
!
!-------------------------------------------------------------------------------
!
!*    9.      Irrigation of gardens and greenroofs
!             ------------------------------------
!
 CALL pgd_teb_irrig(dtco, ug, u, uss, kdim, gdir, 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