[7541] | 1 | ! ================================================================================================================================= |
---|
| 2 | ! MODULE : lpj_light |
---|
| 3 | ! |
---|
| 4 | ! CONTACT : orchidee-help _at_ listes.ipsl.fr |
---|
| 5 | ! |
---|
| 6 | ! LICENCE : IPSL (2006) |
---|
| 7 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
---|
| 8 | ! |
---|
| 9 | !>\BRIEF Light competition within a PFT |
---|
| 10 | !! |
---|
| 11 | !!\n DESCRIPTION: None |
---|
| 12 | !! |
---|
| 13 | !! RECENT CHANGE(S): None |
---|
| 14 | !! |
---|
| 15 | !! REFERENCE(S) : |
---|
| 16 | !! |
---|
| 17 | !! SVN : |
---|
| 18 | !! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_stomate/lpj_light.f90 $ |
---|
| 19 | !! $Date: 2017-10-02 16:24:23 +0200 (Mon, 02 Oct 2017) $ |
---|
| 20 | !! $Revision: 4647 $ |
---|
| 21 | !! \n |
---|
| 22 | !_ ================================================================================================================================ |
---|
| 23 | |
---|
| 24 | MODULE lpj_light |
---|
| 25 | |
---|
| 26 | ! modules used: |
---|
| 27 | USE xios_orchidee |
---|
| 28 | USE ioipsl_para |
---|
| 29 | USE constantes |
---|
| 30 | USE stomate_data |
---|
| 31 | |
---|
| 32 | IMPLICIT NONE |
---|
| 33 | |
---|
| 34 | ! private & public routines |
---|
| 35 | |
---|
| 36 | PRIVATE |
---|
| 37 | PUBLIC light, light_clear |
---|
| 38 | |
---|
| 39 | LOGICAL, SAVE :: firstcall_light = .TRUE. !! first call |
---|
| 40 | !$OMP THREADPRIVATE(firstcall_light) |
---|
| 41 | |
---|
| 42 | CONTAINS |
---|
| 43 | |
---|
| 44 | !! ================================================================================================================================ |
---|
| 45 | !! SUBROUTINE : light_clear |
---|
| 46 | !! |
---|
| 47 | !>\BRIEF Activation |
---|
| 48 | !! |
---|
| 49 | !_ ================================================================================================================================ |
---|
| 50 | |
---|
| 51 | SUBROUTINE light_clear |
---|
| 52 | firstcall_light=.TRUE. |
---|
| 53 | END SUBROUTINE light_clear |
---|
| 54 | |
---|
| 55 | |
---|
| 56 | !! ================================================================================================================================ |
---|
| 57 | !! SUBROUTINE : light |
---|
| 58 | !! |
---|
| 59 | !>\BRIEF Light competition within a PFT |
---|
| 60 | !! |
---|
| 61 | !! DESCRIPTION : This module kills PFTs based on light competition |
---|
| 62 | !! |
---|
| 63 | !! Here, fpc ("foilage projected cover") takes into account the minimum fraction |
---|
| 64 | !! of space covered by trees through branches etc. This is done to prevent strong relative |
---|
| 65 | !! changes of FPC from one day to another for deciduous trees at the beginning of their |
---|
| 66 | !! growing season, which would yield too strong cutbacks.\n |
---|
| 67 | !! |
---|
| 68 | !! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is |
---|
| 69 | !! to represent community ecology effects; seasonal variations in establishment related to phenology |
---|
| 70 | !! may be relevant, but beyond the scope of a 1st generation DGVM.\n |
---|
| 71 | !! |
---|
| 72 | !! If agriculture is present, fpc can never reach 1.0 since natural veget_cov_max < 1.0. To |
---|
| 73 | !! correct for this, ::ind must be recalculated to correspond to the natural density. |
---|
| 74 | !! since ::ind is expressed in m^{-2} grid cell, this can be achieved by dividing individual |
---|
| 75 | !! density by the agricultural fraction.\n |
---|
| 76 | !! |
---|
| 77 | !! The flow in the routine is different for ::ok_dgvm. When ::ok_dgvm is true |
---|
| 78 | !! the following processes are considered: |
---|
| 79 | !! |
---|
| 80 | !! No competition between woody pfts (height of individuals is not considered). |
---|
| 81 | !! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that |
---|
| 82 | !! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit. |
---|
| 83 | !! Age of individuals is not considered. In reality, light competition would more |
---|
| 84 | !! easily kill young individuals, thus increasing the mean age of the stand. |
---|
| 85 | !! Exclude agricultural pfts from competition.\n |
---|
| 86 | !! |
---|
| 87 | !! When ::ok_dgvm is false then light competition is calculated for the static case if the mortality is not |
---|
| 88 | !! assumed to be constant. The following processes are considered: XXX |
---|
| 89 | !! |
---|
| 90 | !! RECENT CHANGE(S): None |
---|
| 91 | !! |
---|
| 92 | !! MAIN OUTPUT VARIABLE(S): ind, biomass, veget_lastlight, bm_to_litter, mortality |
---|
| 93 | !! |
---|
| 94 | !! REFERENCES : |
---|
| 95 | !! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics, |
---|
| 96 | !! plant geography and terrestrial carbon cycling in the LPJ dynamic |
---|
| 97 | !! global vegetation model, Global Change Biology, 9, 161-185.\n |
---|
| 98 | !! |
---|
| 99 | !! FLOWCHART : None |
---|
| 100 | !! \n |
---|
| 101 | !_ ================================================================================================================================ |
---|
| 102 | |
---|
| 103 | SUBROUTINE light (npts, dt, & |
---|
| 104 | veget_cov_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, & |
---|
| 105 | lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality) |
---|
| 106 | |
---|
| 107 | |
---|
| 108 | !! 0. Variable and parameter declaration |
---|
| 109 | |
---|
| 110 | !! 0.1 Input variables |
---|
| 111 | |
---|
| 112 | INTEGER(i_std), INTENT(in) :: npts !! Domain size (unitless) |
---|
| 113 | REAL(r_std), INTENT(in) :: dt !! Time step (days) |
---|
| 114 | LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent !! TRUE if pft is present (true/false) |
---|
| 115 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind !! Crown area of individuals |
---|
| 116 | !! @tex $(m^2)$ @endtex |
---|
| 117 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai !! Leaf area index OF AN INDIVIDUAL PLANT |
---|
| 118 | !! @tex $(m^2 m^{-2})$ @endtex |
---|
| 119 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear !! Last year's maximum fpc for each natural |
---|
| 120 | !! PFT(unitless) |
---|
| 121 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_lastyearmax !! Last year's maximum leafmass for each |
---|
| 122 | !! natural PFT |
---|
| 123 | !! @tex $(gC m^2 s^{-1})$ @endtex |
---|
| 124 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_cov_max !! Current year's maximum fpc for each natural |
---|
| 125 | !! PFT (unitless;0-1) |
---|
| 126 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max !! Last year's maximum fpc for each natural |
---|
| 127 | !! PFT (unitless) |
---|
| 128 | |
---|
| 129 | !! 0.2 Output variables |
---|
| 130 | |
---|
| 131 | !! 0.3 Modified variables |
---|
| 132 | |
---|
| 133 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals |
---|
| 134 | !! @tex $(m^{-2})$ @endtex |
---|
| 135 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass !! Biomass @tex $(gCm^{-2})$ @endtex |
---|
| 136 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_lastlight !! Vegetation cover after last light |
---|
| 137 | !! competition (unitless;0-1) |
---|
| 138 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! Biomass transfer to litter per timestep |
---|
| 139 | !! @tex $(gCm^{-2})$ @endtex |
---|
| 140 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: mortality !! Fraction of individuals that died this |
---|
| 141 | !! time step per dt (unitless;0-1) |
---|
| 142 | |
---|
| 143 | !! 0.4 Local variables |
---|
| 144 | |
---|
| 145 | LOGICAL, PARAMETER :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare |
---|
| 146 | !! today's fpc to last year's Maximum (T) |
---|
| 147 | !! or to fpc of last time step (F) |
---|
| 148 | INTEGER(i_std) :: i,j,k,m !! Index (unitless) |
---|
| 149 | REAL(r_std), DIMENSION(npts) :: sumfpc !! Total natural fpc, sum of all the PFTs |
---|
| 150 | !! (unitless) |
---|
| 151 | REAL(r_std), DIMENSION(npts) :: fracnat !! Fraction of natural vegetation within a |
---|
| 152 | !! grid cell (unitless;0-1) |
---|
| 153 | REAL(r_std) :: sumfpc_wood !! Total natural woody fpc (unitless) |
---|
| 154 | REAL(r_std) :: sumdelta_fpc_wood !! Change in total woody fpc (unitless) |
---|
| 155 | REAL(r_std) :: maxfpc_wood !! Maximum wood fpc (unitless) |
---|
| 156 | INTEGER(i_std) :: optpft_wood !! Which woody pft is maximum (unitless) |
---|
| 157 | REAL(r_std) :: sumfpc_grass !! Total natural grass fpc (unitless) |
---|
| 158 | REAL(r_std), DIMENSION(npts,nvm) :: fpc_nat !! This year's foliage projected cover on |
---|
| 159 | !! natural part of the grid cell |
---|
| 160 | !! @tex $(m^2)$ @endtex |
---|
| 161 | REAL(r_std), DIMENSION(nvm) :: deltafpc !! fpc change within last year (unitless) |
---|
| 162 | REAL(r_std) :: reduct !! Relative change of number of individuals |
---|
| 163 | !! for trees (ind) |
---|
| 164 | REAL(r_std), DIMENSION(nvm) :: survive !! Fraction of plants that survive |
---|
| 165 | !! (unitless;0-1) |
---|
| 166 | REAL(r_std), DIMENSION(npts) :: fpc_real !! FPC for static mode (unitless) |
---|
| 167 | REAL(r_std), DIMENSION(npts) :: lai_ind !! FPC mortality for static mode |
---|
| 168 | REAL(r_std) :: sumfpc_grass2 !! New total grass fpc |
---|
| 169 | REAL(r_std), DIMENSION(npts,nvm) :: light_death !! Fraction of plants that dies each day |
---|
| 170 | !! @tex $(day^{-1})$ @endtex |
---|
| 171 | REAL(r_std) :: fpc_dec !! Relative change of number of individuals |
---|
| 172 | !! for trees |
---|
| 173 | !_ ================================================================================================================================ |
---|
| 174 | |
---|
| 175 | IF (printlev>=3) WRITE(numout,*) 'Entering light' |
---|
| 176 | |
---|
| 177 | |
---|
| 178 | !! 1. Write diagnostics to out_orchidee files |
---|
| 179 | |
---|
| 180 | IF ( firstcall_light ) THEN |
---|
| 181 | |
---|
| 182 | WRITE(numout,*) 'light:' |
---|
| 183 | |
---|
| 184 | WRITE(numout,*) ' > For trees, minimum fraction of crown area covered' |
---|
| 185 | WRITE(numout,*) ' (due to its branches etc.)', min_cover |
---|
| 186 | |
---|
| 187 | WRITE(numout,*) ' > for diagnosis of fpc increase, compare today''s fpc' |
---|
| 188 | IF ( annual_increase ) THEN |
---|
| 189 | WRITE(numout,*) ' to last year''s maximum.' |
---|
| 190 | ELSE |
---|
| 191 | WRITE(numout,*) ' to fpc of the last time step.' |
---|
| 192 | ENDIF |
---|
| 193 | |
---|
| 194 | firstcall_light = .FALSE. |
---|
| 195 | |
---|
| 196 | ENDIF |
---|
| 197 | |
---|
| 198 | !! 2. Light competition in DGVM |
---|
| 199 | |
---|
| 200 | IF (ok_dgvm) THEN |
---|
| 201 | |
---|
| 202 | !! 2.1 Calculate natural part of the grid cell |
---|
| 203 | fracnat(:) = un |
---|
| 204 | DO j = 2,nvm |
---|
| 205 | IF ( .NOT. natural(j) ) THEN |
---|
| 206 | fracnat(:) = fracnat(:) - veget_cov_max(:,j) |
---|
| 207 | ENDIF |
---|
| 208 | ENDDO |
---|
| 209 | |
---|
| 210 | !! 2.2 Calculate fpc on natural part of grid cell |
---|
| 211 | fpc_nat(:,:) = zero |
---|
| 212 | fpc_nat(:,ibare_sechiba) = un |
---|
| 213 | |
---|
| 214 | DO j = 2, nvm ! loop over #PFTs |
---|
| 215 | |
---|
| 216 | |
---|
| 217 | !! 2.2.1 Natural PFTs |
---|
| 218 | IF ( natural(j) ) THEN |
---|
| 219 | |
---|
| 220 | !!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure? |
---|
| 221 | !!?? CODE SHOULD BE CLEANED UP BELOW |
---|
| 222 | |
---|
| 223 | !! 2.2.1.1 Trees |
---|
| 224 | IF ( is_tree(j) ) THEN |
---|
| 225 | |
---|
| 226 | ! !! 2.1.1.1 trees: minimum cover due to stems, branches etc. |
---|
| 227 | ! DO i = 1, npts |
---|
| 228 | ! IF (lai(i,j) == val_exp) THEN |
---|
| 229 | ! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 230 | ! ELSE |
---|
| 231 | ! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & |
---|
| 232 | ! MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) |
---|
| 233 | ! ENDIF |
---|
| 234 | ! ENDDO |
---|
| 235 | !NV : modif from S. Zaehle version : fpc is based on veget_cov_max, not veget. |
---|
| 236 | |
---|
| 237 | WHERE(fracnat(:).GE.min_stomate) |
---|
| 238 | |
---|
| 239 | ! WHERE(LAI(:,j) == val_exp) |
---|
| 240 | ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) |
---|
| 241 | ! ELSEWHERE |
---|
| 242 | ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & |
---|
| 243 | ! MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover ) |
---|
| 244 | ! ENDWHERE |
---|
| 245 | |
---|
| 246 | fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) |
---|
| 247 | ENDWHERE |
---|
| 248 | |
---|
| 249 | ELSE |
---|
| 250 | |
---|
| 251 | !NV : modif from S. Zaehle version : fpc is based on veget_cov_max, not veget. |
---|
| 252 | !!?? DO GRASSES HAVE CROWNS? |
---|
| 253 | |
---|
| 254 | !! 2.2.1.1 Grasses |
---|
| 255 | WHERE(fracnat(:).GE.min_stomate) |
---|
| 256 | |
---|
| 257 | ! WHERE(LAI(:,j) == val_exp) |
---|
| 258 | ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) |
---|
| 259 | ! ELSEWHERE |
---|
| 260 | ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & |
---|
| 261 | ! ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) |
---|
| 262 | ! ENDWHERE |
---|
| 263 | |
---|
| 264 | fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) |
---|
| 265 | ENDWHERE |
---|
| 266 | |
---|
| 267 | !!!$ ! 2.1.1.2 bare ground |
---|
| 268 | !!!$ IF (j == ibare_sechiba) THEN |
---|
| 269 | !!!$ fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) |
---|
| 270 | !!!$ |
---|
| 271 | !!!$ ! 2.1.1.3 grasses |
---|
| 272 | !!!$ ELSE |
---|
| 273 | !!!$ DO i = 1, npts |
---|
| 274 | !!!$ IF (lai(i,j) == val_exp) THEN |
---|
| 275 | !!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 276 | !!!$ ELSE |
---|
| 277 | !!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & |
---|
| 278 | !!!$ ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ) |
---|
| 279 | !!!$ ENDIF |
---|
| 280 | !!!$ ENDDO |
---|
| 281 | !!!$ ENDIF |
---|
| 282 | |
---|
| 283 | ENDIF ! tree/grass |
---|
| 284 | |
---|
| 285 | ELSE |
---|
| 286 | |
---|
| 287 | !! 2.2.2 Agricultural PFTs |
---|
| 288 | ! Agriculural PFTs are not present on natural part |
---|
| 289 | fpc_nat(:,j) = zero |
---|
| 290 | |
---|
| 291 | ENDIF ! natural/agricultural |
---|
| 292 | |
---|
| 293 | ENDDO |
---|
| 294 | |
---|
| 295 | |
---|
| 296 | !! 2.3 Total fpc for grid point |
---|
| 297 | sumfpc(:) = zero |
---|
| 298 | DO j = 2,nvm |
---|
| 299 | |
---|
| 300 | !S. Zaehle bug correction MERGE: need to subtract agricultural area! |
---|
| 301 | sumfpc(:) = sumfpc(:) + fpc_nat(:,j) |
---|
| 302 | ENDDO |
---|
| 303 | |
---|
| 304 | |
---|
| 305 | !! 2.4 Light competition |
---|
| 306 | |
---|
| 307 | light_death(:,:) = zero |
---|
| 308 | |
---|
| 309 | DO i = 1, npts ! S. Zaehle why this loop and not a vector statement ? |
---|
| 310 | |
---|
| 311 | !! 2.4.1 Dense canopy |
---|
| 312 | IF ( sumfpc(i) .GT. fpc_crit ) THEN |
---|
| 313 | |
---|
| 314 | ! 2.4.1.1 fpc change for each pft |
---|
| 315 | ! There are two possibilities: either we compare today's fpc with the fpc after the last |
---|
| 316 | ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case, |
---|
| 317 | ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season. |
---|
| 318 | ! As for trees, the cutback is proportional to this increase, this means that seasonal trees |
---|
| 319 | ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its |
---|
| 320 | ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.) |
---|
| 321 | |
---|
| 322 | IF ( annual_increase ) THEN |
---|
| 323 | deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero ) |
---|
| 324 | ELSE |
---|
| 325 | deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero ) |
---|
| 326 | ENDIF |
---|
| 327 | |
---|
| 328 | !! 2.4.1.2 Default survival |
---|
| 329 | survive(:) = un |
---|
| 330 | |
---|
| 331 | |
---|
| 332 | !! 2.4.1.3 Determine some characteristics of the fpc distribution |
---|
| 333 | sumfpc_wood = zero |
---|
| 334 | sumdelta_fpc_wood = zero |
---|
| 335 | maxfpc_wood = zero |
---|
| 336 | optpft_wood = 0 |
---|
| 337 | sumfpc_grass = zero |
---|
| 338 | |
---|
| 339 | DO j = 2,nvm ! loop over #PFTs |
---|
| 340 | |
---|
| 341 | !! 2.4.1.3.1 Natural pfts |
---|
| 342 | IF ( natural(j) ) THEN |
---|
| 343 | |
---|
| 344 | !! 2.4.1.3.1.1 Trees |
---|
| 345 | IF ( is_tree(j) ) THEN |
---|
| 346 | |
---|
| 347 | ! total woody fpc |
---|
| 348 | sumfpc_wood = sumfpc_wood + fpc_nat(i,j) |
---|
| 349 | |
---|
| 350 | ! how much did the woody fpc increase |
---|
| 351 | sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j) |
---|
| 352 | |
---|
| 353 | ! which woody pft is preponderant |
---|
| 354 | IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN |
---|
| 355 | |
---|
| 356 | optpft_wood = j |
---|
| 357 | |
---|
| 358 | maxfpc_wood = fpc_nat(i,j) |
---|
| 359 | |
---|
| 360 | ENDIF |
---|
| 361 | |
---|
| 362 | ELSE |
---|
| 363 | |
---|
| 364 | !! 2.4.1.3.1.2 Grasses |
---|
| 365 | ! total (natural) grass fpc |
---|
| 366 | sumfpc_grass = sumfpc_grass + fpc_nat(i,j) |
---|
| 367 | |
---|
| 368 | ENDIF ! tree or grass |
---|
| 369 | |
---|
| 370 | ENDIF ! natural |
---|
| 371 | |
---|
| 372 | ENDDO ! loop over pfts |
---|
| 373 | |
---|
| 374 | !! 2.4.1.4 Wood outcompetes grass |
---|
| 375 | ! Light competition where wood outcompetes grasses |
---|
| 376 | |
---|
| 377 | !S. Zaehle IF (sumfpc_wood .GE. fpc_crit ) THEN |
---|
| 378 | ! |
---|
| 379 | !! 3.2.1 all allowed natural space is covered by wood: |
---|
| 380 | !! cut back trees to fpc_crit. |
---|
| 381 | !! Original DGVM: kill grasses. Modified: we let a very |
---|
| 382 | !! small fraction of grasses survive. |
---|
| 383 | ! |
---|
| 384 | |
---|
| 385 | DO j = 2,nvm ! Loop over #PFTs |
---|
| 386 | |
---|
| 387 | ! only present and natural pfts compete |
---|
| 388 | IF ( PFTpresent(i,j) .AND. natural(j) ) THEN |
---|
| 389 | |
---|
| 390 | !! 2.4.1.4.1 Trees |
---|
| 391 | IF ( is_tree(j) ) THEN |
---|
| 392 | |
---|
| 393 | ! no single woody pft is overwhelming |
---|
| 394 | ! (original DGVM: tree_mercy = 0.0 ) |
---|
| 395 | ! The reduction rate is proportional to the ratio deltafpc/fpc. |
---|
| 396 | IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. & |
---|
| 397 | sumdelta_fpc_wood .GT. min_stomate) THEN |
---|
| 398 | |
---|
| 399 | ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * & |
---|
| 400 | ! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), & |
---|
| 401 | ! ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously) |
---|
| 402 | |
---|
| 403 | !!? difficult to fully understand but doesn't look so simple |
---|
| 404 | reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) & |
---|
| 405 | * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un ) |
---|
| 406 | |
---|
| 407 | ELSE |
---|
| 408 | |
---|
| 409 | ! tree fpc didn't icrease or it started from nothing |
---|
| 410 | reduct = zero |
---|
| 411 | |
---|
| 412 | ENDIF |
---|
| 413 | ELSE |
---|
| 414 | |
---|
| 415 | !! 2.4.1.4.2 Grasses |
---|
| 416 | ! Let a very small fraction survive (the sum of all |
---|
| 417 | ! grass individuals may make up a maximum cover of |
---|
| 418 | ! grass_mercy [for lai -> infinity]). |
---|
| 419 | ! In the original DGVM, grasses were killed in that case, |
---|
| 420 | ! corresponding to grass_mercy = 0. |
---|
| 421 | ! |
---|
| 422 | |
---|
| 423 | IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. & |
---|
| 424 | sumfpc_grass.GE.min_stomate) THEN |
---|
| 425 | |
---|
| 426 | fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass |
---|
| 427 | |
---|
| 428 | reduct = fpc_dec |
---|
| 429 | ELSE |
---|
| 430 | reduct = zero |
---|
| 431 | ENDIF |
---|
| 432 | ENDIF ! tree or grass |
---|
| 433 | |
---|
| 434 | survive(j) = un - reduct |
---|
| 435 | ENDIF ! pft there and natural |
---|
| 436 | |
---|
| 437 | ENDDO ! loop over pfts |
---|
| 438 | |
---|
| 439 | !S. Zaehle |
---|
| 440 | !!!$ ELSE |
---|
| 441 | !!!$ |
---|
| 442 | !!!$ ! |
---|
| 443 | !!!$ ! 3.2.2 not too much wood so that grasses can subsist |
---|
| 444 | !!!$ ! |
---|
| 445 | !!!$ |
---|
| 446 | !!!$ ! new total grass fpc |
---|
| 447 | !!!$ sumfpc_grass2 = fpc_crit - sumfpc_wood |
---|
| 448 | !!!$ |
---|
| 449 | !!!$ DO j = 2,nvm |
---|
| 450 | !!!$ |
---|
| 451 | !!!$ ! only present and natural PFTs compete |
---|
| 452 | !!!$ |
---|
| 453 | !!!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN |
---|
| 454 | !!!$ |
---|
| 455 | !!!$ IF ( is_tree(j) ) THEN |
---|
| 456 | !!!$ |
---|
| 457 | !!!$ ! no change for trees |
---|
| 458 | !!!$ |
---|
| 459 | !!!$ survive(j) = 1.0 |
---|
| 460 | !!!$ |
---|
| 461 | !!!$ ELSE |
---|
| 462 | !!!$ |
---|
| 463 | !!!$ ! grass: fractional loss is the same for all grasses |
---|
| 464 | !!!$ |
---|
| 465 | !!!$ IF ( sumfpc_grass .GT. min_stomate ) THEN |
---|
| 466 | !!!$ survive(j) = sumfpc_grass2 / sumfpc_grass |
---|
| 467 | !!!$ ELSE |
---|
| 468 | !!!$ survive(j)= zero |
---|
| 469 | !!!$ ENDIF |
---|
| 470 | !!!$ |
---|
| 471 | !!!$ ENDIF |
---|
| 472 | !!!$ |
---|
| 473 | !!!$ ENDIF ! pft there and natural |
---|
| 474 | !!!$ |
---|
| 475 | !!!$ ENDDO ! loop over pfts |
---|
| 476 | !!!$ |
---|
| 477 | !!!$ ENDIF ! sumfpc_wood > fpc_crit |
---|
| 478 | |
---|
| 479 | |
---|
| 480 | !! 2.4.1.5 Update biomass and litter pools |
---|
| 481 | |
---|
| 482 | DO j = 2,nvm ! Loop over #PFTs |
---|
| 483 | |
---|
| 484 | ! Natural PFTs |
---|
| 485 | IF ( PFTpresent(i,j) .AND. natural(j) ) THEN |
---|
| 486 | |
---|
| 487 | bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + & |
---|
| 488 | biomass(i,j,:,:) * ( un - survive(j) ) |
---|
| 489 | |
---|
| 490 | biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j) |
---|
| 491 | |
---|
| 492 | !? We are in a section where ok_dgvm is already at TRUE: No need to test it again |
---|
| 493 | IF ( ok_dgvm ) THEN |
---|
| 494 | ind(i,j) = ind(i,j) * survive(j) |
---|
| 495 | ENDIF |
---|
| 496 | |
---|
| 497 | ! fraction of plants that dies each day. |
---|
| 498 | ! exact formulation: light_death(i,j) = un - survive(j) / dt |
---|
| 499 | light_death(i,j) = ( un - survive(j) ) / dt |
---|
| 500 | |
---|
| 501 | ENDIF ! pft there and natural |
---|
| 502 | |
---|
| 503 | ENDDO ! loop over pfts |
---|
| 504 | |
---|
| 505 | ENDIF ! sumfpc > fpc_crit |
---|
| 506 | |
---|
| 507 | ENDDO ! loop over grid points |
---|
| 508 | |
---|
| 509 | |
---|
| 510 | !! 2.5 Recalculate fpc for natural PFTs |
---|
| 511 | ! Recalculate fpc on natural part of the grid cell for next light competition |
---|
| 512 | DO j = 2,nvm ! loop over #PFT |
---|
| 513 | |
---|
| 514 | !! 2.5.1 Natural PFTs |
---|
| 515 | IF ( natural(j) ) THEN |
---|
| 516 | |
---|
| 517 | !! 2.5.1.1 Trees |
---|
| 518 | IF ( is_tree(j) ) THEN |
---|
| 519 | |
---|
| 520 | DO i = 1, npts |
---|
| 521 | |
---|
| 522 | !NVMODIF |
---|
| 523 | ! IF (lai(i,j) == val_exp) THEN |
---|
| 524 | ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 525 | ! ELSE |
---|
| 526 | ! veget_lastlight(i,j) = & |
---|
| 527 | ! cn_ind(i,j) * ind(i,j) * & |
---|
| 528 | ! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) |
---|
| 529 | ! ENDIF |
---|
| 530 | !! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 531 | |
---|
| 532 | IF (lai(i,j) == val_exp) THEN |
---|
| 533 | veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 534 | ELSE |
---|
| 535 | veget_lastlight(i,j) = & |
---|
| 536 | cn_ind(i,j) * ind(i,j) * & |
---|
| 537 | MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover ) |
---|
| 538 | ENDIF |
---|
| 539 | ENDDO |
---|
| 540 | |
---|
| 541 | ELSE |
---|
| 542 | |
---|
| 543 | !! 2.5.1.2 Grasses |
---|
| 544 | DO i = 1, npts |
---|
| 545 | |
---|
| 546 | !NVMODIF |
---|
| 547 | ! IF (lai(i,j) == val_exp) THEN |
---|
| 548 | ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 549 | ! ELSE |
---|
| 550 | ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & |
---|
| 551 | ! ( un - exp( -lai(i,j) * ext_coeff(j) ) ) |
---|
| 552 | ! ENDIF |
---|
| 553 | !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 554 | |
---|
| 555 | IF (lai(i,j) == val_exp) THEN |
---|
| 556 | veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) |
---|
| 557 | ELSE |
---|
| 558 | veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & |
---|
| 559 | ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ) |
---|
| 560 | ENDIF |
---|
| 561 | ENDDO |
---|
| 562 | ENDIF ! tree/grass |
---|
| 563 | |
---|
| 564 | ELSE |
---|
| 565 | |
---|
| 566 | !! 2.5.2 Agricultural PFTs |
---|
| 567 | ! Agricultural PFTs are not present on the natural part of the grid point |
---|
| 568 | veget_lastlight(:,j) = zero |
---|
| 569 | |
---|
| 570 | ENDIF ! natural/agricultural |
---|
| 571 | |
---|
| 572 | ENDDO ! # PFTs |
---|
| 573 | |
---|
| 574 | ELSE ! ok_dgvm |
---|
| 575 | |
---|
| 576 | !! 3. Light competition in stomate (without DGVM) |
---|
| 577 | |
---|
| 578 | light_death(:,:) = zero |
---|
| 579 | |
---|
| 580 | DO j = 2, nvm |
---|
| 581 | |
---|
| 582 | IF ( natural(j) ) THEN |
---|
| 583 | |
---|
| 584 | !! NUMBERING BELOW SHOULD BE 5.0 or 4.3 |
---|
| 585 | !! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses, |
---|
| 586 | !! neither a redistribution of mortality (delta fpc) |
---|
| 587 | |
---|
| 588 | !! 3.1 XXX |
---|
| 589 | WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) |
---|
| 590 | lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) ) |
---|
| 591 | ELSEWHERE |
---|
| 592 | lai_ind(:) = zero |
---|
| 593 | ENDWHERE |
---|
| 594 | |
---|
| 595 | fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * & |
---|
| 596 | MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) |
---|
| 597 | |
---|
| 598 | WHERE(fpc_nat(:,j).GT.fpc_max(:,j)) |
---|
| 599 | |
---|
| 600 | light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j)) |
---|
| 601 | |
---|
| 602 | ENDWHERE |
---|
| 603 | |
---|
| 604 | !! 3.2 Update biomass and litter pools |
---|
| 605 | DO m = 1,nelements |
---|
| 606 | DO k=1,nparts |
---|
| 607 | |
---|
| 608 | bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m) |
---|
| 609 | biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m) |
---|
| 610 | |
---|
| 611 | ENDDO |
---|
| 612 | END DO |
---|
| 613 | |
---|
| 614 | !! 3.3 Update number of individuals |
---|
| 615 | ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j) |
---|
| 616 | |
---|
| 617 | ENDIF |
---|
| 618 | ENDDO |
---|
| 619 | |
---|
| 620 | light_death(:,:) = light_death(:,:)/dt |
---|
| 621 | |
---|
| 622 | ENDIF ! ok_dgvm |
---|
| 623 | |
---|
| 624 | |
---|
| 625 | !! 4. Write history files |
---|
| 626 | CALL xios_orchidee_send_field("light_death",light_death) |
---|
| 627 | |
---|
| 628 | CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, & |
---|
| 629 | light_death, npts*nvm, horipft_index) |
---|
| 630 | |
---|
| 631 | IF (printlev>=4) WRITE(numout,*) 'Leaving light' |
---|
| 632 | |
---|
| 633 | END SUBROUTINE light |
---|
| 634 | |
---|
| 635 | END MODULE lpj_light |
---|