init_veg_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_veg_pgd_n (CHI, DTCO, DST, I, SLT, U, &
                           hprogram, hsurf, kluout, ki, kpatch, kground_layer, kmonth, &
                          pvegtype, ppatch, pvegtype_patch, ksize_nature_p,           &
                          kr_nature_p, prm_patch,                                     &
                          odeepsoil, ophysdomc, ptdeep_cli, pgammat_cli, ptdeep,      &
                          pgammat, oagrip, pthreshold, kirrinum, oirriday, oirrigate, &
                          pthresholdspt,                                              &
                          hphoto, hinit, otr_ml, knbiomass, pco2, prhoa, pabc, ppoi,  &
                          pgmes, pgc, pdmax, panmax, pfzero, pepso, pgamm, pqdgamm,   &
                          pqdgmes, pt1gmes, pt2gmes, pamax, pqdamax, pt1amax, pt2amax,&
                          pah, pbh, ptau_wood, pincrease, pturnover,                  &
                          ksv, hsv, ysv, hch_names, haer_names, hdstnames, hsltnames, &
                          hchem_surf_file,                      &
                          psfdst, psfdstm, psfslt,                                    &
                          paosip, paosim, paosjp, paosjm, pho2ip, pho2im, pho2jp,     &
                          pho2jm, pz0, pz0effip, pz0effim, pz0effjp, pz0effjm, pz0rel,&
                          pclay, psand, hpedotf,                                      &
                          pcondsat, pmpotsat, pbcoef, pwwilt, pwfc, pwsat, pwd0,      &
                          pkaniso, hrunoff,                                           &
                          ptauice, pcgsat, pc1sat, pc2ref, pc3, pc4b, pacoef, ppcoef, &
                          pc4ref, ppcps, pplvtt, pplstt,                              &
                          hscond, hisba, phcapsoil, pconddry, pcondsld, hcpsurf,      &
                          pdg, pdroot, pdg2, prootfrac, prunoffd, pdzg, pdzdif,       &
                          psoilwght, kwg_layer, klayer_hort, klayer_dun, pd_ice,      &
                          pksat_ice, palbnir_dry, palbvis_dry, palbuv_dry,            &
                          palbnir_wet, palbvis_wet, palbuv_wet, pbslai_nitro,         &
                          pce_nitro, pcna_nitro, pcf_nitro, pfwtd, pwtd               )  
!#############################################################
!
!!****  *INIT_VEG_PGD_n_n* - routine to initialize ISBA
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      23/07/13     (Decharme) Surface / Water table depth coupling
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_sv_n, ONLY : sv_t
!
!
USE modd_ch_isba_n, ONLY : ch_isba_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_dst_n, ONLY : dst_t
USE modd_isba_n, ONLY : isba_t
USE modd_slt_n, ONLY : slt_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_atm,       ONLY : lcpl_arp
USE modd_data_cover_par, ONLY : nvegtype
USE modd_surf_par,       ONLY : xundef, nundef
USE modd_csts,           ONLY : xcpd, xlvtt, xlstt
USE modd_snow_par,       ONLY : xemissn
USE modd_isba_par,       ONLY : xtau_ice
!
USE modd_sgh_par,        ONLY : xice_deph_max
!
USE mode_cotwo,          ONLY : gauleg
!
USE modi_surf_patch
USE modi_get_1d_mask
USE modi_co2_init_n
USE modi_init_chemical_n
USE modi_open_namelist
USE modi_ch_init_dep_isba_n
USE modi_close_namelist
USE modi_init_dst
USE modi_init_slt
USE modi_subscale_z0eff
!
USE mode_soil
!
USE modi_heatcapz
USE modi_thrmcondz
USE modi_abor1_sfx
USE modi_dif_layer
USE modi_dry_wet_soil_albedos
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(ch_isba_t), INTENT(INOUT) :: chi
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(dst_t), INTENT(INOUT) :: dst
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(slt_t), INTENT(INOUT) :: slt
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6), INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=6), INTENT(IN)  :: hsurf     ! Type of surface
INTEGER, INTENT(IN)  :: kluout
!
INTEGER, INTENT(IN)  :: ki
INTEGER, INTENT(IN)  :: kpatch
INTEGER, INTENT(IN)  :: kground_layer
INTEGER, INTENT(IN)  :: kmonth
!
REAL, DIMENSION(:,:), POINTER :: pvegtype
REAL, DIMENSION(:,:), POINTER :: ppatch
REAL, DIMENSION(:,:,:), POINTER :: pvegtype_patch
INTEGER, DIMENSION(:), POINTER :: ksize_nature_p
INTEGER, DIMENSION(:,:), POINTER :: kr_nature_p
!
REAL, INTENT(IN) :: prm_patch
!
LOGICAL, INTENT(IN) :: odeepsoil
LOGICAL, INTENT(IN) :: ophysdomc
REAL, DIMENSION(:), INTENT(IN) :: ptdeep_cli
REAL, DIMENSION(:), INTENT(IN) :: pgammat_cli
REAL, DIMENSION(:), POINTER :: ptdeep
REAL, DIMENSION(:), POINTER :: pgammat
!
LOGICAL, INTENT(IN) :: oagrip
REAL, DIMENSION(:), INTENT(IN) :: pthreshold
INTEGER, DIMENSION(:,:), POINTER :: kirrinum
LOGICAL, DIMENSION(:,:), POINTER :: oirriday
LOGICAL, DIMENSION(:,:), POINTER :: oirrigate
REAL, DIMENSION(:,:), POINTER :: pthresholdspt
!
 CHARACTER(LEN=3), INTENT(IN) :: hphoto
 CHARACTER(LEN=3), INTENT(IN) :: hinit
LOGICAL, INTENT(IN) :: otr_ml
INTEGER, INTENT(IN) :: knbiomass
REAL, DIMENSION(:), INTENT(IN) :: pco2
REAL, DIMENSION(:), INTENT(IN) :: prhoa
REAL, DIMENSION(:), POINTER :: pabc
REAL, DIMENSION(:), POINTER :: ppoi
REAL, DIMENSION(:,:), INTENT(IN) :: pgmes
REAL, DIMENSION(:,:), INTENT(IN) :: pgc
REAL, DIMENSION(:,:), INTENT(IN):: pdmax
REAL, DIMENSION(:,:), POINTER :: panmax
REAL, DIMENSION(:,:), POINTER :: pfzero
REAL, DIMENSION(:,:), POINTER :: pepso
REAL, DIMENSION(:,:), POINTER :: pgamm
REAL, DIMENSION(:,:), POINTER :: pqdgamm
REAL, DIMENSION(:,:), POINTER :: pqdgmes
REAL, DIMENSION(:,:), POINTER :: pt1gmes
REAL, DIMENSION(:,:), POINTER :: pt2gmes
REAL, DIMENSION(:,:), POINTER :: pamax
REAL, DIMENSION(:,:), POINTER :: pqdamax
REAL, DIMENSION(:,:), POINTER :: pt1amax
REAL, DIMENSION(:,:), POINTER :: pt2amax
REAL, DIMENSION(:,:), POINTER :: pah
REAL, DIMENSION(:,:), POINTER :: pbh
REAL, DIMENSION(:,:), POINTER :: ptau_wood
REAL, DIMENSION(:,:,:), POINTER :: pincrease
REAL, DIMENSION(:,:,:), POINTER :: pturnover
!
INTEGER,                          INTENT(IN) :: ksv      ! number of scalars
 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: hsv      ! name of all scalar variables
TYPE(sv_t), INTENT(INOUT) :: ysv 
 CHARACTER(LEN=6), DIMENSION(:), POINTER :: hch_names
 CHARACTER(LEN=6), DIMENSION(:), POINTER :: haer_names     
 CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: hdstnames
 CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: hsltnames
!
 CHARACTER(LEN=28), INTENT(OUT) :: hchem_surf_file
!
REAL, DIMENSION(:,:,:), POINTER :: psfdst
REAL, DIMENSION(:,:,:), POINTER :: psfdstm
REAL, DIMENSION(:,:,:), POINTER :: psfslt
!
REAL, DIMENSION(:), INTENT(IN) :: paosip
REAL, DIMENSION(:), INTENT(IN) :: paosim
REAL, DIMENSION(:), INTENT(IN) :: paosjp
REAL, DIMENSION(:), INTENT(IN) :: paosjm
REAL, DIMENSION(:), INTENT(IN) :: pho2ip
REAL, DIMENSION(:), INTENT(IN) :: pho2im
REAL, DIMENSION(:), INTENT(IN) :: pho2jp
REAL, DIMENSION(:), INTENT(IN) :: pho2jm
REAL, DIMENSION(:,:), INTENT(IN) :: pz0
REAL, DIMENSION(:,:), POINTER :: pz0effip
REAL, DIMENSION(:,:), POINTER :: pz0effim
REAL, DIMENSION(:,:), POINTER :: pz0effjp
REAL, DIMENSION(:,:), POINTER :: pz0effjm
REAL, DIMENSION(:), POINTER :: pz0rel
!
REAL, DIMENSION(:,:), INTENT(IN) :: pclay
REAL, DIMENSION(:,:), INTENT(IN) :: psand
 CHARACTER(LEN=4), INTENT(IN) :: hpedotf
REAL, DIMENSION(:,:,:), POINTER :: pcondsat
REAL, DIMENSION(:,:), POINTER :: pmpotsat
REAL, DIMENSION(:,:), POINTER :: pbcoef
REAL, DIMENSION(:,:), POINTER :: pwwilt
REAL, DIMENSION(:,:), POINTER :: pwfc
REAL, DIMENSION(:,:), POINTER :: pwsat
REAL, DIMENSION(:,:), POINTER :: pwd0
REAL, DIMENSION(:,:), POINTER :: pkaniso
!
REAL, DIMENSION(:), POINTER :: ptauice
REAL, DIMENSION(:), POINTER :: pcgsat
REAL, DIMENSION(:,:), POINTER :: pc1sat
REAL, DIMENSION(:,:), POINTER :: pc2ref
REAL, DIMENSION(:,:,:), POINTER :: pc3
REAL, DIMENSION(:), POINTER :: pc4b
REAL, DIMENSION(:), POINTER :: pacoef
REAL, DIMENSION(:), POINTER :: ppcoef
REAL, DIMENSION(:,:), POINTER :: pc4ref
!
REAL, DIMENSION(:,:), POINTER :: ppcps
REAL, DIMENSION(:,:), POINTER :: pplvtt
REAL, DIMENSION(:,:), POINTER :: pplstt
!
 CHARACTER(LEN=4), INTENT(IN) :: hscond
 CHARACTER(LEN=3), INTENT(IN) :: hisba
 CHARACTER(LEN=4), INTENT(IN) :: hrunoff
REAL, DIMENSION(:,:), POINTER :: phcapsoil
REAL, DIMENSION(:,:), POINTER :: pconddry
REAL, DIMENSION(:,:), POINTER :: pcondsld
 CHARACTER(LEN=3), INTENT(IN) :: hcpsurf
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: pdg
REAL, DIMENSION(:,:), INTENT(IN) :: pdroot
REAL, DIMENSION(:,:), INTENT(IN) :: pdg2
REAL, DIMENSION(:,:,:), INTENT(IN) :: prootfrac
REAL, DIMENSION(:,:), POINTER :: prunoffd
REAL, DIMENSION(:,:,:), POINTER :: pdzg
REAL, DIMENSION(:,:,:), POINTER :: pdzdif
REAL, DIMENSION(:,:,:), POINTER :: psoilwght
INTEGER, DIMENSION(:,:), INTENT(IN) :: kwg_layer
INTEGER, INTENT(OUT) :: klayer_hort
INTEGER, INTENT(OUT) :: klayer_dun
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: pd_ice
REAL, DIMENSION(:,:), POINTER :: pksat_ice
!
REAL, DIMENSION(:), POINTER :: palbnir_dry
REAL, DIMENSION(:), POINTER :: palbvis_dry
REAL, DIMENSION(:), POINTER :: palbuv_dry
REAL, DIMENSION(:), POINTER :: palbnir_wet
REAL, DIMENSION(:), POINTER :: palbvis_wet
REAL, DIMENSION(:), POINTER :: palbuv_wet
!
REAL, DIMENSION(:,:), POINTER :: pbslai_nitro
REAL, DIMENSION(:,:), INTENT(IN) :: pce_nitro
REAL, DIMENSION(:,:), INTENT(IN) :: pcna_nitro
REAL, DIMENSION(:,:), INTENT(IN) :: pcf_nitro
!
REAL, DIMENSION(:), POINTER :: pfwtd
REAL, DIMENSION(:), POINTER :: pwtd
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER :: jpatch  ! loop counter on tiles
INTEGER :: jilu,jp, jmaxloc    ! loop increment
INTEGER :: jlayer  ! loop counter on layers
!
INTEGER :: ich     ! unit of input chemistry file
INTEGER :: isize
!
REAL, DIMENSION(SIZE(PCO2))       :: zco2  ! CO2 concentration  (kg/kg)
!
INTEGER, DIMENSION(:), ALLOCATABLE :: ir_nature_p
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_VEG_PGD_n',0,zhook_handle)
!
!*       2.4    Fraction of each tile
!               ---------------------
!
ALLOCATE(ppatch(ki,kpatch))
ALLOCATE(pvegtype_patch(ki,nvegtype,kpatch))
ALLOCATE(ksize_nature_p(kpatch))
ALLOCATE(kr_nature_p(ki,kpatch))
!
 CALL surf_patch(kpatch,pvegtype,ppatch,pvegtype_patch)
!
!*       2.5    Masks for tiles
!               ---------------
!
IF (prm_patch/=0.) THEN
  !
  WRITE(kluout,*) " REMOVE PATCH below 5 % add to dominant patch " 
  ! remove small fraction of PATCHES and add to MAIN PATCH
  DO jp = 1,ki
    !1) find most present patch maximum value 
    jmaxloc = maxval(maxloc(ppatch(jp,:)))
    !2) FIND small value of cover 
    DO jpatch = 1,kpatch
      IF ( ppatch(jp,jpatch)<prm_patch ) THEN
        ppatch(jp,jmaxloc) = ppatch(jp,jmaxloc) + ppatch(jp,jpatch)
        ppatch(jp,jpatch) = 0.0
       ENDIF
    ENDDO
  ENDDO
  !
ENDIF
!
DO jpatch=1,kpatch
  ksize_nature_p(jpatch) = count(ppatch(:,jpatch) > 0.0)
ENDDO
!
kr_nature_p(:,:) = 0
DO jpatch=1,kpatch
  ALLOCATE(ir_nature_p(ksize_nature_p(jpatch)))
  CALL get_1d_mask(ksize_nature_p(jpatch),ki,ppatch(:,jpatch),ir_nature_p)
  kr_nature_p(:ksize_nature_p(jpatch),jpatch) = ir_nature_p(:)
  DEALLOCATE(ir_nature_p)
ENDDO
!
!
!*       2.6    Miscellaneous fields for ISBA:
!               -----------------------------
!
!* default value for:
! lateral water flux, deep soil temperature climatology and its relaxation time-scale
!
ALLOCATE(ptdeep(ki))
ALLOCATE(pgammat(ki))
ptdeep(:) = xundef
pgammat(:) = xundef
!
IF (odeepsoil) THEN
   DO jilu = 1, ki
      ptdeep(jilu) = ptdeep_cli(kmonth)
      pgammat(jilu) = 1. / pgammat_cli(kmonth)
   END DO
   !
   WRITE(kluout,*)' LDEEPSOIL = ',odeepsoil,' LPHYSDOMC = ',ophysdomc
   WRITE(kluout,*)' XTDEEP    = ',minval(ptdeep(:)),maxval(ptdeep(:))
   WRITE(kluout,*)' XGAMMAT   = ',minval(pgammat(:)),maxval(pgammat(:))
ENDIF
!
!
!*       2.7    Irrigation
!               ----------
!
IF (oagrip) THEN
   ALLOCATE(kirrinum(ki,kpatch))
   ALLOCATE(oirriday(ki,kpatch))
   ALLOCATE(oirrigate(ki,kpatch))
   ALLOCATE(pthresholdspt(ki,kpatch))
   !
   kirrinum(:,:) = 1
   oirriday(:,:) = .false.                          
   oirrigate(:,:) = .false.                          
   !
   DO jilu = 1, ki
      DO jpatch = 1, kpatch
         pthresholdspt(jilu,jpatch) = pthreshold(kirrinum(jilu,jpatch))
      END DO
   END DO
ELSE
   ALLOCATE(kirrinum(0,0))
   ALLOCATE(oirriday(0,0))
   ALLOCATE(oirrigate(0,0))
   ALLOCATE(pthresholdspt(0,0))
ENDIF
!
!
!*       2.8    Additional fields for ISBA-AGS:
!               ------------------------------                        
!
IF(hphoto /= 'NON' .AND. hinit == 'ALL') THEN
  IF (otr_ml) THEN
    isize = 10
  ELSE
    isize = 3
  ENDIF
  ALLOCATE(pabc(isize))
  ALLOCATE(ppoi(isize))
  pabc(:) = 0.
  ppoi(:) = 0.          
  zco2(:) = pco2(:) / prhoa(:)
  ALLOCATE(panmax(ki,kpatch))
  ALLOCATE(pfzero(ki,kpatch))
  ALLOCATE(pepso(ki,kpatch))
  ALLOCATE(pgamm(ki,kpatch))
  ALLOCATE(pqdgamm(ki,kpatch))
  ALLOCATE(pqdgmes(ki,kpatch))
  ALLOCATE(pt1gmes(ki,kpatch))
  ALLOCATE(pt2gmes(ki,kpatch))
  ALLOCATE(pamax(ki,kpatch))
  ALLOCATE(pqdamax(ki,kpatch))
  ALLOCATE(pt1amax(ki,kpatch))
  ALLOCATE(pt2amax(ki,kpatch))
  ALLOCATE(pah(ki,kpatch))
  ALLOCATE(pbh(ki,kpatch))
  ALLOCATE(ptau_wood(ki,kpatch))
  ALLOCATE(pincrease(ki,knbiomass,kpatch))
  ALLOCATE(pturnover(ki,knbiomass,kpatch))
  CALL co2_init_n(i, &
                  hphoto, ksize_nature_p, kr_nature_p, pvegtype_patch, &
                  zco2, pgmes, pgc, pdmax, pabc, ppoi, panmax, &
                  pfzero, pepso, pgamm, pqdgamm, pqdgmes,      &
                  pt1gmes, pt2gmes, pamax, pqdamax,            &
                  pt1amax, pt2amax, pah, pbh, ptau_wood,       &
                  pincrease, pturnover                         )

ELSEIF(hphoto == 'NON' .AND. otr_ml)THEN ! Case for MEB
   isize = 10
   ALLOCATE (pabc(isize))
   ALLOCATE (ppoi(isize)) ! Working
   pabc(:) = 0.
   ppoi(:) = 0.
   CALL gauleg(0.0,1.0,pabc,ppoi,SIZE(pabc))
   DEALLOCATE (ppoi)
   ALLOCATE   (ppoi(0))
ELSE
  ALLOCATE(pabc(0))
  ALLOCATE(ppoi(0))
  ALLOCATE(panmax(0,0))
  ALLOCATE(pfzero(0,0))
  ALLOCATE(pepso(0,0))
  ALLOCATE(pgamm(0,0))
  ALLOCATE(pqdgamm(0,0))
  ALLOCATE(pqdgmes(0,0))
  ALLOCATE(pt1gmes(0,0))
  ALLOCATE(pt2gmes(0,0))
  ALLOCATE(pamax(0,0))
  ALLOCATE(pqdamax(0,0))
  ALLOCATE(pt1amax(0,0))
  ALLOCATE(pt2amax(0,0))
  ALLOCATE(pah(0,0))
  ALLOCATE(pbh(0,0))
  ALLOCATE(ptau_wood(0,0))
  ALLOCATE(pincrease(0,0,0))
  ALLOCATE(pturnover(0,0,0))  
END IF
!
!-------------------------------------------------------------------------------
!
!        3.  Initialize Chemical Deposition
!            ------------------------------
!
!        3.1 Chemical gazes
!            --------------
!
    !* for the time being, chemistry on vegetation works only for
    ! ISBA on nature tile (not for gardens), because subroutine INIT_CHEMICAL_n
    ! contains explicitely modules from ISBAn. It should be cleaned in a future
    ! version.
IF (hsurf=='NATURE') THEN
 CALL init_chemical_n(kluout, ksv, hsv, ysv, hch_names, haer_names,  &
                     hdstnames=hdstnames, hsltnames=hsltnames        )
END IF
!
IF (ksv /= 0) THEN
  !
  IF (hsurf=='NATURE' .AND. ysv%NBEQ > 0) THEN
    !* for the time being, chemistry deposition on vegetation works only for
    ! ISBA on nature tile (not for gardens), because subroutine CH_INIT_DEP_ISBA_n
    ! contains explicitely modules from ISBAn. It should be cleaned in a future
    ! version.
    CALL open_namelist(hprogram, ich, hfile=hchem_surf_file)
    CALL ch_init_dep_isba_n(chi, dtco, i, &
                            ich, kluout, ki)
    CALL close_namelist(hprogram, ich)
  END IF
  !
  IF (ysv%NDSTEQ >=1) THEN
    ALLOCATE (psfdst(ki, ysv%NDSTEQ, kpatch))  !Output array
    ALLOCATE (psfdstm(ki, ysv%NDSTEQ, kpatch))  !Output array
    psfdst(:,:,:)  = 0.
    psfdstm(:,:,:) = 0.     
    CALL init_dst(dst, u, &
                  hprogram,ksize_nature_p,kr_nature_p, &
                  kpatch,pvegtype_patch)    
  ELSE
    ALLOCATE(psfdst(0,0,0))
    ALLOCATE(psfdstm(0,0,0))
  END IF
  !
  IF (ysv%NSLTEQ >=1) THEN
    ALLOCATE (psfslt(ki,ysv%NSLTEQ,kpatch))  !Output array
    CALL init_slt(slt, &
                  hprogram)   
  ELSE
    ALLOCATE(psfslt(0,0,0))
  END IF
  !
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       4.     Orographic roughness length
!               ---------------------------
!
ALLOCATE(pz0effip(ki,kpatch))
ALLOCATE(pz0effim(ki,kpatch))
ALLOCATE(pz0effjp(ki,kpatch))
ALLOCATE(pz0effjm(ki,kpatch))
ALLOCATE(pz0rel(ki))
!
IF (SIZE(paosip)>0)                                      &
 CALL subscale_z0eff(paosip,paosim,paosjp,paosjm,         &
                    pho2ip,pho2im,pho2jp,pho2jm,pz0,     &
                    pz0effip,pz0effim,pz0effjp,pz0effjm, &
                    pz0rel                               ) 
!
!-------------------------------------------------------------------------------
!
!*       5.1     Soil hydraulic characteristics:
!                -------------------------------
!
ALLOCATE(pcondsat(ki,kground_layer,kpatch))
ALLOCATE(pmpotsat(ki,kground_layer))
ALLOCATE(pbcoef(ki,kground_layer))
ALLOCATE(pwwilt(ki,kground_layer)) ! wilting point
ALLOCATE(pwfc(ki,kground_layer)) ! field capacity
ALLOCATE(pwsat(ki,kground_layer)) ! saturation
ALLOCATE(ptauice(ki))
!        
DO jlayer=1,kground_layer
   pbcoef(:,jlayer) = bcoef_func(pclay(:,jlayer),psand(:,jlayer),hpedotf)
   pmpotsat(:,jlayer) = matpotsat_func(pclay(:,jlayer),psand(:,jlayer),hpedotf)
   DO jpatch=1,kpatch
      pcondsat(:,jlayer,jpatch) = hydcondsat_func(pclay(:,jlayer),psand(:,jlayer),hpedotf)
   ENDDO   
   pwsat(:,jlayer) = wsat_func(pclay(:,jlayer),psand(:,jlayer),hpedotf)
   pwwilt(:,jlayer) = wwilt_func(pclay(:,jlayer),psand(:,jlayer),hpedotf)
END DO
!
IF (hisba=='2-L' .OR. hisba=='3-L') THEN
  !  field capacity at hydraulic conductivity = 0.1mm/day
  pwfc(:,:) = wfc_func(pclay(:,:),psand(:,:),hpedotf)
ELSE IF (hisba=='DIF') THEN
  !  field capacity at water potential = 0.33bar        
  pwfc(:,:) = w33_func(pclay(:,:),psand(:,:),hpedotf)
END IF
!
ptauice(:) = xtau_ice
!
IF (hisba=='2-L' .OR. hisba=='3-L') THEN
  ALLOCATE(pcgsat(ki))
  ALLOCATE(pc1sat(ki,kpatch))
  ALLOCATE(pc2ref(ki,kpatch))
  ALLOCATE(pc3(ki,2,kpatch))
  ALLOCATE(pc4b(ki))
  ALLOCATE(pacoef(ki))
  ALLOCATE(ppcoef(ki))
  ALLOCATE(pc4ref(ki,kpatch))
  pcgsat(:)  = cgsat_func(pclay(:,1),psand(:,1))
  pc4b(:)    = c4b_func(pclay(:,1))
  !
  pacoef(:)  = acoef_func(pclay(:,1))
  ppcoef(:)  = pcoef_func(pclay(:,1))
  !
  DO jpatch=1,kpatch
    pc1sat(:,jpatch) = c1sat_func(pclay(:,1))
    pc2ref(:,jpatch) = c2ref_func(pclay(:,1))         
    pc4ref(:,jpatch) = c4ref_func(pclay(:,1),psand(:,1),       &
                                  pdg(:,2,            jpatch), &
                                  pdg(:,kground_layer,jpatch)  )
    pc3(:,1,jpatch) = c3_func(pclay(:,1))
    pc3(:,2,jpatch) = c3_func(pclay(:,2))

  END DO
  !
ELSE IF (hisba=='DIF') THEN
  !
  ALLOCATE(pcgsat(0))
  ALLOCATE(pc1sat(0,0))
  ALLOCATE(pc2ref(0,0))
  ALLOCATE(pc3(0,0,0))
  ALLOCATE(pc4b(0))
  ALLOCATE(pc4ref(0,0))
  ALLOCATE(pacoef(0))
  ALLOCATE(ppcoef(0))
  !
END IF
!
IF(hrunoff=='SGH')THEN
!
  ALLOCATE(pwd0(ki,kground_layer))
  ALLOCATE(pkaniso(ki,kground_layer))
!
  IF(hisba=='DIF')THEN
     pwd0(:,:) = wfc_func(pclay(:,:),psand(:,:),hpedotf)
  ELSE
     pwd0(:,:) = pwwilt(:,:)
  ENDIF
  pkaniso(:,:) = aniso_func(pclay(:,:))
!
ELSE
!
  ALLOCATE(pwd0(0,0))
  ALLOCATE(pkaniso(0,0))
!
ENDIF
!
!*       5.2     Soil thermal characteristics:
!               --------------------------------
!
ALLOCATE(ppcps(ki,kpatch))
ALLOCATE(pplvtt(ki,kpatch))
ALLOCATE(pplstt(ki,kpatch))
ppcps(:,:) = xcpd
pplvtt(:,:) = xlvtt
pplstt(:,:) = xlstt
!
!CSCOND used in soil.F90 and soildif.F90
!
IF (hscond=='NP89'.AND.hisba=='DIF') THEN
   WRITE(kluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(kluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(kluout,*)'IF CISBA=DIF, CSCOND=NP89 is not available'
   WRITE(kluout,*)'because not physic. CSCOND is put to PL98 '
   WRITE(kluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
   WRITE(kluout,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
IF (hscond=='PL98'.OR.hisba=='DIF') THEN
  ALLOCATE(phcapsoil(ki,kground_layer))
  ALLOCATE(pconddry(ki,kground_layer))
  ALLOCATE(pcondsld(ki,kground_layer))
  ! 
  CALL heatcapz(psand,phcapsoil)
  CALL thrmcondz(psand,pwsat,pconddry,pcondsld)
  !
ELSE
  ALLOCATE(phcapsoil(0,0))
  ALLOCATE(pconddry(0,0))
  ALLOCATE(pcondsld(0,0))
END IF
!
!-------------------------------------------------------------------------------
!CPSURF used in drag.F90
!CPL_ARP used in drag.F90 and e_budget.F90
IF(hcpsurf=='DRY'.AND.lcpl_arp) THEN
  CALL abor1_sfx('CCPSURF=DRY must not be used with LCPL_ARP')
ENDIF
!
!*       6.1    Initialize hydrology
!               --------------------
!
ALLOCATE(prunoffd(ki,kpatch))
prunoffd(:,:)=xundef
!
IF (hisba == 'DIF') THEN
!  
  ALLOCATE(pdzg(ki,kground_layer,kpatch))
  ALLOCATE(pdzdif(ki,kground_layer,kpatch))
  ALLOCATE(psoilwght(ki,kground_layer,kpatch))
  CALL dif_layer(ki, kground_layer, kpatch, ksize_nature_p, &
                 ppatch, pdg, pdroot, pdg2, prootfrac,      &
                 kwg_layer, pdzg, pdzdif, psoilwght,        &
                 prunoffd, klayer_hort, klayer_dun  )
!
   ALLOCATE(pfwtd(ki))
   ALLOCATE(pwtd(ki))
   pfwtd(:) = 0.0
   pwtd(:) = xundef
!
ELSE
!    
  ALLOCATE(pdzg(0,0,0))
  ALLOCATE(pdzdif(0,0,0))
  ALLOCATE(psoilwght(0,0,0))
  DO jpatch=1,kpatch
    WHERE(ppatch(:,jpatch)>0.0)
      prunoffd(:,jpatch) = pdg(:,2,jpatch)
    ENDWHERE
  END DO
!  
  klayer_dun=2
  klayer_hort=2
!
  ALLOCATE(pfwtd(0))
  ALLOCATE(pwtd(0))
!   
ENDIF
!
!Horton (also used by the flooding sheme)
! 
ALLOCATE(pksat_ice(ki,kpatch))
!
IF(hisba/='DIF')THEN
  pd_ice(:,:)=min(pdg(:,2,:),pd_ice(:,:))
  pd_ice(:,:)=max(xice_deph_max,pd_ice(:,:))
  pksat_ice(:,:)=pcondsat(:,1,:)
ELSE
  pd_ice(:,:)=0.0
  pksat_ice(:,:)=0.0
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       8.     Physiographic Radiative fields:  
!               ------------------------------
!
!
!* dry and wet bare soil albedos
!
ALLOCATE(palbnir_dry(ki))
ALLOCATE(palbvis_dry(ki))
ALLOCATE(palbuv_dry(ki))
ALLOCATE(palbnir_wet(ki))
ALLOCATE(palbvis_wet(ki))
ALLOCATE(palbuv_wet(ki))
!
 CALL dry_wet_soil_albedos(psand(:,1),pclay(:,1),                 &
                          pvegtype,                              &
                          palbnir_dry,palbvis_dry,palbuv_dry,    &
                          palbnir_wet,palbvis_wet,palbuv_wet     )  
!
!
!
!*       2.9    Nitrogen version for isbaAgs
!               ------------------------------                        
!
IF (hphoto=='NIT' .OR. hphoto=='NCB') THEN
  ALLOCATE(pbslai_nitro(ki,kpatch              ))
  WHERE ((pce_nitro(:,:)*pcna_nitro(:,:)+pcf_nitro(:,:)) /= 0. )
      pbslai_nitro(:,:) = 1. / (pce_nitro(:,:)*pcna_nitro(:,:)+pcf_nitro(:,:))
  ELSEWHERE
      pbslai_nitro(:,:) = xundef
  ENDWHERE
ELSE
  ALLOCATE(pbslai_nitro(0,0))
ENDIF
!
IF (lhook) CALL dr_hook('INIT_VEG_PGD_n',1,zhook_handle)
!
END SUBROUTINE init_veg_pgd_n