init_teb_veg_optionsn.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 init_teb_veg_options_n (CHT, OSURF_DIAG_ALBEDO, OGREENROOF, GDO, GRO, HPROGRAM)
!#############################################################
!
!!****  *INIT_TEB_TEB_VEG_n* - routine to initialize ISBA
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!!      B. Decharme 07/2011 : read pgd+prep
!!      B. Decharme 04/2013 : delete CTOPREG option (never used)
!!                            water table / surface coupling
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_ch_teb_n, ONLY : ch_teb_t
USE modd_isba_options_n, ONLY : isba_options_t
!
USE modd_read_namelist,   ONLY : lnam_read
!
USE modd_type_date_surf
USE modd_type_snow
!
!


USE modd_data_cover_par,  ONLY: nvegtype
USE modd_surf_par,        ONLY: xundef, nundef
!
USE modd_isba_par,        ONLY : xoptimgrid
!
USE modn_teb_n,           ONLY : xtstep
!
USE modi_read_nam_pgd_isba
USE modi_default_isba
USE modi_default_ch_dep
USE modi_default_ch_bio_flux
USE modi_default_crocus
USE modi_read_default_teb_veg_n
USE modi_read_teb_veg_conf_n
USE modi_get_luout
USE modi_read_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
!
TYPE(ch_teb_t), INTENT(INOUT) :: CHT
LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
LOGICAL, INTENT(IN) :: OGREENROOF 
TYPE(isba_options_t), INTENT(INOUT) :: GDO
TYPE(isba_options_t), INTENT(INOUT) :: GRO
!
 CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: IVERSION, IBUGFIX  ! surface version
INTEGER           :: ILUOUT   ! unit of output listing file
INTEGER           :: IRESP    ! Error code after redding
 CHARACTER(LEN=12) :: YRECFM   ! Name of the article to be read
 CHARACTER(LEN=4 ) :: YLVL
!
INTEGER :: JLAYER ! loop counter on layers
!
REAL                              :: ZOUT_TSTEP
 CHARACTER(LEN=3)                  :: YRAIN 
LOGICAL                           :: GCANOPY_DRAG
LOGICAL                           :: GGLACIER
LOGICAL                           :: GFLOOD
LOGICAL                           :: GWTD
LOGICAL                           :: GVEGUPD
LOGICAL                           :: GSPINUPCARBS
LOGICAL                           :: GSPINUPCARBW
REAL                              :: ZSPINMAXS
REAL                              :: ZSPINMAXW
REAL                              :: ZCO2_START
REAL                              :: ZCO2_END
INTEGER                           :: INBYEARSPINS
INTEGER                           :: INBYEARSPINW
!
INTEGER                  :: IPATCH           ! number of patches
INTEGER                  :: IGROUND_LAYER    ! number of soil layers
INTEGER                  :: JVEGTYPE
 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)        :: YSOC_TOP         ! file name for organic carbon top soil
 CHARACTER(LEN=28)        :: YSOC_SUB         ! file name for organic carbon sub soil
 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=28)        :: YPERM            ! file name for permafrost distribution
 CHARACTER(LEN=6)         :: YSANDFILETYPE    ! sand data file type
 CHARACTER(LEN=6)         :: YCLAYFILETYPE    ! clay data file type
 CHARACTER(LEN=6)         :: YSOCFILETYPE     ! organic carbon 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
 CHARACTER(LEN=6)         :: YPERMFILETYPE    ! permafrost distribution data file type
REAL                     :: XUNIF_SAND       ! uniform value of sand fraction  (-)
REAL                     :: XUNIF_CLAY       ! uniform value of clay fraction  (-)
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_RUNOFFB    ! uniform value of subgrid runoff coefficient
REAL                     :: XUNIF_WDRAIN     ! uniform subgrid drainage parameter
REAL                     :: XUNIF_PERM       ! uniform permafrost distribution
LOGICAL                  :: LIMP_SAND        ! Imposed maps of Sand
LOGICAL                  :: LIMP_CLAY        ! Imposed maps of Clay
LOGICAL                  :: LIMP_SOC         ! Imposed maps of organic carbon
LOGICAL                  :: LIMP_CTI         ! Imposed maps of topographic index statistics
LOGICAL                  :: LIMP_PERM        ! Imposed maps of permafrost distribution
REAL, DIMENSION(150)     :: ZSOILGRID        ! Soil grid reference for DIF
 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
LOGICAL                  :: GMEB      ! Multi-energy balance (MEB)
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_TEB_VEG_OPTIONS_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!               Other little things
!
osurf_diag_albedo = .false.
!
IF (lnam_read) THEN
 !
 !*       1.     Defaults
 !               --------
 !
 !        1.1. Hard defaults
 !      
 !       Definition of default options for ISBA (in MODD_TEB_VEG_n)
 !       REM - TSTEP, OUT_TSTEP, CANOPY_DRAG are defined as local variables
 !             because they are already in init_teb.f90 (these options are 
 !             forced to the same values for TEB and urban green areas)
 !
 CALL default_isba(gdo%XTSTEP, gdo%XOUT_TSTEP, gdo%CRUNOFF, &
                   gdo%CSCOND, gdo%CC1DRY, gdo%CSOILFRZ,   &
                   gdo%CDIFSFCOND, gdo%CSNOWRES, gdo%CCPSURF, gdo%XCGMAX, &
                   gdo%XCDRAG, gdo%CKSAT, gdo%LSOC, gdo%CRAIN, gdo%CHORT, &
                   gdo%LGLACIER, gdo%LCANOPY_DRAG, gdo%LVEGUPD, gdo%LSPINUPCARBS, &
                   gdo%LSPINUPCARBW, gdo%XSPINMAXS, gdo%XSPINMAXW, gdo%XCO2_START,&
                   gdo%XCO2_END, gdo%NNBYEARSPINS, gdo%NNBYEARSPINW, gdo%LNITRO_DILU )
 !
 CALL default_ch_bio_flux(cht%LCH_BIO_FLUX)
 !
 CALL default_crocus(gdo%LSNOWDRIFT,gdo%LSNOWDRIFT_SUBLIM,gdo%LSNOW_ABS_ZENITH,&
                     gdo%CSNOWMETAMO,gdo%CSNOWRAD) 
 !
ENDIF
!        1.2. Defaults from file header
!    
 CALL read_default_teb_veg_n(cht, gdo, hprogram)
!
 CALL read_teb_veg_conf_n(cht, gdo, hprogram)
!
!-------------------------------------------------------------------------------
gdo%NPATCH = 1
gdo%CRESPSL = 'DEF'
gdo%LMEB_GNDRES = .false.
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
!*       2.     Definition of version
!               ---------------------
!
yrecfm='VERSION'
 CALL read_surf(hprogram,yrecfm,iversion,iresp)
!
yrecfm='BUG'
 CALL read_surf(hprogram,yrecfm,ibugfix,iresp)
!
!*       2.     Initialisation of ISBA options
!               ------------------------------
!
!
yrecfm='TWN_ISBA'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_ISBA'
 CALL read_surf(hprogram,yrecfm,gdo%CISBA,iresp)
!
IF (iversion>=7) THEN
  !
  yrecfm='TWN_PEDOTF'
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_PEDOTF'
  CALL read_surf(hprogram,yrecfm,gdo%CPEDOTF,iresp)
  !
ELSE
  gdo%CPEDOTF = 'CH78'
ENDIF
!
yrecfm='TWN_PHOTO'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_PHOTO'
 CALL read_surf(hprogram,yrecfm,gdo%CPHOTO,iresp)
!
yrecfm='TWN_LAYER'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_LAYER'
 CALL read_surf(hprogram,yrecfm,gdo%NGROUND_LAYER,iresp)
!
ALLOCATE(gdo%LMEB_PATCH(1))
gdo%LMEB_PATCH(:) = .false.
!
!* new radiative transfert
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
  !
  yrecfm='TWN_TR_ML'
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_TR_ML'
  CALL read_surf(hprogram,yrecfm,gdo%LTR_ML,iresp)
  !
ELSE 
  gdo%LTR_ML = .false.
ENDIF
!
IF (iversion>8 .OR. iversion==8 .AND. ibugfix>=1) THEN
  !
  yrecfm='GD_ALBEDO'
  CALL read_surf(hprogram,yrecfm,gdo%CALBEDO,iresp)
  !
ELSE
  !
  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%CALBEDO = yalbedo
  !
ENDIF
!
!* Reference grid for DIF
!
IF(gdo%CISBA=='DIF') THEN
  ALLOCATE(gdo%XSOILGRID(gdo%NGROUND_LAYER))
  gdo%XSOILGRID=xundef
  IF (iversion>=8) THEN
     DO jlayer=1,gdo%NGROUND_LAYER
        WRITE(ylvl,'(I4)') jlayer
        yrecfm='GD_SGRID'//adjustl(ylvl(:len_trim(ylvl)))
        CALL read_surf(hprogram,yrecfm,gdo%XSOILGRID(jlayer),iresp)
     ENDDO
  ELSEIF (iversion==7 .AND. ibugfix>=2) THEN
    yrecfm='TWN_SOILGRID'
    IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_SOILGRID'
    CALL read_surf(hprogram,yrecfm,gdo%XSOILGRID,iresp,hdir='-')
  ELSE
    gdo%XSOILGRID(1:gdo%NGROUND_LAYER)=xoptimgrid(1:gdo%NGROUND_LAYER)
  ENDIF
ELSE
  ALLOCATE(gdo%XSOILGRID(0))
ENDIF
!
!* number of biomass pools
!
gdo%NNBIOMASS=1
IF (gdo%CPHOTO=='NIT') gdo%NNBIOMASS=3
!
!-------------------------------------------------------------------------------
!
IF (ogreenroof) THEN
  !
  gro%NPATCH = 1
  ALLOCATE(gro%LMEB_PATCH(1))
  gro%LMEB_PATCH(:) = .false.
  gro%CRESPSL   = gdo%CRESPSL  
  !
  yrecfm='GR_ISBA'
  CALL read_surf(hprogram,yrecfm,gro%CISBA,iresp)
  !
  gro%CPEDOTF   = gdo%CPEDOTF  
  gro%CPHOTO    = gdo%CPHOTO
  !
  yrecfm='GR_LAYER'
  CALL read_surf( hprogram,yrecfm,gro%NGROUND_LAYER,iresp)
  !
  gro%LTR_ML = .false.
  !
  gro%NNBIOMASS = gdo%NNBIOMASS
  !
  yrecfm='GR_SCOND'
  CALL read_surf(hprogram,yrecfm,gro%CSCOND,iresp)
  !
  gro%XTSTEP = gdo%XTSTEP
  gro%XOUT_TSTEP = gdo%XOUT_TSTEP
  gro%CRUNOFF = gdo%CRUNOFF
  gro%CALBEDO = gdo%CALBEDO
  gro%CC1DRY = gdo%CC1DRY
  gro%CSOILFRZ = gdo%CSOILFRZ
  gro%CDIFSFCOND = gdo%CDIFSFCOND 
  gro%CSNOWRES = gdo%CSNOWRES
  gro%CCPSURF = gdo%CCPSURF
  gro%XCGMAX = gdo%XCGMAX 
  gro%XCDRAG = gdo%XCDRAG 
  gro%CKSAT = gdo%CKSAT
  gro%LSOC = gdo%LSOC
  gro%CRAIN = gdo%CRAIN
  gro%CHORT = gdo%CHORT
  gro%LGLACIER = gdo%LGLACIER
  gro%LCANOPY_DRAG = gdo%LCANOPY_DRAG
  gro%LVEGUPD = gdo%LVEGUPD
  gro%LSPINUPCARBS = gdo%LSPINUPCARBS
  gro%LSPINUPCARBW = gdo%LSPINUPCARBW
  gro%XSPINMAXS = gdo%XSPINMAXS
  gro%XSPINMAXW = gdo%XSPINMAXW
  gro%XCO2_START = gdo%XCO2_START
  gro%XCO2_END = gdo%XCO2_END
  gro%NNBYEARSPINS = gdo%NNBYEARSPINS
  gro%NNBYEARSPINW = gdo%NNBYEARSPINW
  gro%LNITRO_DILU = gdo%LNITRO_DILU
  !
  gro%LSNOWDRIFT = gdo%LSNOWDRIFT
  gro%LSNOWDRIFT_SUBLIM = gdo%LSNOWDRIFT_SUBLIM
  gro%LSNOW_ABS_ZENITH = gdo%LSNOW_ABS_ZENITH
  gro%CSNOWMETAMO = gdo%CSNOWMETAMO
  gro%CSNOWRAD = gdo%CSNOWRAD
  !
  gro%LMEB_GNDRES = gdo%LMEB_GNDRES
ENDIF
!
!-------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('INIT_TEB_VEG_OPTIONS_N',1,zhook_handle)
END SUBROUTINE init_teb_veg_options_n