SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/init_veg

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_VEG_PGD_n(HPROGRAM, KLUOUT, KI, KPATCH, KGROUND_LAYER, KMONTH,        &
00003                         PVEGTYPE, PPATCH, PVEGTYPE_PATCH, KSIZE_NATURE_P, KR_NATURE_P,  &
00004                         PRM_PATCH, &
00005                         ODEEPSOIL, OPHYSDOMC, PTDEEP_CLI, PGAMMAT_CLI, PTDEEP, PGAMMAT, &
00006                         OAGRIP, PTHRESHOLD, KIRRINUM, OIRRIDAY, OIRRIGATE, PTHRESHOLDSPT, &
00007                         HPHOTO, HINIT, OTR_ML, KNBIOMASS, PCO2, PRHOA, PABC, PPOI,  &
00008                         PGMES, PGC, PDMAX, PANMAX, PFZERO, PEPSO, PGAMM, PQDGAMM,   &
00009                         PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX,&
00010                         PAH, PBH, PTAU_WOOD, PINCREASE, PTURNOVER,                  &
00011                         KSV, HSV, KBEQ, HSVO, KAEREQ, KSV_CHSBEG, KSV_CHSEND,       &
00012                         KSV_AERBEG, KSV_AEREND, HCH_NAMES, HAER_NAMES, KDSTEQ,      &
00013                         KSV_DSTBEG, KSV_DSTEND, KSLTEQ, KSV_SLTBEG, KSV_SLTEND,     &
00014                         HDSTNAMES, HSLTNAMES, HCHEM_SURF_FILE,                      &
00015                         PSFDST, PSFDSTM, PSFSLT,                                    &
00016                         PAOSIP, PAOSIM, PAOSJP, PAOSJM, PHO2IP, PHO2IM, PHO2JP,     &
00017                         PHO2JM, PZ0, PZ0EFFIP, PZ0EFFIM, PZ0EFFJP, PZ0EFFJM, PZ0REL,&
00018                         PCLAY, PSAND, HPEDOTF,                                      &
00019                         PCONDSAT, PMPOTSAT, PBCOEF, PWWILT, PWFC, PWSAT,            &
00020                         PTAUICE, PCGSAT, PC1SAT, PC2REF, PC3, PC4B, PACOEF, PPCOEF, &
00021                         PC4REF, PPCPS, PPLVTT, PPLSTT,                              &
00022                         HSCOND, HISBA, PHCAPSOIL, PCONDDRY, PCONDSLD, HCPSURF,      &
00023                         PDG, PDROOT, PDG2, PROOTFRAC, PRUNOFFD, PDZG, PDZDIF,       &
00024                         PSOILWGHT, KWG_LAYER, KLAYER_HORT, KLAYER_DUN, PD_ICE,      &
00025                         PKSAT_ICE, PALBNIR_DRY, PALBVIS_DRY, PALBUV_DRY,            &
00026                         PALBNIR_WET, PALBVIS_WET, PALBUV_WET, PBSLAI_NITRO,         &
00027                         PCE_NITRO, PCNA_NITRO, PCF_NITRO                            )  
00028 !#############################################################
00029 !
00030 !!****  *INIT_VEG_PGD_n_n* - routine to initialize ISBA
00031 !!
00032 !!    PURPOSE
00033 !!    -------
00034 !!
00035 !!**  METHOD
00036 !!    ------
00037 !!
00038 !!    EXTERNAL
00039 !!    --------
00040 !!
00041 !!
00042 !!    IMPLICIT ARGUMENTS
00043 !!    ------------------
00044 !!
00045 !!    REFERENCE
00046 !!    ---------
00047 !!
00048 !!
00049 !!    AUTHOR
00050 !!    ------
00051 !!      V. Masson   *Meteo France*      
00052 !!
00053 !!    MODIFICATIONS
00054 !!    -------------
00055 !!
00056 !-------------------------------------------------------------------------------
00057 !
00058 !*       0.    DECLARATIONS
00059 !              ------------
00060 !
00061 USE MODD_SURF_ATM,       ONLY : LCPL_ARP
00062 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
00063 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00064 USE MODD_CSTS,           ONLY : XCPD, XLVTT, XLSTT
00065 USE MODD_SNOW_PAR,       ONLY : XEMISSN
00066 USE MODD_ISBA_PAR,       ONLY : XTAU_ICE
00067 !
00068 USE MODD_SGH_PAR,        ONLY : XICE_DEPH_MAX
00069 !
00070 USE MODI_SURF_PATCH
00071 USE MODI_GET_1D_MASK
00072 USE MODI_CO2_INIT_n
00073 USE MODI_INIT_CHEMICAL_n
00074 USE MODI_OPEN_NAMELIST
00075 USE MODI_CH_INIT_DEP_ISBA_n
00076 USE MODI_CLOSE_NAMELIST
00077 USE MODI_INIT_DST
00078 USE MODI_INIT_SLT
00079 USE MODI_SUBSCALE_Z0EFF
00080 !
00081 USE MODE_SOIL
00082 !
00083 USE MODI_HEATCAPZ
00084 USE MODI_THRMCONDZ
00085 USE MODI_ABOR1_SFX
00086 USE MODI_DIF_LAYER
00087 USE MODI_DRY_WET_SOIL_ALBEDOS
00088 !
00089 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00090 USE PARKIND1  ,ONLY : JPRB
00091 !
00092 IMPLICIT NONE
00093 !
00094 !*       0.1   Declarations of arguments
00095 !              -------------------------
00096 !
00097  CHARACTER(LEN=6), INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00098 INTEGER, INTENT(IN)  :: KLUOUT
00099 !
00100 INTEGER, INTENT(IN)  :: KI
00101 INTEGER, INTENT(IN)  :: KPATCH
00102 INTEGER, INTENT(IN)  :: KGROUND_LAYER
00103 INTEGER, INTENT(IN)  :: KMONTH
00104 !
00105 REAL, DIMENSION(:,:), POINTER :: PVEGTYPE
00106 REAL, DIMENSION(:,:), POINTER :: PPATCH
00107 REAL, DIMENSION(:,:,:), POINTER :: PVEGTYPE_PATCH
00108 INTEGER, DIMENSION(:), POINTER :: KSIZE_NATURE_P
00109 INTEGER, DIMENSION(:,:), POINTER :: KR_NATURE_P
00110 !
00111 REAL, INTENT(IN) :: PRM_PATCH
00112 !
00113 LOGICAL, INTENT(IN) :: ODEEPSOIL
00114 LOGICAL, INTENT(IN) :: OPHYSDOMC
00115 REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_CLI
00116 REAL, DIMENSION(:), INTENT(IN) :: PGAMMAT_CLI
00117 REAL, DIMENSION(:), POINTER :: PTDEEP
00118 REAL, DIMENSION(:), POINTER :: PGAMMAT
00119 !
00120 LOGICAL, INTENT(IN) :: OAGRIP
00121 REAL, DIMENSION(:), INTENT(IN) :: PTHRESHOLD
00122 INTEGER, DIMENSION(:,:), POINTER :: KIRRINUM
00123 LOGICAL, DIMENSION(:,:), POINTER :: OIRRIDAY
00124 LOGICAL, DIMENSION(:,:), POINTER :: OIRRIGATE
00125 REAL, DIMENSION(:,:), POINTER :: PTHRESHOLDSPT
00126 !
00127  CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
00128  CHARACTER(LEN=3), INTENT(IN) :: HINIT
00129 LOGICAL, INTENT(IN) :: OTR_ML
00130 INTEGER, INTENT(IN) :: KNBIOMASS
00131 REAL, DIMENSION(:), INTENT(IN) :: PCO2
00132 REAL, DIMENSION(:), INTENT(IN) :: PRHOA
00133 REAL, DIMENSION(:), POINTER :: PABC
00134 REAL, DIMENSION(:), POINTER :: PPOI
00135 REAL, DIMENSION(:,:), INTENT(IN) :: PGMES
00136 REAL, DIMENSION(:,:), INTENT(IN) :: PGC
00137 REAL, DIMENSION(:,:), INTENT(IN):: PDMAX
00138 REAL, DIMENSION(:,:), POINTER :: PANMAX
00139 REAL, DIMENSION(:,:), POINTER :: PFZERO
00140 REAL, DIMENSION(:,:), POINTER :: PEPSO
00141 REAL, DIMENSION(:,:), POINTER :: PGAMM
00142 REAL, DIMENSION(:,:), POINTER :: PQDGAMM
00143 REAL, DIMENSION(:,:), POINTER :: PQDGMES
00144 REAL, DIMENSION(:,:), POINTER :: PT1GMES
00145 REAL, DIMENSION(:,:), POINTER :: PT2GMES
00146 REAL, DIMENSION(:,:), POINTER :: PAMAX
00147 REAL, DIMENSION(:,:), POINTER :: PQDAMAX
00148 REAL, DIMENSION(:,:), POINTER :: PT1AMAX
00149 REAL, DIMENSION(:,:), POINTER :: PT2AMAX
00150 REAL, DIMENSION(:,:), POINTER :: PAH
00151 REAL, DIMENSION(:,:), POINTER :: PBH
00152 REAL, DIMENSION(:,:), POINTER :: PTAU_WOOD
00153 REAL, DIMENSION(:,:,:), POINTER :: PINCREASE
00154 REAL, DIMENSION(:,:,:), POINTER :: PTURNOVER
00155 !
00156 INTEGER,                          INTENT(IN) :: KSV      ! number of scalars
00157  CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV      ! name of all scalar variables
00158 INTEGER,                         INTENT(OUT) :: KBEQ     ! number of chemical variables
00159  CHARACTER(LEN=6), DIMENSION(:), POINTER :: HSVO          ! name of scalar species without # and @
00160 INTEGER,                         INTENT(OUT) :: KAEREQ  ! number of aerosol variables
00161 INTEGER,                         INTENT(OUT) :: KSV_CHSBEG  ! first chemical var.
00162 INTEGER,                         INTENT(OUT) :: KSV_CHSEND  ! last  chemical var.
00163 INTEGER,                         INTENT(OUT) :: KSV_AERBEG  ! first aerosol var.
00164 INTEGER,                         INTENT(OUT) :: KSV_AEREND  ! last  aerosol var.
00165  CHARACTER(LEN=6), DIMENSION(:), POINTER :: HCH_NAMES
00166  CHARACTER(LEN=6), DIMENSION(:), POINTER :: HAER_NAMES     
00167 INTEGER,                         INTENT(OUT) :: KDSTEQ     ! number of chemical variables
00168 INTEGER,                         INTENT(OUT) :: KSV_DSTBEG  ! first chemical var.
00169 INTEGER,                         INTENT(OUT) :: KSV_DSTEND  ! last  chemical var.
00170 INTEGER,                         INTENT(OUT) :: KSLTEQ     ! number of chemical variables
00171 INTEGER,                         INTENT(OUT) :: KSV_SLTBEG  ! first chemical var.
00172 INTEGER,                         INTENT(OUT) :: KSV_SLTEND  ! last  chemical var.
00173  CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HDSTNAMES
00174  CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HSLTNAMES
00175 !
00176  CHARACTER(LEN=28), INTENT(OUT) :: HCHEM_SURF_FILE
00177 !
00178 REAL, DIMENSION(:,:,:), POINTER :: PSFDST
00179 REAL, DIMENSION(:,:,:), POINTER :: PSFDSTM
00180 REAL, DIMENSION(:,:,:), POINTER :: PSFSLT
00181 !
00182 REAL, DIMENSION(:), INTENT(IN) :: PAOSIP
00183 REAL, DIMENSION(:), INTENT(IN) :: PAOSIM
00184 REAL, DIMENSION(:), INTENT(IN) :: PAOSJP
00185 REAL, DIMENSION(:), INTENT(IN) :: PAOSJM
00186 REAL, DIMENSION(:), INTENT(IN) :: PHO2IP
00187 REAL, DIMENSION(:), INTENT(IN) :: PHO2IM
00188 REAL, DIMENSION(:), INTENT(IN) :: PHO2JP
00189 REAL, DIMENSION(:), INTENT(IN) :: PHO2JM
00190 REAL, DIMENSION(:,:), INTENT(IN) :: PZ0
00191 REAL, DIMENSION(:,:), POINTER :: PZ0EFFIP
00192 REAL, DIMENSION(:,:), POINTER :: PZ0EFFIM
00193 REAL, DIMENSION(:,:), POINTER :: PZ0EFFJP
00194 REAL, DIMENSION(:,:), POINTER :: PZ0EFFJM
00195 REAL, DIMENSION(:), POINTER :: PZ0REL
00196 !
00197 REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY
00198 REAL, DIMENSION(:,:), INTENT(IN) :: PSAND
00199  CHARACTER(LEN=4), INTENT(IN) :: HPEDOTF
00200 REAL, DIMENSION(:,:,:), POINTER :: PCONDSAT
00201 REAL, DIMENSION(:,:), POINTER :: PMPOTSAT
00202 REAL, DIMENSION(:,:), POINTER :: PBCOEF
00203 REAL, DIMENSION(:,:), POINTER :: PWWILT
00204 REAL, DIMENSION(:,:), POINTER :: PWFC
00205 REAL, DIMENSION(:,:), POINTER :: PWSAT
00206 REAL, DIMENSION(:), POINTER :: PTAUICE
00207 REAL, DIMENSION(:), POINTER :: PCGSAT
00208 REAL, DIMENSION(:,:), POINTER :: PC1SAT
00209 REAL, DIMENSION(:,:), POINTER :: PC2REF
00210 REAL, DIMENSION(:,:,:), POINTER :: PC3
00211 REAL, DIMENSION(:), POINTER :: PC4B
00212 REAL, DIMENSION(:), POINTER :: PACOEF
00213 REAL, DIMENSION(:), POINTER :: PPCOEF
00214 REAL, DIMENSION(:,:), POINTER :: PC4REF
00215 !
00216 REAL, DIMENSION(:,:), POINTER :: PPCPS
00217 REAL, DIMENSION(:,:), POINTER :: PPLVTT
00218 REAL, DIMENSION(:,:), POINTER :: PPLSTT
00219 !
00220  CHARACTER(LEN=4), INTENT(IN) :: HSCOND
00221  CHARACTER(LEN=3), INTENT(IN) :: HISBA
00222 REAL, DIMENSION(:,:), POINTER :: PHCAPSOIL
00223 REAL, DIMENSION(:,:), POINTER :: PCONDDRY
00224 REAL, DIMENSION(:,:), POINTER :: PCONDSLD
00225  CHARACTER(LEN=3), INTENT(IN) :: HCPSURF
00226 !
00227 REAL, DIMENSION(:,:,:), INTENT(IN) :: PDG
00228 REAL, DIMENSION(:,:), INTENT(IN) :: PDROOT
00229 REAL, DIMENSION(:,:), INTENT(IN) :: PDG2
00230 REAL, DIMENSION(:,:,:), INTENT(IN) :: PROOTFRAC
00231 REAL, DIMENSION(:,:), POINTER :: PRUNOFFD
00232 REAL, DIMENSION(:,:,:), POINTER :: PDZG
00233 REAL, DIMENSION(:,:,:), POINTER :: PDZDIF
00234 REAL, DIMENSION(:,:,:), POINTER :: PSOILWGHT
00235 INTEGER, DIMENSION(:,:), INTENT(IN) :: KWG_LAYER
00236 INTEGER, INTENT(OUT) :: KLAYER_HORT
00237 INTEGER, INTENT(OUT) :: KLAYER_DUN
00238 !
00239 REAL, DIMENSION(:,:), INTENT(INOUT) :: PD_ICE
00240 REAL, DIMENSION(:,:), POINTER :: PKSAT_ICE
00241 !
00242 REAL, DIMENSION(:), POINTER :: PALBNIR_DRY
00243 REAL, DIMENSION(:), POINTER :: PALBVIS_DRY
00244 REAL, DIMENSION(:), POINTER :: PALBUV_DRY
00245 REAL, DIMENSION(:), POINTER :: PALBNIR_WET
00246 REAL, DIMENSION(:), POINTER :: PALBVIS_WET
00247 REAL, DIMENSION(:), POINTER :: PALBUV_WET
00248 !
00249 REAL, DIMENSION(:,:), POINTER :: PBSLAI_NITRO
00250 REAL, DIMENSIOn(:,:), INTENT(IN) :: PCE_NITRO
00251 REAL, DIMENSIOn(:,:), INTENT(IN) :: PCNA_NITRO
00252 REAL, DIMENSIOn(:,:), INTENT(IN) :: PCF_NITRO
00253 !
00254 !*       0.2   Declarations of local variables
00255 !              -------------------------------
00256 !
00257 INTEGER :: JPATCH  ! loop counter on tiles
00258 INTEGER :: JILU,JP, JMAXLOC    ! loop increment
00259 INTEGER :: JLAYER  ! loop counter on layers
00260 !
00261 INTEGER :: ICH     ! unit of input chemistry file
00262 INTEGER :: ISIZE
00263 !
00264 REAL, DIMENSION(SIZE(PCO2))       :: ZCO2  ! CO2 concentration  (kg/kg)
00265 !
00266 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00267 !
00268 !-------------------------------------------------------------------------------
00269 !
00270 !               Initialisation for IO
00271 !
00272 IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_n',0,ZHOOK_HANDLE)
00273 !
00274 !*       2.4    Fraction of each tile
00275 !               ---------------------
00276 !
00277 ALLOCATE(PPATCH         (KI,KPATCH))
00278 ALLOCATE(PVEGTYPE_PATCH (KI,NVEGTYPE,KPATCH))
00279 ALLOCATE(KSIZE_NATURE_P (KPATCH))
00280 ALLOCATE(KR_NATURE_P    (KI,KPATCH))
00281 !
00282  CALL SURF_PATCH(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
00283 !
00284 !*       2.5    Masks for tiles
00285 !               ---------------
00286 !
00287 IF (PRM_PATCH/=0.) THEN
00288   !
00289   WRITE(KLUOUT,*) " REMOVE PATCH below 5 % add to dominant patch " 
00290   ! remove small fraction of PATCHES and add to MAIN PATCH
00291   DO JP = 1,KI
00292     !1) find most present patch maximum value 
00293     JMAXLOC = MAXVAL(MAXLOC(PPATCH(JP,:)))
00294     !2) FIND small value of cover 
00295     DO JPATCH = 1,KPATCH
00296       IF ( PPATCH(JP,JPATCH)<PRM_PATCH ) THEN
00297         PPATCH(JP,JMAXLOC) = PPATCH(JP,JMAXLOC) + PPATCH(JP,JPATCH)
00298         PPATCH(JP,JPATCH) = 0.0
00299        ENDIF
00300     ENDDO
00301   ENDDO
00302   !
00303 ENDIF
00304 !
00305 DO JPATCH=1,KPATCH
00306   KSIZE_NATURE_P(JPATCH) = COUNT(PPATCH(:,JPATCH) > 0.0)
00307 ENDDO
00308 !
00309 KR_NATURE_P(:,:) = 0
00310 DO JPATCH=1,KPATCH
00311   CALL GET_1D_MASK(KSIZE_NATURE_P(JPATCH),KI,PPATCH(:,JPATCH),KR_NATURE_P(:KSIZE_NATURE_P(JPATCH),JPATCH))
00312 ENDDO
00313 !
00314 !
00315 !*       2.6    Miscellaneous fields for ISBA:
00316 !               -----------------------------
00317 !
00318 !* default value for:
00319 ! lateral water flux, deep soil temperature climatology and its relaxation time-scale
00320 !
00321 ALLOCATE(PTDEEP (KI))
00322 ALLOCATE(PGAMMAT(KI))
00323 PTDEEP (:) = XUNDEF
00324 PGAMMAT(:) = XUNDEF
00325 !
00326 IF (ODEEPSOIL) THEN
00327    DO JILU = 1, KI
00328       PTDEEP (JILU) = PTDEEP_CLI (KMONTH)
00329       PGAMMAT(JILU) = 1. / PGAMMAT_CLI(KMONTH)
00330    END DO
00331    !
00332    WRITE(KLUOUT,*)' LDEEPSOIL = ',ODEEPSOIL,' LPHYSDOMC = ',OPHYSDOMC
00333    WRITE(KLUOUT,*)' XTDEEP    = ',MINVAL(PTDEEP(:)),MAXVAL(PTDEEP(:))
00334    WRITE(KLUOUT,*)' XGAMMAT   = ',MINVAL(PGAMMAT(:)),MAXVAL(PGAMMAT(:))
00335 ENDIF
00336 !
00337 !
00338 !*       2.7    Irrigation
00339 !               ----------
00340 !
00341 IF (OAGRIP) THEN
00342    ALLOCATE(KIRRINUM(KI,KPATCH))
00343    ALLOCATE(OIRRIDAY(KI,KPATCH))
00344    ALLOCATE(OIRRIGATE(KI,KPATCH))
00345    ALLOCATE(PTHRESHOLDSPT(KI,KPATCH))
00346    !
00347    KIRRINUM (:,:) = 1
00348    OIRRIDAY (:,:) = .FALSE.                          
00349    OIRRIGATE(:,:) = .FALSE.                          
00350    !
00351    DO JILU = 1, KI
00352       DO JPATCH = 1, KPATCH
00353          PTHRESHOLDSPT(JILU,JPATCH) = PTHRESHOLD(KIRRINUM(JILU,JPATCH))
00354       END DO
00355    END DO
00356 ELSE
00357    ALLOCATE(KIRRINUM(0,0))
00358    ALLOCATE(OIRRIDAY(0,0))
00359    ALLOCATE(OIRRIGATE(0,0))
00360    ALLOCATE(PTHRESHOLDSPT(0,0))
00361 ENDIF
00362 !
00363 !
00364 !*       2.8    Additional fields for ISBA-AGS:
00365 !               ------------------------------                        
00366 !
00367 IF(HPHOTO /= 'NON' .AND. HINIT == 'ALL') THEN
00368   IF (OTR_ML) THEN
00369     ISIZE = 10
00370   ELSE
00371     ISIZE = 3
00372   ENDIF
00373   ALLOCATE(PABC(ISIZE))
00374   ALLOCATE(PPOI(ISIZE))
00375   PABC(:) = 0.
00376   PPOI(:) = 0.          
00377   ZCO2(:) = PCO2(:) / PRHOA(:)
00378   ALLOCATE(PANMAX        (KI,KPATCH))
00379   ALLOCATE(PFZERO        (KI,KPATCH))
00380   ALLOCATE(PEPSO         (KI,KPATCH))
00381   ALLOCATE(PGAMM         (KI,KPATCH))
00382   ALLOCATE(PQDGAMM       (KI,KPATCH))
00383   ALLOCATE(PQDGMES       (KI,KPATCH))
00384   ALLOCATE(PT1GMES       (KI,KPATCH))
00385   ALLOCATE(PT2GMES       (KI,KPATCH))
00386   ALLOCATE(PAMAX         (KI,KPATCH))
00387   ALLOCATE(PQDAMAX       (KI,KPATCH))
00388   ALLOCATE(PT1AMAX       (KI,KPATCH))
00389   ALLOCATE(PT2AMAX       (KI,KPATCH))
00390   ALLOCATE(PAH           (KI,KPATCH))
00391   ALLOCATE(PBH           (KI,KPATCH))
00392   ALLOCATE(PTAU_WOOD     (KI,KPATCH))
00393   ALLOCATE(PINCREASE     (KI,KNBIOMASS,KPATCH))
00394   ALLOCATE(PTURNOVER     (KI,KNBIOMASS,KPATCH))
00395   CALL CO2_INIT_n(HPHOTO, KSIZE_NATURE_P, KR_NATURE_P, PVEGTYPE_PATCH, &
00396                   ZCO2, PGMES, PGC, PDMAX, PABC, PPOI, PANMAX, &
00397                   PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES,      &
00398                   PT1GMES, PT2GMES, PAMAX, PQDAMAX,            &
00399                   PT1AMAX, PT2AMAX, PAH, PBH, PTAU_WOOD,       &
00400                   PINCREASE, PTURNOVER                         )
00401 ELSE
00402   ALLOCATE(PABC(0))
00403   ALLOCATE(PPOI(0))
00404   ALLOCATE(PANMAX        (0,0))
00405   ALLOCATE(PFZERO        (0,0))
00406   ALLOCATE(PEPSO         (0,0))
00407   ALLOCATE(PGAMM         (0,0))
00408   ALLOCATE(PQDGAMM       (0,0))
00409   ALLOCATE(PQDGMES       (0,0))
00410   ALLOCATE(PT1GMES       (0,0))
00411   ALLOCATE(PT2GMES       (0,0))
00412   ALLOCATE(PAMAX         (0,0))
00413   ALLOCATE(PQDAMAX       (0,0))
00414   ALLOCATE(PT1AMAX       (0,0))
00415   ALLOCATE(PT2AMAX       (0,0))
00416   ALLOCATE(PAH           (0,0))
00417   ALLOCATE(PBH           (0,0))
00418   ALLOCATE(PTAU_WOOD     (0,0))
00419   ALLOCATE(PINCREASE     (0,0,0))
00420   ALLOCATE(PTURNOVER     (0,0,0))  
00421 END IF
00422 !
00423 !-------------------------------------------------------------------------------
00424 !
00425 !        3.  Initialize Chemical Deposition
00426 !            ------------------------------
00427 !
00428 !        3.1 Chemical gazes
00429 !            --------------
00430 !
00431  CALL INIT_CHEMICAL_n(KLUOUT, KSV, HSV, KBEQ, HSVO, KAEREQ,           &
00432                      KSV_CHSBEG, KSV_CHSEND, KSV_AERBEG, KSV_AEREND, &
00433                      HCH_NAMES, HAER_NAMES, KDSTEQ, KSV_DSTBEG,      &
00434                      KSV_DSTEND, KSLTEQ, KSV_SLTBEG, KSV_SLTEND,     &
00435                      HDSTNAMES=HDSTNAMES, HSLTNAMES=HSLTNAMES        )
00436 !
00437 IF (KSV /= 0) THEN
00438   !
00439   IF (KBEQ > 0) THEN
00440     CALL OPEN_NAMELIST(HPROGRAM, ICH, HFILE=HCHEM_SURF_FILE)
00441     CALL CH_INIT_DEP_ISBA_n(ICH, KLUOUT, HSVO, KI)
00442     CALL CLOSE_NAMELIST(HPROGRAM, ICH)
00443   END IF
00444   !
00445   IF (KDSTEQ >=1) THEN
00446     ALLOCATE (PSFDST (KI, KDSTEQ, KPATCH))  !Output array
00447     ALLOCATE (PSFDSTM(KI, KDSTEQ, KPATCH))  !Output array
00448     PSFDST(:,:,:)  = 0.
00449     PSFDSTM(:,:,:) = 0.     
00450     CALL INIT_DST(HPROGRAM,KSIZE_NATURE_P,KR_NATURE_P, &
00451                   KPATCH,PVEGTYPE_PATCH)    
00452   ELSE
00453     ALLOCATE(PSFDST (0,0,0))
00454     ALLOCATE(PSFDSTM(0,0,0))
00455   END IF
00456   !
00457   IF (KSLTEQ >=1) THEN
00458     ALLOCATE (PSFSLT(KI,KSLTEQ,KPATCH))  !Output array
00459     CALL INIT_SLT(HPROGRAM)   
00460   ELSE
00461     ALLOCATE(PSFSLT(0,0,0))
00462   END IF
00463   !
00464 ENDIF
00465 !
00466 !-------------------------------------------------------------------------------
00467 !
00468 !*       4.     Orographic roughness length
00469 !               ---------------------------
00470 !
00471 ALLOCATE(PZ0EFFIP(KI,KPATCH))
00472 ALLOCATE(PZ0EFFIM(KI,KPATCH))
00473 ALLOCATE(PZ0EFFJP(KI,KPATCH))
00474 ALLOCATE(PZ0EFFJM(KI,KPATCH))
00475 ALLOCATE(PZ0REL  (KI))
00476 !
00477 IF (SIZE(PAOSIP)>0)                                      &
00478  CALL SUBSCALE_Z0EFF(PAOSIP,PAOSIM,PAOSJP,PAOSJM,         &
00479                     PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0,     &
00480                     PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
00481                     PZ0REL                               ) 
00482 !
00483 !-------------------------------------------------------------------------------
00484 !
00485 !*       5.1     Soil hydraulic characteristics:
00486 !                -------------------------------
00487 !
00488 ALLOCATE(PCONDSAT (KI,KGROUND_LAYER,KPATCH))
00489 ALLOCATE(PMPOTSAT (KI,KGROUND_LAYER))
00490 ALLOCATE(PBCOEF   (KI,KGROUND_LAYER))
00491 ALLOCATE(PWWILT   (KI,KGROUND_LAYER)) ! wilting point
00492 ALLOCATE(PWFC     (KI,KGROUND_LAYER)) ! field capacity
00493 ALLOCATE(PWSAT    (KI,KGROUND_LAYER)) ! saturation
00494 ALLOCATE(PTAUICE  (KI))
00495 !        
00496 DO JLAYER=1,KGROUND_LAYER
00497    PBCOEF  (:,JLAYER) = BCOEF_FUNC     (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
00498    PMPOTSAT(:,JLAYER) = MATPOTSAT_FUNC (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
00499    DO JPATCH=1,KPATCH
00500       PCONDSAT(:,JLAYER,JPATCH) = HYDCONDSAT_FUNC(PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
00501    ENDDO   
00502    PWSAT (:,JLAYER) = WSAT_FUNC (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
00503    PWWILT(:,JLAYER) = WWILT_FUNC(PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
00504 END DO
00505 !
00506 IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
00507   !  field capacity at hydraulic conductivity = 0.1mm/day
00508   PWFC  (:,:) = WFC_FUNC  (PCLAY(:,:),PSAND(:,:),HPEDOTF)
00509 ELSE IF (HISBA=='DIF') THEN
00510   !  field capacity at water potential = 0.33bar        
00511   PWFC  (:,:) = W33_FUNC  (PCLAY(:,:),PSAND(:,:),HPEDOTF)
00512 END IF
00513 !
00514 PTAUICE(:) = XTAU_ICE
00515 !
00516 IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
00517   ALLOCATE(PCGSAT (KI))
00518   ALLOCATE(PC1SAT (KI,KPATCH))
00519   ALLOCATE(PC2REF (KI,KPATCH))
00520   ALLOCATE(PC3    (KI,2,KPATCH))
00521   ALLOCATE(PC4B   (KI))
00522   ALLOCATE(PACOEF (KI))
00523   ALLOCATE(PPCOEF (KI))
00524   ALLOCATE(PC4REF (KI,KPATCH))
00525   PCGSAT(:)  = CGSAT_FUNC(PCLAY(:,1),PSAND(:,1))
00526   PC4B(:)    = C4B_FUNC(PCLAY(:,1))
00527   !
00528   PACOEF(:)  = ACOEF_FUNC(PCLAY(:,1))
00529   PPCOEF(:)  = PCOEF_FUNC(PCLAY(:,1))
00530   !
00531   DO JPATCH=1,KPATCH
00532     PC1SAT(:,JPATCH) = C1SAT_FUNC(PCLAY(:,1))
00533     PC2REF(:,JPATCH) = C2REF_FUNC(PCLAY(:,1))         
00534     PC4REF(:,JPATCH) = C4REF_FUNC(PCLAY(:,1),PSAND(:,1),       &
00535                                   PDG(:,2,            JPATCH), &
00536                                   PDG(:,KGROUND_LAYER,JPATCH)  )
00537     PC3     (:,1,JPATCH) = C3_FUNC(PCLAY(:,1))
00538     PC3     (:,2,JPATCH) = C3_FUNC(PCLAY(:,2))
00539 
00540   END DO
00541   !
00542 ELSE IF (HISBA=='DIF') THEN
00543   !
00544   ALLOCATE(PCGSAT (0))
00545   ALLOCATE(PC1SAT (0,0))
00546   ALLOCATE(PC2REF (0,0))
00547   ALLOCATE(PC3    (0,0,0))
00548   ALLOCATE(PC4B   (0))
00549   ALLOCATE(PC4REF (0,0))
00550   ALLOCATE(PACOEF (0))
00551   ALLOCATE(PPCOEF (0))
00552   !
00553 END IF
00554 !
00555 !*       5.2     Soil thermal characteristics:
00556 !               --------------------------------
00557 !
00558 ALLOCATE(PPCPS (KI,KPATCH))
00559 ALLOCATE(PPLVTT(KI,KPATCH))
00560 ALLOCATE(PPLSTT(KI,KPATCH))
00561 PPCPS (:,:) = XCPD
00562 PPLVTT(:,:) = XLVTT
00563 PPLSTT(:,:) = XLSTT
00564 !
00565 !CSCOND used in soil.F90 and soildif.F90
00566 IF (HSCOND=='PL98'.OR.HISBA=='DIF') THEN
00567   ALLOCATE(PHCAPSOIL(KI,KGROUND_LAYER))
00568   ! 
00569   CALL HEATCAPZ(PSAND,PWSAT,PHCAPSOIL)
00570   !
00571   IF (HSCOND=='PL98') THEN
00572     !
00573     ALLOCATE(PCONDDRY (KI,KGROUND_LAYER))
00574     ALLOCATE(PCONDSLD (KI,KGROUND_LAYER))
00575     ! 
00576     CALL THRMCONDZ(PSAND,PWSAT,PCONDDRY,PCONDSLD)
00577     !
00578   ELSE
00579     !
00580     ALLOCATE(PCONDDRY (0,0))
00581     ALLOCATE(PCONDSLD (0,0))
00582     !
00583   ENDIF
00584   !
00585 ELSE
00586   ALLOCATE(PHCAPSOIL(0,0))
00587   ALLOCATE(PCONDDRY (0,0))
00588   ALLOCATE(PCONDSLD (0,0))
00589 END IF
00590 !
00591 !-------------------------------------------------------------------------------
00592 !CPSURF used in drag.F90
00593 !CPL_ARP used in drag.F90 and e_budget.F90
00594 IF(HCPSURF=='DRY'.AND.LCPL_ARP) THEN
00595   CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
00596 ENDIF
00597 !
00598 !*       6.1    Initialize hydrology
00599 !               --------------------
00600 !
00601 ALLOCATE(PRUNOFFD (KI,KPATCH))
00602 PRUNOFFD(:,:)=XUNDEF
00603 !
00604 IF (HISBA == 'DIF') THEN
00605 !  
00606   ALLOCATE(PDZG       (KI,KGROUND_LAYER,KPATCH))
00607   ALLOCATE(PDZDIF     (KI,KGROUND_LAYER,KPATCH))
00608   ALLOCATE(PSOILWGHT  (KI,KGROUND_LAYER,KPATCH))
00609   CALL DIF_LAYER(KI, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
00610                  PPATCH, PDG, PDROOT, PDG2, PROOTFRAC,      &
00611                  KWG_LAYER, PDZG, PDZDIF, PSOILWGHT,        &
00612                  PRUNOFFD, KLAYER_HORT, KLAYER_DUN  )
00613 !
00614 ELSE
00615 !    
00616   ALLOCATE(PDZG       (0,0,0))
00617   ALLOCATE(PDZDIF     (0,0,0))
00618   ALLOCATE(PSOILWGHT  (0,0,0))
00619   DO JPATCH=1,KPATCH
00620     WHERE(PPATCH(:,JPATCH)>0.0)
00621       PRUNOFFD(:,JPATCH) = PDG(:,2,JPATCH)
00622     ENDWHERE
00623   END DO
00624 !  
00625   KLAYER_DUN=2
00626   KLAYER_HORT=2
00627 !   
00628 ENDIF
00629 !
00630 !Horton (also used by the flooding sheme)
00631 ! 
00632 ALLOCATE(PKSAT_ICE(KI,KPATCH))
00633 !
00634 IF(HISBA/='DIF')THEN
00635   PD_ICE   (:,:)=MIN(PDG(:,2,:),PD_ICE(:,:))
00636   PD_ICE   (:,:)=MAX(XICE_DEPH_MAX,PD_ICE(:,:))
00637   PKSAT_ICE(:,:)=PCONDSAT(:,1,:)
00638 ELSE
00639   PD_ICE   (:,:)=0.0
00640   PKSAT_ICE(:,:)=0.0
00641 ENDIF
00642 !
00643 !-------------------------------------------------------------------------------
00644 !
00645 !*       8.     Physiographic Radiative fields:  
00646 !               ------------------------------
00647 !
00648 !
00649 !* dry and wet bare soil albedos
00650 !
00651 ALLOCATE(PALBNIR_DRY  (KI))
00652 ALLOCATE(PALBVIS_DRY  (KI))
00653 ALLOCATE(PALBUV_DRY   (KI))
00654 ALLOCATE(PALBNIR_WET  (KI))
00655 ALLOCATE(PALBVIS_WET  (KI))
00656 ALLOCATE(PALBUV_WET   (KI))
00657 !
00658  CALL DRY_WET_SOIL_ALBEDOS(PSAND(:,1),PCLAY(:,1),                 &
00659                           PVEGTYPE,                              &
00660                           PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY,    &
00661                           PALBNIR_WET,PALBVIS_WET,PALBUV_WET     )  
00662 !
00663 !
00664 !
00665 !*       2.9    Nitrogen version for isbaAgs
00666 !               ------------------------------                        
00667 !
00668 IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
00669   ALLOCATE(PBSLAI_NITRO            (KI,KPATCH              ))
00670   WHERE ((PCE_NITRO (:,:)*PCNA_NITRO(:,:)+PCF_NITRO (:,:)) /= 0. )
00671       PBSLAI_NITRO(:,:) = 1. / (PCE_NITRO (:,:)*PCNA_NITRO(:,:)+PCF_NITRO (:,:))
00672   ELSEWHERE
00673       PBSLAI_NITRO(:,:) = XUNDEF
00674   ENDWHERE
00675 ELSE
00676   ALLOCATE(PBSLAI_NITRO (0,0))
00677 ENDIF
00678 !
00679 IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_n',1,ZHOOK_HANDLE)
00680 !
00681 END SUBROUTINE INIT_VEG_PGD_n