|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !################## 00002 MODULE MODD_TEB_GARDEN_n 00003 !################## 00004 ! 00005 !!**** *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !! 00011 !!** IMPLICIT ARGUMENTS 00012 !! ------------------ 00013 !! None 00014 !! 00015 !! REFERENCE 00016 !! --------- 00017 !! 00018 !! AUTHOR 00019 !! ------ 00020 !! A. Lemonsu *Meteo France* 00021 !! 00022 !! MODIFICATIONS 00023 !! ------------- 00024 !! Original 01/2011 00025 !! 00026 !------------------------------------------------------------------------------- 00027 ! 00028 !* 0. DECLARATIONS 00029 ! ------------ 00030 ! 00031 USE MODD_TYPE_SNOW 00032 ! 00033 ! 00034 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00035 USE PARKIND1 ,ONLY : JPRB 00036 ! 00037 IMPLICIT NONE 00038 00039 TYPE TEB_GARDEN_OPTIONS_t 00040 !------------------------------------------------------------------------------- 00041 ! 00042 ! type of initialization of vegetation: from cover types (ecoclimap) or parameters prescribed 00043 ! 00044 LOGICAL :: LPAR_GARDEN ! T: parameters computed from ecoclimap 00045 ! ! F: they are read in the file 00046 ! 00047 ! Number of inside garden vegetation (not TEB) patches and of layers 00048 ! 00049 ! 00050 INTEGER :: NGROUND_LAYER ! number of ground layers 00051 ! 00052 INTEGER :: NLAYER_HORT 00053 INTEGER :: NLAYER_DUN 00054 ! 00055 REAL, POINTER, DIMENSION(:) :: XSOILGRID ! Soil layer grid as reference for DIF 00056 ! 00057 END TYPE TEB_GARDEN_OPTIONS_t 00058 !------------------------------------------------------------------------------- 00059 TYPE TEB_GARDEN_PGD_t 00060 !------------------------------------------------------------------------------- 00061 ! 00062 ! Mask and number of grid elements containing patches/tiles: 00063 ! 00064 REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE ! fraction of each vegetation type for 00065 ! ! each grid mesh (-) 00066 !------------------------------------------------------------------------------- 00067 ! 00068 ! Averaged Surface radiative parameters: 00069 ! 00070 REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-) 00071 REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-) 00072 REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-) 00073 REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-) 00074 REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-) 00075 REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-) 00076 REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-) 00077 REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-) 00078 REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo (-) 00079 REAL, POINTER, DIMENSION(:) :: XALBNIR_TSOIL ! total near-infra-red albedo of wet soil (-) 00080 REAL, POINTER, DIMENSION(:) :: XALBVIS_TSOIL ! total visible albedo of soil (-) 00081 ! 00082 !------------------------------------------------------------------------------- 00083 ! 00084 ! Input Parameters, per patch: 00085 ! 00086 ! - vegetation + bare soil: 00087 ! 00088 REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths 00089 ! ! (momentum to heat) (-) 00090 ! 00091 ! - vegetation: 00092 ! 00093 REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-) 00094 REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-) 00095 REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-) 00096 REAL, POINTER, DIMENSION(:) :: XALBNIR_TVEG ! total near-infra-red albedo of vegetation (-) 00097 REAL, POINTER, DIMENSION(:) :: XALBVIS_TVEG ! total visible albedo of vegetation (-) 00098 ! 00099 ! - vegetation: default option (Jarvis) and general parameters: 00100 ! 00101 REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water 00102 ! ! interception 00103 ! ! storage capacity on the vegetation (-) 00104 REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m) 00105 REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation 00106 ! ! of the surface stomatal 00107 ! ! resistance 00108 REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J) 00109 REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation 00110 ! ! usable in photosynthesis (W/m2) 00111 REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option) 00112 ! 00113 !------------------------------------------------------------------------------- 00114 ! 00115 ! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options) 00116 ! 00117 ! REAL, DIMENSION(3) :: XABC ! abscissa needed for integration 00118 REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration 00119 ! ! of net assimilation and stomatal 00120 ! ! conductance over canopy depth (-) 00121 ! REAL, DIMENSION(3) :: XPOI ! Gaussian weights for integration 00122 REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration 00123 ! ! of net assimilation and stomatal 00124 ! ! conductance over canopy depth (-) 00125 REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2) 00126 REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2) 00127 REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s) 00128 REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m) 00129 REAL, POINTER, DIMENSION(:) :: XANF ! total assimilation over canopy ( 00130 REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate ( 00131 REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo- 00132 ! ! respiration or saturation deficit ( 00133 REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use 00134 ! ! efficiency (mg J-1 PAR) 00135 REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm) 00136 REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation 00137 ! ! concentration (-) 00138 REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1) 00139 REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1) 00140 REAL, POINTER, DIMENSION(:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-) 00141 REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing 00142 ! ! compensation concentration function for 00143 ! ! mesophyll conductance: minimum 00144 ! ! temperature (K) 00145 REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing 00146 ! ! compensation concentration function for 00147 ! ! mesophyll conductance: maximum 00148 ! ! temperature (K) 00149 REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1) 00150 REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic 00151 ! ! capacity (-) 00152 REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing 00153 ! ! compensation concentration function for 00154 ! ! leaf photosynthetic capacity: minimum 00155 ! ! temperature (K) 00156 REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing 00157 ! ! compensation concentration function for 00158 ! ! leaf photosynthetic capacity: maximum 00159 ! ! temperature (K) 00160 ! 00161 00162 !------------------------------------------------------------------------------- 00163 ! 00164 ! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options) 00165 ! 00166 LOGICAL, POINTER, DIMENSION(:) :: LSTRESS ! vegetation response type to water 00167 ! ! stress (true:defensive false:offensive) (-) 00168 REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water 00169 ! ! content for stress parameterisation 00170 REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1) 00171 REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress 00172 ! ! response (offensive or defensive) (log(mm/s)) 00173 REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress 00174 ! ! response (offensive or defensive) (-) 00175 REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit 00176 ! ! tolerate by vegetation (kg/kg) 00177 ! 00178 !------------------------------------------------------------------------------- 00179 ! 00180 ! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option) 00181 ! 00182 REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to 00183 ! ! nitrogen concentration (m2/kg) 00184 REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area 00185 ! ! ratio (m2/kg) 00186 REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active 00187 ! ! biomass (kg/kg) 00188 REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen 00189 ! ! decline theory (kg/m2) 00190 ! 00191 !------------------------------------------------------------------------------- 00192 ! 00193 ! - soil: primary parameters 00194 ! 00195 REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-) 00196 REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-) 00197 REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid surface runoff slope parameter (-) 00198 REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-) 00199 REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s) 00200 REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a 00201 ! ! prescribed lower boundary temperature (1/days) 00202 REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer thicknesses (m) 00203 ! ! NOTE: in Force-Restore mode, the 00204 ! ! uppermost layer thickness is superficial 00205 ! ! and is only explicitly used for soil 00206 ! ! water phase changes (m) 00207 REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is 00208 ! ! computed: in Force-Restore this is the 00209 ! ! total soil column ('2-L'), or root zone 00210 ! ! ('3-L'). For the 'DIF' option, it can 00211 ! ! be any depth within soil column (m) 00212 ! 00213 REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! ISBA-DIF: weights for vertical 00214 REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option) 00215 REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option) 00216 ! 00217 INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF 00218 REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m) 00219 REAL, POINTER, DIMENSION(:) :: XDG2 ! root depth for DIF as 3-L (m) 00220 !------------------------------------------------------------------------------- 00221 ! 00222 ! - soil: Secondary parameters: hydrology 00223 ! 00224 REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at 00225 ! ! saturation (-) 00226 REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-) 00227 REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m) 00228 REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical 00229 ! ! diffusion coefficient (slope parameter) (-) 00230 REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical 00231 ! ! diffusion coefficient (-) 00232 REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical 00233 ! ! diffusion coefficient (-) 00234 REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical 00235 ! ! diffusion coefficient (-) 00236 REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content 00237 ! ! profile (m3/m3) 00238 REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content 00239 ! ! profile (m3/m3) 00240 REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3) 00241 REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-) 00242 REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s) 00243 REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m) 00244 ! 00245 !------------------------------------------------------------------------------- 00246 ! 00247 ! - soil: Secondary parameters: thermal 00248 ! 00249 REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at 00250 ! ! saturation (K m2/J) 00251 REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3) 00252 REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K) 00253 REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K) 00254 REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature 00255 ! ! (optional) (K) 00256 REAL, POINTER, DIMENSION(:) :: XPCPS 00257 REAL, POINTER, DIMENSION(:) :: XPLVTT 00258 REAL, POINTER, DIMENSION(:) :: XPLSTT 00259 !------------------------------------------------------------------------------- 00260 ! 00261 ! - SGH scheme 00262 ! 00263 REAL, POINTER, DIMENSION(:) :: XD_ICE !depth of the soil column for the calculation 00264 ! of the frozen soil fraction (m) 00265 REAL, POINTER, DIMENSION(:) :: XKSAT_ICE !hydraulic conductivity at saturation 00266 ! over frozen area (m s-1) 00267 !------------------------------------------------------------------------------- 00268 ! 00269 ! Type of vegetation (simplification of vegetation charaterization) 00270 CHARACTER(LEN=4) :: CTYPE_HVEG ! type of high vegetation 00271 CHARACTER(LEN=4) :: CTYPE_LVEG ! type of low vegetation 00272 CHARACTER(LEN=4) :: CTYPE_NVEG ! type of bare soil (no vegetation) 00273 !------------------------------------------------------------------------------- 00274 ! 00275 END TYPE TEB_GARDEN_PGD_t 00276 ! 00277 TYPE TEB_GARDEN_PGD_EVOL_t 00278 !!------------------------------------------------------------------------------- 00279 ! 00280 ! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', or 'NIT') or prescribed (YPHOTO='NON', 'AGS' or 'LST') 00281 ! 00282 REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2) 00283 REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-) 00284 REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-) 00285 REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-) 00286 REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo (-) 00287 REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-) 00288 REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m) 00289 ! 00290 !------------------------------------------------------------------------------- 00291 END TYPE TEB_GARDEN_PGD_EVOL_t 00292 00293 TYPE TEB_GARDEN_t 00294 !------------------------------------------------------------------------------- 00295 ! 00296 ! Prognostic variables: 00297 ! 00298 ! - Snow Cover: 00299 ! 00300 TYPE(SURF_SNOW) :: TSNOW ! snow state: 00301 ! ! scheme type/option (-) 00302 ! ! number of layers (-) 00303 ! ! snow (& liq. water) content (kg/m2) 00304 ! ! heat content (J/m2) 00305 ! ! temperature (K) 00306 ! ! density (kg m-3) 00307 ! 00308 !------------------------------------------------------------------------------- 00309 ! 00310 ! - Soil and vegetation heat and water: 00311 ! 00312 REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the 00313 ! ! foliage of the vegetation 00314 ! ! canopy (kg/m2) 00315 REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil 00316 ! ! temperature profile (K) 00317 REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3) 00318 REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric 00319 ! ! ice content profile (m3/m3) 00320 REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m) 00321 ! 00322 !------------------------------------------------------------------------------- 00323 ! 00324 ! - Vegetation: Ags Prognostic (YPHOTO = 'AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB') 00325 ! 00326 REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s) 00327 REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2) 00328 REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s) 00329 REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2) 00330 REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul) 00331 REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul) 00332 REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul) 00333 REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul) 00334 ! 00335 !------------------------------------------------------------------------------- 00336 ! 00337 ! - Vegetation: Ags Prognostic (YPHOTO = 'NIT', 'NCB') 00338 ! 00339 REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of 00340 ! ! biomass (kg/m2/s) 00341 REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2) 00342 ! 00343 ! 00344 !------------------------------------------------------------------------------- 00345 ! 00346 ! - Snow and flood fractions and total albedo at time t: 00347 ! 00348 REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground 00349 REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation 00350 REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation 00351 REAL, POINTER, DIMENSION(:) :: XPSN ! Total Snow fraction 00352 ! 00353 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-) 00354 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-) 00355 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil 00356 !------------------------------------------------------------------------------- 00357 ! 00358 END TYPE TEB_GARDEN_t 00359 00360 00361 TYPE(TEB_GARDEN_OPTIONS_t), ALLOCATABLE, TARGET, SAVE :: TEB_GARDEN_OPTIONS_MODEL(:) 00362 TYPE(TEB_GARDEN_PGD_t), ALLOCATABLE, TARGET, SAVE :: TEB_GARDEN_PGD_MODEL(:) 00363 TYPE(TEB_GARDEN_PGD_EVOL_t),ALLOCATABLE, TARGET, SAVE :: TEB_GARDEN_PGD_EVOL_MODEL(:,:) 00364 TYPE(TEB_GARDEN_t), ALLOCATABLE, TARGET, SAVE :: TEB_GARDEN_MODEL(:,:) 00365 00366 LOGICAL, POINTER :: LPAR_GARDEN=>NULL() 00367 !$OMP THREADPRIVATE(LPAR_GARDEN) 00368 REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE=>NULL() 00369 !$OMP THREADPRIVATE(XVEGTYPE) 00370 INTEGER, POINTER :: NGROUND_LAYER=>NULL() 00371 !$OMP THREADPRIVATE(NGROUND_LAYER) 00372 INTEGER, POINTER :: NLAYER_HORT=>NULL() 00373 !$OMP THREADPRIVATE(NLAYER_HORT) 00374 INTEGER, POINTER :: NLAYER_DUN=>NULL() 00375 !$OMP THREADPRIVATE(NLAYER_DUN) 00376 REAL, POINTER, DIMENSION(:) :: XSOILGRID=>NULL() 00377 !$OMP THREADPRIVATE(XSOILGRID) 00378 REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY=>NULL() 00379 !$OMP THREADPRIVATE(XALBNIR_DRY) 00380 REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY=>NULL() 00381 !$OMP THREADPRIVATE(XALBVIS_DRY) 00382 REAL, POINTER, DIMENSION(:) :: XALBUV_DRY=>NULL() 00383 !$OMP THREADPRIVATE(XALBUV_DRY) 00384 REAL, POINTER, DIMENSION(:) :: XALBNIR_WET=>NULL() 00385 !$OMP THREADPRIVATE(XALBNIR_WET) 00386 REAL, POINTER, DIMENSION(:) :: XALBVIS_WET=>NULL() 00387 !$OMP THREADPRIVATE(XALBVIS_WET) 00388 REAL, POINTER, DIMENSION(:) :: XALBUV_WET=>NULL() 00389 !$OMP THREADPRIVATE(XALBUV_WET) 00390 REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL=>NULL() 00391 !$OMP THREADPRIVATE(XALBNIR_SOIL) 00392 REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL=>NULL() 00393 !$OMP THREADPRIVATE(XALBVIS_SOIL) 00394 REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL=>NULL() 00395 !$OMP THREADPRIVATE(XALBUV_SOIL) 00396 REAL, POINTER, DIMENSION(:) :: XALBNIR_TSOIL=>NULL() 00397 !$OMP THREADPRIVATE(XALBNIR_TSOIL) 00398 REAL, POINTER, DIMENSION(:) :: XALBVIS_TSOIL=>NULL() 00399 !$OMP THREADPRIVATE(XALBVIS_TSOIL) 00400 REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H=>NULL() 00401 !$OMP THREADPRIVATE(XZ0_O_Z0H) 00402 REAL, POINTER, DIMENSION(:) :: XALBNIR=>NULL() 00403 !$OMP THREADPRIVATE(XALBNIR) 00404 REAL, POINTER, DIMENSION(:) :: XALBVIS=>NULL() 00405 !$OMP THREADPRIVATE(XALBVIS) 00406 REAL, POINTER, DIMENSION(:) :: XALBUV=>NULL() 00407 !$OMP THREADPRIVATE(XALBUV) 00408 REAL, POINTER, DIMENSION(:) :: XEMIS=>NULL() 00409 !$OMP THREADPRIVATE(XEMIS) 00410 REAL, POINTER, DIMENSION(:) :: XZ0=>NULL() 00411 !$OMP THREADPRIVATE(XZ0) 00412 REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG=>NULL() 00413 !$OMP THREADPRIVATE(XALBNIR_VEG) 00414 REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG=>NULL() 00415 !$OMP THREADPRIVATE(XALBVIS_VEG) 00416 REAL, POINTER, DIMENSION(:) :: XALBUV_VEG=>NULL() 00417 !$OMP THREADPRIVATE(XALBUV_VEG) 00418 REAL, POINTER, DIMENSION(:) :: XALBNIR_TVEG=>NULL() 00419 !$OMP THREADPRIVATE(XALBNIR_TVEG) 00420 REAL, POINTER, DIMENSION(:) :: XALBVIS_TVEG=>NULL() 00421 !$OMP THREADPRIVATE(XALBVIS_TVEG) 00422 REAL, POINTER, DIMENSION(:) :: XVEG=>NULL() 00423 !$OMP THREADPRIVATE(XVEG) 00424 REAL, POINTER, DIMENSION(:) :: XWRMAX_CF=>NULL() 00425 !$OMP THREADPRIVATE(XWRMAX_CF) 00426 REAL, POINTER, DIMENSION(:) :: XRSMIN=>NULL() 00427 !$OMP THREADPRIVATE(XRSMIN) 00428 REAL, POINTER, DIMENSION(:) :: XGAMMA=>NULL() 00429 !$OMP THREADPRIVATE(XGAMMA) 00430 REAL, POINTER, DIMENSION(:) :: XCV=>NULL() 00431 !$OMP THREADPRIVATE(XCV) 00432 REAL, POINTER, DIMENSION(:) :: XRGL=>NULL() 00433 !$OMP THREADPRIVATE(XRGL) 00434 REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC=>NULL() 00435 !$OMP THREADPRIVATE(XROOTFRAC) 00436 REAL, DIMENSION(:), POINTER :: XABC=>NULL() 00437 !$OMP THREADPRIVATE(XABC) 00438 REAL, DIMENSION(:), POINTER :: XPOI=>NULL() 00439 !$OMP THREADPRIVATE(XPOI) 00440 REAL, POINTER, DIMENSION(:) :: XBSLAI=>NULL() 00441 !$OMP THREADPRIVATE(XBSLAI) 00442 REAL, POINTER, DIMENSION(:) :: XLAIMIN=>NULL() 00443 !$OMP THREADPRIVATE(XLAIMIN) 00444 REAL, POINTER, DIMENSION(:) :: XLAI=>NULL() 00445 !$OMP THREADPRIVATE(XLAI) 00446 REAL, POINTER, DIMENSION(:) :: XSEFOLD=>NULL() 00447 !$OMP THREADPRIVATE(XSEFOLD) 00448 REAL, POINTER, DIMENSION(:) :: XH_TREE=>NULL() 00449 !$OMP THREADPRIVATE(XH_TREE) 00450 REAL, POINTER, DIMENSION(:) :: XANF=>NULL() 00451 !$OMP THREADPRIVATE(XANF) 00452 REAL, POINTER, DIMENSION(:) :: XANMAX=>NULL() 00453 !$OMP THREADPRIVATE(XANMAX) 00454 REAL, POINTER, DIMENSION(:) :: XFZERO=>NULL() 00455 !$OMP THREADPRIVATE(XFZERO) 00456 REAL, POINTER, DIMENSION(:) :: XEPSO=>NULL() 00457 !$OMP THREADPRIVATE(XEPSO) 00458 REAL, POINTER, DIMENSION(:) :: XGAMM=>NULL() 00459 !$OMP THREADPRIVATE(XGAMM) 00460 REAL, POINTER, DIMENSION(:) :: XQDGAMM=>NULL() 00461 !$OMP THREADPRIVATE(XQDGAMM) 00462 REAL, POINTER, DIMENSION(:) :: XGMES=>NULL() 00463 !$OMP THREADPRIVATE(XGMES) 00464 REAL, POINTER, DIMENSION(:) :: XRE25=>NULL() 00465 !$OMP THREADPRIVATE(XRE25) 00466 REAL, POINTER, DIMENSION(:) :: XQDGMES=>NULL() 00467 !$OMP THREADPRIVATE(XQDGMES) 00468 REAL, POINTER, DIMENSION(:) :: XT1GMES=>NULL() 00469 !$OMP THREADPRIVATE(XT1GMES) 00470 REAL, POINTER, DIMENSION(:) :: XT2GMES=>NULL() 00471 !$OMP THREADPRIVATE(XT2GMES) 00472 REAL, POINTER, DIMENSION(:) :: XAMAX=>NULL() 00473 !$OMP THREADPRIVATE(XAMAX) 00474 REAL, POINTER, DIMENSION(:) :: XQDAMAX=>NULL() 00475 !$OMP THREADPRIVATE(XQDAMAX) 00476 REAL, POINTER, DIMENSION(:) :: XT1AMAX=>NULL() 00477 !$OMP THREADPRIVATE(XT1AMAX) 00478 REAL, POINTER, DIMENSION(:) :: XT2AMAX=>NULL() 00479 !$OMP THREADPRIVATE(XT2AMAX) 00480 LOGICAL, POINTER, DIMENSION(:) :: LSTRESS=>NULL() 00481 !$OMP THREADPRIVATE(LSTRESS) 00482 REAL, POINTER, DIMENSION(:) :: XF2I=>NULL() 00483 !$OMP THREADPRIVATE(XF2I) 00484 REAL, POINTER, DIMENSION(:) :: XGC=>NULL() 00485 !$OMP THREADPRIVATE(XGC) 00486 REAL, POINTER, DIMENSION(:) :: XAH=>NULL() 00487 !$OMP THREADPRIVATE(XAH) 00488 REAL, POINTER, DIMENSION(:) :: XBH=>NULL() 00489 !$OMP THREADPRIVATE(XBH) 00490 REAL, POINTER, DIMENSION(:) :: XDMAX=>NULL() 00491 !$OMP THREADPRIVATE(XDMAX) 00492 REAL, POINTER, DIMENSION(:) :: XCE_NITRO=>NULL() 00493 !$OMP THREADPRIVATE(XCE_NITRO) 00494 REAL, POINTER, DIMENSION(:) :: XCF_NITRO=>NULL() 00495 !$OMP THREADPRIVATE(XCF_NITRO) 00496 REAL, POINTER, DIMENSION(:) :: XCNA_NITRO=>NULL() 00497 !$OMP THREADPRIVATE(XCNA_NITRO) 00498 REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO=>NULL() 00499 !$OMP THREADPRIVATE(XBSLAI_NITRO) 00500 REAL, POINTER, DIMENSION(:,:) :: XSAND=>NULL() 00501 !$OMP THREADPRIVATE(XSAND) 00502 REAL, POINTER, DIMENSION(:,:) :: XCLAY=>NULL() 00503 !$OMP THREADPRIVATE(XCLAY) 00504 REAL, POINTER, DIMENSION(:) :: XRUNOFFB=>NULL() 00505 !$OMP THREADPRIVATE(XRUNOFFB) 00506 REAL, POINTER, DIMENSION(:) :: XWDRAIN=>NULL() 00507 !$OMP THREADPRIVATE(XWDRAIN) 00508 REAL, POINTER, DIMENSION(:) :: XTAUICE=>NULL() 00509 !$OMP THREADPRIVATE(XTAUICE) 00510 REAL, POINTER, DIMENSION(:) :: XGAMMAT=>NULL() 00511 !$OMP THREADPRIVATE(XGAMMAT) 00512 REAL, POINTER, DIMENSION(:,:) :: XDG=>NULL() 00513 !$OMP THREADPRIVATE(XDG) 00514 REAL, POINTER, DIMENSION(:) :: XRUNOFFD=>NULL() 00515 !$OMP THREADPRIVATE(XRUNOFFD) 00516 REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT=>NULL() 00517 !$OMP THREADPRIVATE(XSOILWGHT) 00518 REAL, POINTER, DIMENSION(:,:) :: XDZG=>NULL() 00519 !$OMP THREADPRIVATE(XDZG) 00520 REAL, POINTER, DIMENSION(:,:) :: XDZDIF=>NULL() 00521 !$OMP THREADPRIVATE(XDZDIF) 00522 INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER=>NULL() 00523 !$OMP THREADPRIVATE(NWG_LAYER) 00524 REAL, POINTER, DIMENSION(:) :: XDROOT=>NULL() 00525 !$OMP THREADPRIVATE(XDROOT) 00526 REAL, POINTER, DIMENSION(:) :: XDG2=>NULL() 00527 !$OMP THREADPRIVATE(XDG2) 00528 REAL, POINTER, DIMENSION(:) :: XC1SAT=>NULL() 00529 !$OMP THREADPRIVATE(XC1SAT) 00530 REAL, POINTER, DIMENSION(:) :: XC2REF=>NULL() 00531 !$OMP THREADPRIVATE(XC2REF) 00532 REAL, POINTER, DIMENSION(:,:) :: XC3=>NULL() 00533 !$OMP THREADPRIVATE(XC3) 00534 REAL, POINTER, DIMENSION(:) :: XC4B=>NULL() 00535 !$OMP THREADPRIVATE(XC4B) 00536 REAL, POINTER, DIMENSION(:) :: XC4REF=>NULL() 00537 !$OMP THREADPRIVATE(XC4REF) 00538 REAL, POINTER, DIMENSION(:) :: XACOEF=>NULL() 00539 !$OMP THREADPRIVATE(XACOEF) 00540 REAL, POINTER, DIMENSION(:) :: XPCOEF=>NULL() 00541 !$OMP THREADPRIVATE(XPCOEF) 00542 REAL, POINTER, DIMENSION(:,:) :: XWFC=>NULL() 00543 !$OMP THREADPRIVATE(XWFC) 00544 REAL, POINTER, DIMENSION(:,:) :: XWWILT=>NULL() 00545 !$OMP THREADPRIVATE(XWWILT) 00546 REAL, POINTER, DIMENSION(:,:) :: XWSAT=>NULL() 00547 !$OMP THREADPRIVATE(XWSAT) 00548 REAL, POINTER, DIMENSION(:,:) :: XBCOEF=>NULL() 00549 !$OMP THREADPRIVATE(XBCOEF) 00550 REAL, POINTER, DIMENSION(:,:) :: XCONDSAT=>NULL() 00551 !$OMP THREADPRIVATE(XCONDSAT) 00552 REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT=>NULL() 00553 !$OMP THREADPRIVATE(XMPOTSAT) 00554 REAL, POINTER, DIMENSION(:) :: XCGSAT=>NULL() 00555 !$OMP THREADPRIVATE(XCGSAT) 00556 REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL=>NULL() 00557 !$OMP THREADPRIVATE(XHCAPSOIL) 00558 REAL, POINTER, DIMENSION(:,:) :: XCONDDRY=>NULL() 00559 !$OMP THREADPRIVATE(XCONDDRY) 00560 REAL, POINTER, DIMENSION(:,:) :: XCONDSLD=>NULL() 00561 !$OMP THREADPRIVATE(XCONDSLD) 00562 REAL, POINTER, DIMENSION(:) :: XTDEEP=>NULL() 00563 !$OMP THREADPRIVATE(XTDEEP) 00564 TYPE(SURF_SNOW), POINTER :: TSNOW=>NULL() 00565 !$OMP THREADPRIVATE(TSNOW) 00566 REAL, POINTER, DIMENSION(:) :: XWR=>NULL() 00567 !$OMP THREADPRIVATE(XWR) 00568 REAL, POINTER, DIMENSION(:,:) :: XTG=>NULL() 00569 !$OMP THREADPRIVATE(XTG) 00570 REAL, POINTER, DIMENSION(:,:) :: XWG=>NULL() 00571 !$OMP THREADPRIVATE(XWG) 00572 REAL, POINTER, DIMENSION(:,:) :: XWGI=>NULL() 00573 !$OMP THREADPRIVATE(XWGI) 00574 REAL, POINTER, DIMENSION(:) :: XRESA=>NULL() 00575 !$OMP THREADPRIVATE(XRESA) 00576 REAL, POINTER, DIMENSION(:) :: XPCPS=>NULL() 00577 !$OMP THREADPRIVATE(XPCPS) 00578 REAL, POINTER, DIMENSION(:) :: XPLVTT=>NULL() 00579 !$OMP THREADPRIVATE(XPLVTT) 00580 REAL, POINTER, DIMENSION(:) :: XPLSTT=>NULL() 00581 !$OMP THREADPRIVATE(XPLSTT) 00582 REAL, POINTER, DIMENSION(:) :: XAN=>NULL() 00583 !$OMP THREADPRIVATE(XAN) 00584 REAL, POINTER, DIMENSION(:) :: XANDAY=>NULL() 00585 !$OMP THREADPRIVATE(XANDAY) 00586 REAL, POINTER, DIMENSION(:) :: XANFM=>NULL() 00587 !$OMP THREADPRIVATE(XANFM) 00588 REAL, POINTER, DIMENSION(:) :: XLE=>NULL() 00589 !$OMP THREADPRIVATE(XLE) 00590 REAL, POINTER, DIMENSION(:) :: XFAPARC=>NULL() 00591 !$OMP THREADPRIVATE(XFAPARC) 00592 REAL, POINTER, DIMENSION(:) :: XFAPIRC=>NULL() 00593 !$OMP THREADPRIVATE(XFAPIRC) 00594 REAL, POINTER, DIMENSION(:) :: XLAI_EFFC=>NULL() 00595 !$OMP THREADPRIVATE(XLAI_EFFC) 00596 REAL, POINTER, DIMENSION(:) :: XMUS=>NULL() 00597 !$OMP THREADPRIVATE(XMUS) 00598 REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS=>NULL() 00599 !$OMP THREADPRIVATE(XRESP_BIOMASS) 00600 REAL, POINTER, DIMENSION(:,:) :: XBIOMASS=>NULL() 00601 !$OMP THREADPRIVATE(XBIOMASS) 00602 ! 00603 REAL, POINTER, DIMENSION(:) :: XPSNG=>NULL() 00604 !$OMP THREADPRIVATE(XPSNG) 00605 REAL, POINTER, DIMENSION(:) :: XPSNV=>NULL() 00606 !$OMP THREADPRIVATE(XPSNV) 00607 REAL, POINTER, DIMENSION(:) :: XPSNV_A=>NULL() 00608 !$OMP THREADPRIVATE(XPSNV_A) 00609 REAL, POINTER, DIMENSION(:) :: XPSN=>NULL() 00610 !$OMP THREADPRIVATE(XPSN) 00611 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB=>NULL() 00612 !$OMP THREADPRIVATE(XSNOWFREE_ALB) 00613 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG=>NULL() 00614 !$OMP THREADPRIVATE(XSNOWFREE_ALB_VEG) 00615 REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL=>NULL() 00616 !$OMP THREADPRIVATE(XSNOWFREE_ALB_SOIL) 00617 ! 00618 !SGH scheme 00619 ! 00620 REAL, POINTER, DIMENSION(:) :: XD_ICE=>NULL() 00621 !$OMP THREADPRIVATE(XD_ICE) 00622 REAL, POINTER, DIMENSION(:) :: XKSAT_ICE=>NULL() 00623 !$OMP THREADPRIVATE(XKSAT_ICE) 00624 ! 00625 ! Type of vegetation (simplification of veg characterization) 00626 CHARACTER(LEN=4), POINTER :: CTYPE_HVEG=>NULL() 00627 !$OMP THREADPRIVATE(CTYPE_HVEG) 00628 CHARACTER(LEN=4), POINTER :: CTYPE_LVEG=>NULL() 00629 !$OMP THREADPRIVATE(CTYPE_LVEG) 00630 CHARACTER(LEN=4), POINTER :: CTYPE_NVEG=>NULL() 00631 !$OMP THREADPRIVATE(CTYPE_NVEG) 00632 ! 00633 CONTAINS 00634 00635 SUBROUTINE TEB_GARDEN_OPTIONS_GOTO_MODEL(KFROM, KTO, LKFROM) 00636 LOGICAL, INTENT(IN) :: LKFROM 00637 INTEGER, INTENT(IN) :: KFROM, KTO 00638 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00639 ! 00640 ! Current model is set to model KTO 00641 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_GOTO_MODEL',0,ZHOOK_HANDLE) 00642 IF (LKFROM) THEN 00643 TEB_GARDEN_OPTIONS_MODEL(KTO)%XSOILGRID=>XSOILGRID 00644 ENDIF 00645 LPAR_GARDEN=>TEB_GARDEN_OPTIONS_MODEL(KTO)%LPAR_GARDEN 00646 NGROUND_LAYER=>TEB_GARDEN_OPTIONS_MODEL(KTO)%NGROUND_LAYER 00647 NLAYER_HORT=>TEB_GARDEN_OPTIONS_MODEL(KTO)%NLAYER_HORT 00648 NLAYER_DUN=>TEB_GARDEN_OPTIONS_MODEL(KTO)%NLAYER_DUN 00649 XSOILGRID=>TEB_GARDEN_OPTIONS_MODEL(KTO)%XSOILGRID 00650 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_GOTO_MODEL',1,ZHOOK_HANDLE) 00651 ! 00652 END SUBROUTINE TEB_GARDEN_OPTIONS_GOTO_MODEL 00653 00654 SUBROUTINE TEB_GARDEN_OPTIONS_ALLOC(KMODEL) 00655 INTEGER, INTENT(IN) :: KMODEL 00656 INTEGER :: J 00657 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00658 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_ALLOC",0,ZHOOK_HANDLE) 00659 ALLOCATE(TEB_GARDEN_OPTIONS_MODEL(KMODEL)) 00660 DO J=1,KMODEL 00661 NULLIFY(TEB_GARDEN_OPTIONS_MODEL(J)%XSOILGRID) 00662 ENDDO 00663 TEB_GARDEN_OPTIONS_MODEL(:)%LPAR_GARDEN=.TRUE. 00664 TEB_GARDEN_OPTIONS_MODEL(:)%NGROUND_LAYER=0 00665 TEB_GARDEN_OPTIONS_MODEL(:)%NLAYER_HORT=0 00666 TEB_GARDEN_OPTIONS_MODEL(:)%NLAYER_DUN=0 00667 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_ALLOC",1,ZHOOK_HANDLE) 00668 END SUBROUTINE TEB_GARDEN_OPTIONS_ALLOC 00669 00670 SUBROUTINE TEB_GARDEN_OPTIONS_DEALLO 00671 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00672 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_DEALLO",0,ZHOOK_HANDLE) 00673 IF (ALLOCATED(TEB_GARDEN_OPTIONS_MODEL)) DEALLOCATE(TEB_GARDEN_OPTIONS_MODEL) 00674 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_DEALLO",1,ZHOOK_HANDLE) 00675 END SUBROUTINE TEB_GARDEN_OPTIONS_DEALLO 00676 00677 00678 SUBROUTINE TEB_GARDEN_GOTO_MODEL(KFROM, KTO, LKFROM, KFROM_PATCH, KTO_PATCH) 00679 LOGICAL, INTENT(IN) :: LKFROM 00680 INTEGER, INTENT(IN) :: KFROM, KTO 00681 INTEGER, INTENT(IN) :: KFROM_PATCH, KTO_PATCH 00682 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00683 ! 00684 ! Save current state for allocated arrays 00685 IF (LKFROM) THEN 00686 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XWR=>XWR 00687 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XTG=>XTG 00688 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XWG=>XWG 00689 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XWGI=>XWGI 00690 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XRESA=>XRESA 00691 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XAN=>XAN 00692 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XANDAY=>XANDAY 00693 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XANFM=>XANFM 00694 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XLE=>XLE 00695 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XFAPARC=>XFAPARC 00696 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XFAPIRC=>XFAPIRC 00697 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XLAI_EFFC=>XLAI_EFFC 00698 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XMUS=>XMUS 00699 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XRESP_BIOMASS=>XRESP_BIOMASS 00700 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XBIOMASS=>XBIOMASS 00701 ! 00702 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XPSNG=>XPSNG 00703 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XPSNV_A=>XPSNV_A 00704 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XPSNV=>XPSNV 00705 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XPSN=>XPSN 00706 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XSNOWFREE_ALB=>XSNOWFREE_ALB 00707 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XSNOWFREE_ALB_VEG=>XSNOWFREE_ALB_VEG 00708 TEB_GARDEN_MODEL(KFROM,KFROM_PATCH)%XSNOWFREE_ALB_SOIL=>XSNOWFREE_ALB_SOIL 00709 ! 00710 ENDIF 00711 ! 00712 ! Current model is set to model KTO 00713 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_GOTO_MODEL',0,ZHOOK_HANDLE) 00714 TSNOW=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%TSNOW 00715 XWR=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XWR 00716 XTG=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XTG 00717 XWG=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XWG 00718 XWGI=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XWGI 00719 XRESA=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XRESA 00720 XAN=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XAN 00721 XANDAY=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XANDAY 00722 XANFM=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XANFM 00723 XLE=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XLE 00724 XFAPARC=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XFAPARC 00725 XFAPIRC=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XFAPIRC 00726 XLAI_EFFC=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XLAI_EFFC 00727 XMUS=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XMUS 00728 XRESP_BIOMASS=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XRESP_BIOMASS 00729 XBIOMASS=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XBIOMASS 00730 ! 00731 XPSNG=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XPSNG 00732 XPSNV_A=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XPSNV_A 00733 XPSNV=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XPSNV 00734 XPSN=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XPSN 00735 XSNOWFREE_ALB=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XSNOWFREE_ALB 00736 XSNOWFREE_ALB_VEG=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XSNOWFREE_ALB_VEG 00737 XSNOWFREE_ALB_SOIL=>TEB_GARDEN_MODEL(KTO,KTO_PATCH)%XSNOWFREE_ALB_SOIL 00738 ! 00739 ! Types of vegetation (simplification of veg characterization) 00740 ! 00741 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_GOTO_MODEL',1,ZHOOK_HANDLE) 00742 ! 00743 END SUBROUTINE TEB_GARDEN_GOTO_MODEL 00744 00745 SUBROUTINE TEB_GARDEN_ALLOC(KMODEL,KPATCH) 00746 INTEGER, INTENT(IN) :: KMODEL, KPATCH 00747 INTEGER :: J, JP 00748 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00749 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_ALLOC",0,ZHOOK_HANDLE) 00750 ALLOCATE(TEB_GARDEN_MODEL(KMODEL,KPATCH)) 00751 DO J=1,KMODEL 00752 DO JP=1,KPATCH 00753 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XWR) 00754 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XTG) 00755 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XWG) 00756 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XWGI) 00757 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XRESA) 00758 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XAN) 00759 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XANDAY) 00760 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XANFM) 00761 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XLE) 00762 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XFAPARC) 00763 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XFAPIRC) 00764 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XLAI_EFFC) 00765 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XMUS) 00766 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XRESP_BIOMASS) 00767 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XBIOMASS) 00768 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XPSNG) 00769 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XPSNV) 00770 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XPSNV_A) 00771 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XPSN) 00772 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XSNOWFREE_ALB) 00773 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XSNOWFREE_ALB_VEG) 00774 NULLIFY(TEB_GARDEN_MODEL(J,JP)%XSNOWFREE_ALB_SOIL) 00775 ENDDO 00776 ENDDO 00777 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_ALLOC",1,ZHOOK_HANDLE) 00778 END SUBROUTINE TEB_GARDEN_ALLOC 00779 00780 SUBROUTINE TEB_GARDEN_DEALLO 00781 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00782 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_DEALLO",0,ZHOOK_HANDLE) 00783 IF (ALLOCATED(TEB_GARDEN_MODEL)) DEALLOCATE(TEB_GARDEN_MODEL) 00784 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_DEALLO",1,ZHOOK_HANDLE) 00785 END SUBROUTINE TEB_GARDEN_DEALLO 00786 00787 SUBROUTINE TEB_GARDEN_PGD_GOTO_MODEL(KFROM, KTO, LKFROM) 00788 LOGICAL, INTENT(IN) :: LKFROM 00789 INTEGER, INTENT(IN) :: KFROM, KTO 00790 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00791 ! 00792 ! Save current state for allocated arrays 00793 IF (LKFROM) THEN 00794 TEB_GARDEN_PGD_MODEL(KFROM)%XVEGTYPE=>XVEGTYPE 00795 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_DRY=>XALBNIR_DRY 00796 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_DRY=>XALBVIS_DRY 00797 TEB_GARDEN_PGD_MODEL(KFROM)%XALBUV_DRY=>XALBUV_DRY 00798 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_WET=>XALBNIR_WET 00799 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_WET=>XALBVIS_WET 00800 TEB_GARDEN_PGD_MODEL(KFROM)%XALBUV_WET=>XALBUV_WET 00801 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_SOIL=>XALBNIR_SOIL 00802 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_SOIL=>XALBVIS_SOIL 00803 TEB_GARDEN_PGD_MODEL(KFROM)%XALBUV_SOIL=>XALBUV_SOIL 00804 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_TSOIL=>XALBNIR_TSOIL 00805 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_TSOIL=>XALBVIS_TSOIL 00806 TEB_GARDEN_PGD_MODEL(KFROM)%XZ0_O_Z0H=>XZ0_O_Z0H 00807 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_VEG=>XALBNIR_VEG 00808 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_VEG=>XALBVIS_VEG 00809 TEB_GARDEN_PGD_MODEL(KFROM)%XALBUV_VEG=>XALBUV_VEG 00810 TEB_GARDEN_PGD_MODEL(KFROM)%XALBNIR_TVEG=>XALBNIR_TVEG 00811 TEB_GARDEN_PGD_MODEL(KFROM)%XALBVIS_TVEG=>XALBVIS_TVEG 00812 TEB_GARDEN_PGD_MODEL(KFROM)%XWRMAX_CF=>XWRMAX_CF 00813 TEB_GARDEN_PGD_MODEL(KFROM)%XRSMIN=>XRSMIN 00814 TEB_GARDEN_PGD_MODEL(KFROM)%XGAMMA=>XGAMMA 00815 TEB_GARDEN_PGD_MODEL(KFROM)%XCV=>XCV 00816 TEB_GARDEN_PGD_MODEL(KFROM)%XRGL=>XRGL 00817 TEB_GARDEN_PGD_MODEL(KFROM)%XROOTFRAC=>XROOTFRAC 00818 TEB_GARDEN_PGD_MODEL(KFROM)%XABC=>XABC 00819 TEB_GARDEN_PGD_MODEL(KFROM)%XPOI=>XPOI 00820 TEB_GARDEN_PGD_MODEL(KFROM)%XBSLAI=>XBSLAI 00821 TEB_GARDEN_PGD_MODEL(KFROM)%XLAIMIN=>XLAIMIN 00822 TEB_GARDEN_PGD_MODEL(KFROM)%XSEFOLD=>XSEFOLD 00823 TEB_GARDEN_PGD_MODEL(KFROM)%XH_TREE=>XH_TREE 00824 TEB_GARDEN_PGD_MODEL(KFROM)%XANF=>XANF 00825 TEB_GARDEN_PGD_MODEL(KFROM)%XANMAX=>XANMAX 00826 TEB_GARDEN_PGD_MODEL(KFROM)%XFZERO=>XFZERO 00827 TEB_GARDEN_PGD_MODEL(KFROM)%XEPSO=>XEPSO 00828 TEB_GARDEN_PGD_MODEL(KFROM)%XGAMM=>XGAMM 00829 TEB_GARDEN_PGD_MODEL(KFROM)%XQDGAMM=>XQDGAMM 00830 TEB_GARDEN_PGD_MODEL(KFROM)%XGMES=>XGMES 00831 TEB_GARDEN_PGD_MODEL(KFROM)%XRE25=>XRE25 00832 TEB_GARDEN_PGD_MODEL(KFROM)%XQDGMES=>XQDGMES 00833 TEB_GARDEN_PGD_MODEL(KFROM)%XT1GMES=>XT1GMES 00834 TEB_GARDEN_PGD_MODEL(KFROM)%XT2GMES=>XT2GMES 00835 TEB_GARDEN_PGD_MODEL(KFROM)%XAMAX=>XAMAX 00836 TEB_GARDEN_PGD_MODEL(KFROM)%XQDAMAX=>XQDAMAX 00837 TEB_GARDEN_PGD_MODEL(KFROM)%XT1AMAX=>XT1AMAX 00838 TEB_GARDEN_PGD_MODEL(KFROM)%XT2AMAX=>XT2AMAX 00839 TEB_GARDEN_PGD_MODEL(KFROM)%LSTRESS=>LSTRESS 00840 TEB_GARDEN_PGD_MODEL(KFROM)%XF2I=>XF2I 00841 TEB_GARDEN_PGD_MODEL(KFROM)%XGC=>XGC 00842 TEB_GARDEN_PGD_MODEL(KFROM)%XAH=>XAH 00843 TEB_GARDEN_PGD_MODEL(KFROM)%XBH=>XBH 00844 TEB_GARDEN_PGD_MODEL(KFROM)%XDMAX=>XDMAX 00845 TEB_GARDEN_PGD_MODEL(KFROM)%XCE_NITRO=>XCE_NITRO 00846 TEB_GARDEN_PGD_MODEL(KFROM)%XCF_NITRO=>XCF_NITRO 00847 TEB_GARDEN_PGD_MODEL(KFROM)%XCNA_NITRO=>XCNA_NITRO 00848 TEB_GARDEN_PGD_MODEL(KFROM)%XBSLAI_NITRO=>XBSLAI_NITRO 00849 TEB_GARDEN_PGD_MODEL(KFROM)%XSAND=>XSAND 00850 TEB_GARDEN_PGD_MODEL(KFROM)%XCLAY=>XCLAY 00851 TEB_GARDEN_PGD_MODEL(KFROM)%XRUNOFFB=>XRUNOFFB 00852 TEB_GARDEN_PGD_MODEL(KFROM)%XWDRAIN=>XWDRAIN 00853 TEB_GARDEN_PGD_MODEL(KFROM)%XTAUICE=>XTAUICE 00854 TEB_GARDEN_PGD_MODEL(KFROM)%XGAMMAT=>XGAMMAT 00855 TEB_GARDEN_PGD_MODEL(KFROM)%XDG=>XDG 00856 TEB_GARDEN_PGD_MODEL(KFROM)%XRUNOFFD=>XRUNOFFD 00857 TEB_GARDEN_PGD_MODEL(KFROM)%XSOILWGHT=>XSOILWGHT 00858 TEB_GARDEN_PGD_MODEL(KFROM)%XDZG=>XDZG 00859 TEB_GARDEN_PGD_MODEL(KFROM)%XDZDIF=>XDZDIF 00860 TEB_GARDEN_PGD_MODEL(KFROM)%NWG_LAYER=>NWG_LAYER 00861 TEB_GARDEN_PGD_MODEL(KFROM)%XDROOT=>XDROOT 00862 TEB_GARDEN_PGD_MODEL(KFROM)%XDG2=>XDG2 00863 TEB_GARDEN_PGD_MODEL(KFROM)%XPCPS=>XPCPS 00864 TEB_GARDEN_PGD_MODEL(KFROM)%XPLVTT=>XPLVTT 00865 TEB_GARDEN_PGD_MODEL(KFROM)%XPLSTT=>XPLSTT 00866 TEB_GARDEN_PGD_MODEL(KFROM)%XC1SAT=>XC1SAT 00867 TEB_GARDEN_PGD_MODEL(KFROM)%XC2REF=>XC2REF 00868 TEB_GARDEN_PGD_MODEL(KFROM)%XC3=>XC3 00869 TEB_GARDEN_PGD_MODEL(KFROM)%XC4B=>XC4B 00870 TEB_GARDEN_PGD_MODEL(KFROM)%XC4REF=>XC4REF 00871 TEB_GARDEN_PGD_MODEL(KFROM)%XACOEF=>XACOEF 00872 TEB_GARDEN_PGD_MODEL(KFROM)%XPCOEF=>XPCOEF 00873 TEB_GARDEN_PGD_MODEL(KFROM)%XWFC=>XWFC 00874 TEB_GARDEN_PGD_MODEL(KFROM)%XWWILT=>XWWILT 00875 TEB_GARDEN_PGD_MODEL(KFROM)%XWSAT=>XWSAT 00876 TEB_GARDEN_PGD_MODEL(KFROM)%XBCOEF=>XBCOEF 00877 TEB_GARDEN_PGD_MODEL(KFROM)%XCONDSAT=>XCONDSAT 00878 TEB_GARDEN_PGD_MODEL(KFROM)%XMPOTSAT=>XMPOTSAT 00879 TEB_GARDEN_PGD_MODEL(KFROM)%XCGSAT=>XCGSAT 00880 TEB_GARDEN_PGD_MODEL(KFROM)%XHCAPSOIL=>XHCAPSOIL 00881 TEB_GARDEN_PGD_MODEL(KFROM)%XCONDDRY=>XCONDDRY 00882 TEB_GARDEN_PGD_MODEL(KFROM)%XCONDSLD=>XCONDSLD 00883 TEB_GARDEN_PGD_MODEL(KFROM)%XTDEEP=>XTDEEP 00884 ! 00885 ! 00886 !SGH scheme 00887 ! 00888 TEB_GARDEN_PGD_MODEL(KFROM)%XD_ICE=>XD_ICE 00889 TEB_GARDEN_PGD_MODEL(KFROM)%XKSAT_ICE=>XKSAT_ICE 00890 ENDIF 00891 ! 00892 ! Current model is set to model KTO 00893 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_GOTO_MODEL',0,ZHOOK_HANDLE) 00894 XVEGTYPE=>TEB_GARDEN_PGD_MODEL(KTO)%XVEGTYPE 00895 XALBNIR_DRY=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_DRY 00896 XALBVIS_DRY=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_DRY 00897 XALBUV_DRY=>TEB_GARDEN_PGD_MODEL(KTO)%XALBUV_DRY 00898 XALBNIR_WET=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_WET 00899 XALBVIS_WET=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_WET 00900 XALBUV_WET=>TEB_GARDEN_PGD_MODEL(KTO)%XALBUV_WET 00901 XALBNIR_SOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_SOIL 00902 XALBVIS_SOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_SOIL 00903 XALBUV_SOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XALBUV_SOIL 00904 XALBNIR_TSOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_TSOIL 00905 XALBVIS_TSOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_TSOIL 00906 XZ0_O_Z0H=>TEB_GARDEN_PGD_MODEL(KTO)%XZ0_O_Z0H 00907 XALBNIR_VEG=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_VEG 00908 XALBVIS_VEG=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_VEG 00909 XALBUV_VEG=>TEB_GARDEN_PGD_MODEL(KTO)%XALBUV_VEG 00910 XALBNIR_TVEG=>TEB_GARDEN_PGD_MODEL(KTO)%XALBNIR_TVEG 00911 XALBVIS_TVEG=>TEB_GARDEN_PGD_MODEL(KTO)%XALBVIS_TVEG 00912 XWRMAX_CF=>TEB_GARDEN_PGD_MODEL(KTO)%XWRMAX_CF 00913 XRSMIN=>TEB_GARDEN_PGD_MODEL(KTO)%XRSMIN 00914 XGAMMA=>TEB_GARDEN_PGD_MODEL(KTO)%XGAMMA 00915 XCV=>TEB_GARDEN_PGD_MODEL(KTO)%XCV 00916 XRGL=>TEB_GARDEN_PGD_MODEL(KTO)%XRGL 00917 XROOTFRAC=>TEB_GARDEN_PGD_MODEL(KTO)%XROOTFRAC 00918 XABC=>TEB_GARDEN_PGD_MODEL(KTO)%XABC 00919 XPOI=>TEB_GARDEN_PGD_MODEL(KTO)%XPOI 00920 XBSLAI=>TEB_GARDEN_PGD_MODEL(KTO)%XBSLAI 00921 XLAIMIN=>TEB_GARDEN_PGD_MODEL(KTO)%XLAIMIN 00922 XSEFOLD=>TEB_GARDEN_PGD_MODEL(KTO)%XSEFOLD 00923 XH_TREE=>TEB_GARDEN_PGD_MODEL(KTO)%XH_TREE 00924 XANF=>TEB_GARDEN_PGD_MODEL(KTO)%XANF 00925 XANMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XANMAX 00926 XFZERO=>TEB_GARDEN_PGD_MODEL(KTO)%XFZERO 00927 XEPSO=>TEB_GARDEN_PGD_MODEL(KTO)%XEPSO 00928 XGAMM=>TEB_GARDEN_PGD_MODEL(KTO)%XGAMM 00929 XQDGAMM=>TEB_GARDEN_PGD_MODEL(KTO)%XQDGAMM 00930 XGMES=>TEB_GARDEN_PGD_MODEL(KTO)%XGMES 00931 XRE25=>TEB_GARDEN_PGD_MODEL(KTO)%XRE25 00932 XQDGMES=>TEB_GARDEN_PGD_MODEL(KTO)%XQDGMES 00933 XT1GMES=>TEB_GARDEN_PGD_MODEL(KTO)%XT1GMES 00934 XT2GMES=>TEB_GARDEN_PGD_MODEL(KTO)%XT2GMES 00935 XAMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XAMAX 00936 XQDAMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XQDAMAX 00937 XT1AMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XT1AMAX 00938 XT2AMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XT2AMAX 00939 LSTRESS=>TEB_GARDEN_PGD_MODEL(KTO)%LSTRESS 00940 XF2I=>TEB_GARDEN_PGD_MODEL(KTO)%XF2I 00941 XGC=>TEB_GARDEN_PGD_MODEL(KTO)%XGC 00942 XAH=>TEB_GARDEN_PGD_MODEL(KTO)%XAH 00943 XBH=>TEB_GARDEN_PGD_MODEL(KTO)%XBH 00944 XDMAX=>TEB_GARDEN_PGD_MODEL(KTO)%XDMAX 00945 XCE_NITRO=>TEB_GARDEN_PGD_MODEL(KTO)%XCE_NITRO 00946 XCF_NITRO=>TEB_GARDEN_PGD_MODEL(KTO)%XCF_NITRO 00947 XCNA_NITRO=>TEB_GARDEN_PGD_MODEL(KTO)%XCNA_NITRO 00948 XBSLAI_NITRO=>TEB_GARDEN_PGD_MODEL(KTO)%XBSLAI_NITRO 00949 XSAND=>TEB_GARDEN_PGD_MODEL(KTO)%XSAND 00950 XCLAY=>TEB_GARDEN_PGD_MODEL(KTO)%XCLAY 00951 XRUNOFFB=>TEB_GARDEN_PGD_MODEL(KTO)%XRUNOFFB 00952 XWDRAIN=>TEB_GARDEN_PGD_MODEL(KTO)%XWDRAIN 00953 XTAUICE=>TEB_GARDEN_PGD_MODEL(KTO)%XTAUICE 00954 XGAMMAT=>TEB_GARDEN_PGD_MODEL(KTO)%XGAMMAT 00955 XDG=>TEB_GARDEN_PGD_MODEL(KTO)%XDG 00956 XRUNOFFD=>TEB_GARDEN_PGD_MODEL(KTO)%XRUNOFFD 00957 XSOILWGHT=>TEB_GARDEN_PGD_MODEL(KTO)%XSOILWGHT 00958 XDZG=>TEB_GARDEN_PGD_MODEL(KTO)%XDZG 00959 XDZDIF=>TEB_GARDEN_PGD_MODEL(KTO)%XDZDIF 00960 NWG_LAYER=>TEB_GARDEN_PGD_MODEL(KTO)%NWG_LAYER 00961 XDROOT=>TEB_GARDEN_PGD_MODEL(KTO)%XDROOT 00962 XDG2=>TEB_GARDEN_PGD_MODEL(KTO)%XDG2 00963 XPCPS=>TEB_GARDEN_PGD_MODEL(KTO)%XPCPS 00964 XPLVTT=>TEB_GARDEN_PGD_MODEL(KTO)%XPLVTT 00965 XPLSTT=>TEB_GARDEN_PGD_MODEL(KTO)%XPLSTT 00966 XC1SAT=>TEB_GARDEN_PGD_MODEL(KTO)%XC1SAT 00967 XC2REF=>TEB_GARDEN_PGD_MODEL(KTO)%XC2REF 00968 XC3=>TEB_GARDEN_PGD_MODEL(KTO)%XC3 00969 XC4B=>TEB_GARDEN_PGD_MODEL(KTO)%XC4B 00970 XC4REF=>TEB_GARDEN_PGD_MODEL(KTO)%XC4REF 00971 XACOEF=>TEB_GARDEN_PGD_MODEL(KTO)%XACOEF 00972 XPCOEF=>TEB_GARDEN_PGD_MODEL(KTO)%XPCOEF 00973 XWFC=>TEB_GARDEN_PGD_MODEL(KTO)%XWFC 00974 XWWILT=>TEB_GARDEN_PGD_MODEL(KTO)%XWWILT 00975 XWSAT=>TEB_GARDEN_PGD_MODEL(KTO)%XWSAT 00976 XBCOEF=>TEB_GARDEN_PGD_MODEL(KTO)%XBCOEF 00977 XCONDSAT=>TEB_GARDEN_PGD_MODEL(KTO)%XCONDSAT 00978 XMPOTSAT=>TEB_GARDEN_PGD_MODEL(KTO)%XMPOTSAT 00979 XCGSAT=>TEB_GARDEN_PGD_MODEL(KTO)%XCGSAT 00980 XHCAPSOIL=>TEB_GARDEN_PGD_MODEL(KTO)%XHCAPSOIL 00981 XCONDDRY=>TEB_GARDEN_PGD_MODEL(KTO)%XCONDDRY 00982 XCONDSLD=>TEB_GARDEN_PGD_MODEL(KTO)%XCONDSLD 00983 XTDEEP=>TEB_GARDEN_PGD_MODEL(KTO)%XTDEEP 00984 ! 00985 !SGH scheme 00986 ! 00987 XD_ICE=>TEB_GARDEN_PGD_MODEL(KTO)%XD_ICE 00988 XKSAT_ICE=>TEB_GARDEN_PGD_MODEL(KTO)%XKSAT_ICE 00989 ! 00990 ! Types of vegetation (simplification of veg characterization) 00991 ! 00992 CTYPE_HVEG=>TEB_GARDEN_PGD_MODEL(KTO)%CTYPE_HVEG 00993 CTYPE_LVEG=>TEB_GARDEN_PGD_MODEL(KTO)%CTYPE_LVEG 00994 CTYPE_NVEG=>TEB_GARDEN_PGD_MODEL(KTO)%CTYPE_NVEG 00995 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_GOTO_MODEL',1,ZHOOK_HANDLE) 00996 ! 00997 END SUBROUTINE TEB_GARDEN_PGD_GOTO_MODEL 00998 00999 SUBROUTINE TEB_GARDEN_PGD_ALLOC(KMODEL) 01000 INTEGER, INTENT(IN) :: KMODEL 01001 INTEGER :: J 01002 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01003 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_ALLOC",0,ZHOOK_HANDLE) 01004 ALLOCATE(TEB_GARDEN_PGD_MODEL(KMODEL)) 01005 DO J=1,KMODEL 01006 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XVEGTYPE) 01007 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_DRY) 01008 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_DRY) 01009 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBUV_DRY) 01010 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_WET) 01011 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_WET) 01012 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBUV_WET) 01013 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_SOIL) 01014 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_SOIL) 01015 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBUV_SOIL) 01016 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_TSOIL) 01017 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_TSOIL) 01018 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XZ0_O_Z0H) 01019 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_VEG) 01020 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_VEG) 01021 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBUV_VEG) 01022 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBNIR_TVEG) 01023 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XALBVIS_TVEG) 01024 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XWRMAX_CF) 01025 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XRSMIN) 01026 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XGAMMA) 01027 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCV) 01028 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XRGL) 01029 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XROOTFRAC) 01030 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XBSLAI) 01031 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XLAIMIN) 01032 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XSEFOLD) 01033 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XH_TREE) 01034 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XANF) 01035 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XANMAX) 01036 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XFZERO) 01037 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XEPSO) 01038 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XGAMM) 01039 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XQDGAMM) 01040 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XGMES) 01041 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XRE25) 01042 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XQDGMES) 01043 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XT1GMES) 01044 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XT2GMES) 01045 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XAMAX) 01046 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XQDAMAX) 01047 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XT1AMAX) 01048 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XT2AMAX) 01049 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%LSTRESS) 01050 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XF2I) 01051 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XGC) 01052 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XAH) 01053 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XBH) 01054 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDMAX) 01055 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCE_NITRO) 01056 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCF_NITRO) 01057 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCNA_NITRO) 01058 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XBSLAI_NITRO) 01059 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XSAND) 01060 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCLAY) 01061 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XRUNOFFB) 01062 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XWDRAIN) 01063 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XTAUICE) 01064 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XGAMMAT) 01065 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDG) 01066 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XRUNOFFD) 01067 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XSOILWGHT) 01068 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDZG) 01069 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDZDIF) 01070 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%NWG_LAYER) 01071 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDROOT) 01072 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XDG2) 01073 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XPCPS) 01074 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XPLVTT) 01075 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XPLSTT) 01076 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XC1SAT) 01077 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XC2REF) 01078 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XC3) 01079 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XC4B) 01080 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XC4REF) 01081 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XACOEF) 01082 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XPCOEF) 01083 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XWFC) 01084 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XWWILT) 01085 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XWSAT) 01086 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XBCOEF) 01087 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCONDSAT) 01088 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XMPOTSAT) 01089 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCGSAT) 01090 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XHCAPSOIL) 01091 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCONDDRY) 01092 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XCONDSLD) 01093 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XTDEEP) 01094 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XD_ICE) 01095 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XKSAT_ICE) 01096 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XABC) 01097 NULLIFY(TEB_GARDEN_PGD_MODEL(J)%XPOI) 01098 ENDDO 01099 TEB_GARDEN_PGD_MODEL(:)%CTYPE_HVEG=' ' 01100 TEB_GARDEN_PGD_MODEL(:)%CTYPE_LVEG=' ' 01101 TEB_GARDEN_PGD_MODEL(:)%CTYPE_NVEG=' ' 01102 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_ALLOC",1,ZHOOK_HANDLE) 01103 END SUBROUTINE TEB_GARDEN_PGD_ALLOC 01104 01105 SUBROUTINE TEB_GARDEN_PGD_DEALLO 01106 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01107 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_DEALLO",0,ZHOOK_HANDLE) 01108 IF (ALLOCATED(TEB_GARDEN_PGD_MODEL)) DEALLOCATE(TEB_GARDEN_PGD_MODEL) 01109 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_DEALLO",1,ZHOOK_HANDLE) 01110 END SUBROUTINE TEB_GARDEN_PGD_DEALLO 01111 01112 01113 01114 SUBROUTINE TEB_GARDEN_PGD_EVOL_GOTO_MODEL(KFROM, KTO, LKFROM, KFROM_PATCH, KTO_PATCH) 01115 LOGICAL, INTENT(IN) :: LKFROM 01116 INTEGER, INTENT(IN) :: KFROM, KTO 01117 INTEGER, INTENT(IN) :: KFROM_PATCH, KTO_PATCH 01118 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01119 ! 01120 ! Save current state for allocated arrays 01121 IF (LKFROM) THEN 01122 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XALBNIR=>XALBNIR 01123 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XALBVIS=>XALBVIS 01124 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XALBUV=>XALBUV 01125 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XEMIS=>XEMIS 01126 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XZ0=>XZ0 01127 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XVEG=>XVEG 01128 TEB_GARDEN_PGD_EVOL_MODEL(KFROM,KFROM_PATCH)%XLAI=>XLAI 01129 ENDIF 01130 ! 01131 ! Current model is set to model KTO 01132 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_MODEL',0,ZHOOK_HANDLE) 01133 XALBNIR=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XALBNIR 01134 XALBVIS=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XALBVIS 01135 XALBUV=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XALBUV 01136 XEMIS=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XEMIS 01137 XZ0=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XZ0 01138 XVEG=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XVEG 01139 XLAI=>TEB_GARDEN_PGD_EVOL_MODEL(KTO,KTO_PATCH)%XLAI 01140 IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_MODEL',1,ZHOOK_HANDLE) 01141 ! 01142 END SUBROUTINE TEB_GARDEN_PGD_EVOL_GOTO_MODEL 01143 01144 SUBROUTINE TEB_GARDEN_PGD_EVOL_ALLOC(KMODEL,KPATCH) 01145 INTEGER, INTENT(IN) :: KMODEL,KPATCH 01146 INTEGER :: J, JP 01147 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01148 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_ALLOC",0,ZHOOK_HANDLE) 01149 ALLOCATE(TEB_GARDEN_PGD_EVOL_MODEL(KMODEL,KPATCH)) 01150 DO J=1,KMODEL 01151 DO JP=1,KPATCH 01152 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XALBNIR) 01153 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XALBVIS) 01154 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XALBUV) 01155 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XEMIS) 01156 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XZ0) 01157 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XVEG) 01158 NULLIFY(TEB_GARDEN_PGD_EVOL_MODEL(J,JP)%XLAI) 01159 END DO 01160 ENDDO 01161 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_ALLOC",1,ZHOOK_HANDLE) 01162 END SUBROUTINE TEB_GARDEN_PGD_EVOL_ALLOC 01163 01164 SUBROUTINE TEB_GARDEN_PGD_EVOL_DEALLO 01165 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01166 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_DEALLO",0,ZHOOK_HANDLE) 01167 IF (ALLOCATED(TEB_GARDEN_PGD_EVOL_MODEL)) DEALLOCATE(TEB_GARDEN_PGD_EVOL_MODEL) 01168 IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_DEALLO",1,ZHOOK_HANDLE) 01169 END SUBROUTINE TEB_GARDEN_PGD_EVOL_DEALLO 01170 01171 01172 01173 END MODULE MODD_TEB_GARDEN_n
1.8.0
