init_teb_garden_pgdn.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_garden_pgd_n (DTCO, U, CHI, DTI, I, DST, SLT, CHT, TG, T, TOP, GDM, &
                                          hprogram,hinit, oread_pgd,ki, ksv, hsv, kversion, kbugfix, &
                                          pco2, prhoa)
        !#############################################################
        !
        !!****  *INIT_TEB_GARDEN_PGD_n* - routine to initialize ISBA
        !!
        !!    PURPOSE
        !!    -------
        !!
        !!**  METHOD
        !!    ------
        !!
        !!    EXTERNAL
        !!    --------
        !!
        !!
        !!    IMPLICIT ARGUMENTS
        !!    ------------------
        !!
        !!    REFERENCE
        !!    ---------
        !!
        !!
        !!    AUTHOR
        !!    ------
        !!      A. Lemonsu  *Meteo France*
        !!
        !!    MODIFICATIONS
        !!    -------------
        !!      Original    09/2009
        !!                  11/2013 (B. Decharme) No exp profile with DIF
        !-------------------------------------------------------------------------------
        !
        !*       0.    DECLARATIONS
        !              ------------
        !
        !
        USE modd_data_cover_n, ONLY : data_cover_t
        USE modd_surf_atm_n, ONLY : surf_atm_t
        USE modd_ch_isba_n, ONLY : ch_isba_t
        USE modd_data_isba_n, ONLY : data_isba_t
        USE modd_isba_n, ONLY : isba_t
        USE modd_dst_n, ONLY : dst_t
        USE modd_slt_n, ONLY : slt_t
        USE modd_ch_teb_n, ONLY : ch_teb_t
        USE modd_teb_grid_n, ONLY : teb_grid_t
        USE modd_teb_n, ONLY : teb_t
        USE modd_teb_option_n, ONLY : teb_options_t
        USE modd_surfex_n, ONLY : teb_garden_model_t
        !
        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_sgh_par,         ONLY: ndimtab, xf_decay
        !
        USE modi_get_luout
        USE modi_allocate_teb_garden_pgd
        USE modi_read_pgd_teb_garden_n
        USE modi_convert_patch_garden
        USE modi_init_from_data_grdn_n
        USE modi_init_veg_pgd_garden_n
        USE modi_exp_decay_soil_fr
        USE modi_abor1_sfx
        !
        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(surf_atm_t), INTENT(INOUT) :: u
        TYPE(ch_isba_t), INTENT(INOUT) :: chi
        TYPE(data_isba_t), INTENT(INOUT) :: dti
        TYPE(isba_t), INTENT(INOUT) :: i
        TYPE(dst_t), INTENT(INOUT) :: dst
        TYPE(slt_t), INTENT(INOUT) :: slt
        TYPE(ch_teb_t), INTENT(INOUT) :: cht
        TYPE(teb_grid_t), INTENT(INOUT) :: tg
        TYPE(teb_t), INTENT(INOUT) :: t
        TYPE(teb_options_t), INTENT(INOUT) :: top
        TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
        !
         CHARACTER(LEN=6),                   INTENT(IN)  :: hprogram  ! program calling surf. schemes
         CHARACTER(LEN=3),                   INTENT(IN)  :: hinit     ! choice of fields to initialize
        LOGICAL,                            INTENT(IN)  :: oread_pgd ! flag to read PGD fields in the file
        INTEGER,                            INTENT(IN)  :: ki        ! number of points
        INTEGER,                            INTENT(IN)  :: ksv       ! number of scalars
         CHARACTER(LEN=6), DIMENSION(KSV),   INTENT(IN)  :: hsv       ! name of all scalar variables
        INTEGER,                            INTENT(IN)  :: kversion  ! version number of the file being read
        INTEGER,                            INTENT(IN)  :: kbugfix
        REAL,             DIMENSION(KI),    INTENT(IN)  :: pco2        ! CO2 concentration (kg/m3)
        REAL,             DIMENSION(KI),    INTENT(IN)  :: prhoa       ! air density
        !
        !
        !
        !*       0.2   Declarations of local variables
        !              -------------------------------
        !
        INTEGER           :: jilu     ! loop increment
        INTEGER           :: iluout   ! unit of output listing file
        !
        INTEGER           :: idecade  ! decade of simulation
        !
        INTEGER :: jvegtype, jlayer  ! loop counter on vegtypes
        !
        REAL, DIMENSION(KI)               :: zf
        REAL, DIMENSION(KI)               :: zwork
        REAL(KIND=JPRB) :: zhook_handle
        !
        !-------------------------------------------------------------------------------
        !
        !               Initialisation for IO
        !
        IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_PGD_n',0,zhook_handle)
         CALL get_luout(hprogram,iluout)
        !
        !-------------------------------------------------------------------------------
        !
        !*       2.     Physiographic fields
        !               --------------------
        !
        !* allocation of urban green area variables
        !
         CALL allocate_teb_garden_pgd(gdm%TGDPE, gdm%TGDP, &
                                      oread_pgd, ki, nvegtype, gdm%TGDO%NGROUND_LAYER, ndimtab)  
        !
        !
        !*       2.1    Cover, soil and orographic fields:
        !               ---------------------------------
        !
        IF (oread_pgd) &
         CALL read_pgd_teb_garden_n(cht, dtco, gdm%DTGD, gdm%GBGD, u, gdm%TGDO, gdm%TGDP, tg, top, &
                                    hprogram,kversion,kbugfix)
        !
        !
        !*       2.3    Physiographic data fields from land cover:
        !               -----------------------------------------
        !
        IF (top%TTIME%TDATE%MONTH /= nundef) THEN
          idecade = 3 * ( top%TTIME%TDATE%MONTH - 1 ) + min(top%TTIME%TDATE%DAY-1,29) / 10 + 1
        ELSE
          idecade = 1
        END IF
        !
        !
        IF (.NOT. gdm%TGDO%LPAR_GARDEN) THEN
          CALL convert_patch_garden(dtco, dti, i, gdm%TGDO, gdm%TGDPE, gdm%TGDP, top, gdm%TVG, &
                                    ki,idecade)
        ELSE
         CALL init_from_data_grdn_n(gdm%DTGD, &
                                    idecade,gdm%TVG%CPHOTO, gdm%TGDPE%CUR%XVEG, &
                                    gdm%TGDPE%CUR%XLAI,gdm%TGDP%XRSMIN,gdm%TGDP%XGAMMA,&
                                    gdm%TGDP%XWRMAX_CF, gdm%TGDP%XRGL,gdm%TGDP%XCV,gdm%TGDP%XDG,&
                                    gdm%TGDP%XD_ICE,gdm%TGDPE%CUR%XZ0,gdm%TGDP%XZ0_O_Z0H,&
                                    gdm%TGDP%XALBNIR_VEG,gdm%TGDP%XALBVIS_VEG,     &
                                    gdm%TGDP%XALBUV_VEG,gdm%TGDPE%CUR%XEMIS,      &
                                    gdm%TGDP%XVEGTYPE,gdm%TGDP%XROOTFRAC,gdm%TGDP%XGMES,&
                                    gdm%TGDP%XBSLAI,gdm%TGDP%XLAIMIN,gdm%TGDP%XSEFOLD,gdm%TGDP%XGC,   &
                                    gdm%TGDP%XDMAX, gdm%TGDP%XF2I, gdm%TGDP%LSTRESS, gdm%TGDP%XH_TREE,&
                                    gdm%TGDP%XRE25,gdm%TGDP%XCE_NITRO,gdm%TGDP%XCF_NITRO,gdm%TGDP%XCNA_NITRO      )  

          IF (gdm%TVG%CISBA=='DIF') THEN
            WHERE(t%CUR%XGARDEN(:)/=0.)
              gdm%TGDP%NWG_LAYER(:)=gdm%TGDO%NGROUND_LAYER 
              gdm%TGDP%XDG2  (:)=0.0
              gdm%TGDP%XDROOT(:)=0.0
            ENDWHERE
            DO jlayer=gdm%TGDO%NGROUND_LAYER,1,-1
              DO jilu=1,ki
                IF(t%CUR%XGARDEN(jilu)/=0..AND.gdm%TGDP%XROOTFRAC(jilu,jlayer)>=1.0)THEN
                  gdm%TGDP%XDG2  (jilu)=gdm%TGDP%XDG(jilu,jlayer)
                  gdm%TGDP%XDROOT(jilu)=gdm%TGDP%XDG(jilu,jlayer)
                ENDIF
              ENDDO
            ENDDO
          ENDIF

        END IF
        !

        WHERE (t%CUR%XGARDEN(:)==0.)
          gdm%TGDPE%CUR%XVEG(:)=0.
          gdm%TGDPE%CUR%XLAI(:)=0.
          gdm%TGDP%XRSMIN(:)=40.
          gdm%TGDP%XGAMMA(:)=0.
          gdm%TGDP%XWRMAX_CF(:)=0.2
          gdm%TGDP%XRGL(:)=100.
          gdm%TGDP%XCV(:)=2.e-5
          gdm%TGDPE%CUR%XZ0(:)=0.013
          gdm%TGDP%XZ0_O_Z0H(:)=10.
          gdm%TGDP%XALBNIR_VEG(:)=0.30
          gdm%TGDP%XALBVIS_VEG(:)=0.30
          gdm%TGDP%XALBUV_VEG(:)=0.06
          gdm%TGDPE%CUR%XEMIS(:)=0.94
        ENDWHERE  
        IF (gdm%TVG%CPHOTO/='NON') THEN
          WHERE (t%CUR%XGARDEN(:)==0.)
            gdm%TGDP%XGMES(:)=0.020
            gdm%TGDP%XBSLAI(:)=0.36
            gdm%TGDP%XLAIMIN(:)=0.3
            gdm%TGDP%XSEFOLD(:)=90*86400.
            gdm%TGDP%XH_TREE(:)=0.
            gdm%TGDP%XRE25(:)=3.6e-7
            gdm%TGDP%XGC(:)=0.00025
          END WHERE
          IF (gdm%TVG%CPHOTO/='AGS' .AND. gdm%TVG%CPHOTO/='LAI') THEN
            WHERE (t%CUR%XGARDEN(:)==0.) 
              gdm%TGDP%XDMAX(:)=0.1
              gdm%TGDP%XF2I(:)=0.3
            END WHERE
            IF (gdm%TVG%CPHOTO=='NIT' .OR. gdm%TVG%CPHOTO=='NCB') THEN
              WHERE (t%CUR%XGARDEN(:)==0.)      
                gdm%TGDP%XCE_NITRO(:)=7.68
                gdm%TGDP%XCF_NITRO(:)=-4.33
                gdm%TGDP%XCNA_NITRO(:)=1.3
              END WHERE
            ENDIF
          ENDIF
        ENDIF
        IF(gdm%TVG%CISBA/='DIF')THEN
          DO jlayer=1,gdm%TGDO%NGROUND_LAYER
            WHERE (t%CUR%XGARDEN(:)==0.)
              gdm%TGDP%XDG(:,jlayer)=0.2*jlayer
            END WHERE
          ENDDO
        ELSE
          WHERE (t%CUR%XGARDEN(:)==0.) 
            gdm%TGDP%XDG(:,1)=0.01
            gdm%TGDP%XDG(:,2)=0.04
            gdm%TGDP%XROOTFRAC(:,1)=0.
            gdm%TGDP%XROOTFRAC(:,2)=0.
          END WHERE        
          DO jlayer=3,gdm%TGDO%NGROUND_LAYER
            WHERE (t%CUR%XGARDEN(:)==0.)
              gdm%TGDP%XDG(:,jlayer)=0.1*(jlayer-2)
              gdm%TGDP%XROOTFRAC(:,jlayer)=0.
            END WHERE
          ENDDO               
          WHERE (t%CUR%XGARDEN(:)==0.) 
            gdm%TGDP%NWG_LAYER(:)=gdm%TGDO%NGROUND_LAYER
            gdm%TGDP%XDROOT   (:)=0.0
            gdm%TGDP%XDG2     (:)=gdm%TGDP%XDG(:,gdm%TGDO%NGROUND_LAYER-1)
          ENDWHERE    
        ENDIF  
        WHERE (t%CUR%XGARDEN(:)==0.) 
          gdm%TGDP%XD_ICE(:)=0.8*gdm%TGDP%XDG(:,2)
        END WHERE  
        DO jvegtype=1,nvegtype
          WHERE (t%CUR%XGARDEN(:)==0.)
            gdm%TGDP%XVEGTYPE(:,jvegtype)=0.
            gdm%TGDP%XVEGTYPE(:,1)=1.
          END WHERE
        ENDDO
        !
         CALL init_veg_pgd_garden_n(chi, dtco, dst, i, slt, u, &
                            hprogram, iluout, ki, gdm%TGDO%NGROUND_LAYER, top%TTIME%TDATE%MONTH,    &
                        gdm%TGDP%XVEGTYPE, gdm%TGDP%XTDEEP, gdm%TGDP%XGAMMAT, gdm%TVG%CPHOTO, hinit, &
                        gdm%TVG%LTR_ML, gdm%TVG%CRUNOFF, gdm%TVG%NNBIOMASS, pco2, prhoa, &
                        gdm%TGDP%XABC, gdm%TGDP%XPOI, gdm%TGDP%XGMES, gdm%TGDP%XGC, gdm%TGDP%XDMAX, &
                        gdm%TGDP%XANMAX, gdm%TGDP%XFZERO, gdm%TGDP%XEPSO, gdm%TGDP%XGAMM, gdm%TGDP%XQDGAMM,   &
                        gdm%TGDP%XQDGMES, gdm%TGDP%XT1GMES, gdm%TGDP%XT2GMES, gdm%TGDP%XAMAX, gdm%TGDP%XQDAMAX, &
                        gdm%TGDP%XT1AMAX, gdm%TGDP%XT2AMAX,gdm%TGDP%XAH, gdm%TGDP%XBH,            &
                        ksv, hsv, cht%SVT, cht%CCH_NAMES, cht%CAER_NAMES,cht%CDSTNAMES, cht%CSLTNAMES, &
                        cht%CCHEM_SURF_FILE, gdm%TGDP%XCLAY, gdm%TGDP%XSAND, gdm%TVG%CPEDOTF,      &
                        gdm%TGDP%XCONDSAT, gdm%TGDP%XMPOTSAT, gdm%TGDP%XBCOEF, gdm%TGDP%XWWILT, &
                        gdm%TGDP%XWFC, gdm%TGDP%XWSAT, gdm%TGDP%XTAUICE, gdm%TGDP%XCGSAT, gdm%TGDP%XC1SAT, &
                        gdm%TGDP%XC2REF, gdm%TGDP%XC3, gdm%TGDP%XC4B, gdm%TGDP%XACOEF, gdm%TGDP%XPCOEF, &
                        gdm%TGDP%XC4REF, gdm%TGDP%XPCPS, gdm%TGDP%XPLVTT, gdm%TGDP%XPLSTT,        &
                        gdm%TVG%CSCOND, gdm%TVG%CISBA, gdm%TGDP%XHCAPSOIL, gdm%TGDP%XCONDDRY, &
                        gdm%TGDP%XCONDSLD, gdm%TVG%CCPSURF, gdm%TGDP%XDG, gdm%TGDP%XDROOT, gdm%TGDP%XDG2, &
                        gdm%TGDP%XROOTFRAC, gdm%TGDP%XRUNOFFD, gdm%TGDP%XDZG, gdm%TGDP%XDZDIF,       &
                        gdm%TGDP%XSOILWGHT, gdm%TGDP%NWG_LAYER, gdm%TGDO%NLAYER_HORT, &
                        gdm%TGDO%NLAYER_DUN, gdm%TGDP%XD_ICE,  &
                        gdm%TGDP%XKSAT_ICE, gdm%TGDP%XALBNIR_DRY, gdm%TGDP%XALBVIS_DRY, gdm%TGDP%XALBUV_DRY,   &
                        gdm%TGDP%XALBNIR_WET, gdm%TGDP%XALBVIS_WET, gdm%TGDP%XALBUV_WET, gdm%TGDP%XBSLAI_NITRO, &
                        gdm%TGDP%XCE_NITRO, gdm%TGDP%XCNA_NITRO, gdm%TGDP%XCF_NITRO                            )
!
!-------------------------------------------------------------------------------
!
IF(gdm%TVG%CISBA=='DIF'.AND.gdm%TVG%LSOC)THEN
  CALL abor1_sfx('INIT_TEB_GARDEN_PGDn: SUBGRID Soil organic matter'//&
                 ' effect (LSOC) NOT YET IMPLEMENTED FOR GARDEN')
ELSEIF (gdm%TVG%CISBA=='3-L'.AND.gdm%TVG%CKSAT=='EXP') THEN 
  CALL abor1_sfx('INIT_TEB_GARDEN_PGDn: topmodel exponential decay not implemented for garden')
ENDIF
!
IF(gdm%TVG%CKSAT=='SGH' .AND. gdm%TVG%CISBA/='DIF' .AND. hinit/='PRE')THEN 
  zf(:)=min(4.0/gdm%TGDP%XDG(:,2),xf_decay)
  CALL exp_decay_soil_fr(gdm%TVG%CISBA, zf(:),gdm%TGDP%XC1SAT(:),gdm%TGDP%XC2REF(:),&
                         gdm%TGDP%XDG(:,:),gdm%TGDP%XD_ICE(:),gdm%TGDP%XC4REF(:),&
                         gdm%TGDP%XC3(:,:),gdm%TGDP%XCONDSAT(:,:),gdm%TGDP%XKSAT_ICE(:))
ENDIF
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_PGD_n',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE init_teb_garden_pgd_n