| 1 | ! ================================================================================================================================= |
|---|
| 2 | ! MODULE : stomate_kill |
|---|
| 3 | ! |
|---|
| 4 | ! CONTACT : orchidee-help _at_ ipsl.jussieu.fr |
|---|
| 5 | ! |
|---|
| 6 | ! LICENCE : IPSL (2006) |
|---|
| 7 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
|---|
| 8 | ! |
|---|
| 9 | !>\BRIEF Simulate mortality of individuals and update biomass, litter and |
|---|
| 10 | !! stand density of the PFT |
|---|
| 11 | !! |
|---|
| 12 | !!\n DESCRIPTION : Simulate mortality of individuals and update biomass, litter and |
|---|
| 13 | !! stand density of the PFT. This module replaces lpj_gap/kill. Biomass actually |
|---|
| 14 | !! dies here and is moved to the litter pools. This does not work with the DGVM |
|---|
| 15 | !! at the moment. |
|---|
| 16 | !! |
|---|
| 17 | !! RECENT CHANGE(S): None |
|---|
| 18 | !! |
|---|
| 19 | !! REFERENCE(S) : |
|---|
| 20 | !! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics, |
|---|
| 21 | !! plant geography and terrestrial carbon cycling in the LPJ dynamic |
|---|
| 22 | !! global vegetation model, Global Change Biology, 9, 161-185.\n |
|---|
| 23 | !! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation |
|---|
| 24 | !! to canopy leaf area." Advances in Ecological Research 13: 327-354.\n |
|---|
| 25 | !! |
|---|
| 26 | !! SVN : |
|---|
| 27 | !! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_kill.f90 $ |
|---|
| 28 | !! $Date: 2013-09-27 09:59:24 +0200 (Fri, 27 Sep 2013) $ |
|---|
| 29 | !! $Revision: 1485 $ |
|---|
| 30 | !! \n |
|---|
| 31 | !_ ================================================================================================================================ |
|---|
| 32 | |
|---|
| 33 | MODULE stomate_kill |
|---|
| 34 | |
|---|
| 35 | ! modules used: |
|---|
| 36 | |
|---|
| 37 | USE stomate_data |
|---|
| 38 | USE pft_parameters |
|---|
| 39 | USE constantes |
|---|
| 40 | USE ioipsl_para |
|---|
| 41 | USE stomate_prescribe |
|---|
| 42 | USE stomate_mark_kill, ONLY : distribute_mortality_biomass |
|---|
| 43 | USE function_library, ONLY : nmax, wood_to_dia, check_vegetation_area, & |
|---|
| 44 | check_mass_balance, sort_circ_class_biomass, & |
|---|
| 45 | cc_to_biomass |
|---|
| 46 | USE sapiens_lcchange, ONLY : merge_biomass_pfts |
|---|
| 47 | |
|---|
| 48 | IMPLICIT NONE |
|---|
| 49 | |
|---|
| 50 | ! private & public routines |
|---|
| 51 | |
|---|
| 52 | PRIVATE |
|---|
| 53 | PUBLIC natural_mortality, natural_mortality_clear, mortality_clean |
|---|
| 54 | |
|---|
| 55 | ! Variable declaration |
|---|
| 56 | |
|---|
| 57 | LOGICAL, SAVE :: firstcall_stomate_kill = .TRUE. !! first call flag |
|---|
| 58 | !$OMP THREADPRIVATE(firstcall_stomate_kill) |
|---|
| 59 | INTEGER(i_std), SAVE :: printlev_loc !! Local level of text output for current module |
|---|
| 60 | !$OMP THREADPRIVATE(printlev_loc) |
|---|
| 61 | CONTAINS |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | !! ================================================================================================================================ |
|---|
| 65 | !! SUBROUTINE : natural_mortality_clear |
|---|
| 66 | !! |
|---|
| 67 | !>\BRIEF Set the firstcall flag back to .TRUE. to prepare for the next simulation. |
|---|
| 68 | !_ ================================================================================================================================ |
|---|
| 69 | |
|---|
| 70 | SUBROUTINE natural_mortality_clear |
|---|
| 71 | firstcall_stomate_kill = .TRUE. |
|---|
| 72 | END SUBROUTINE natural_mortality_clear |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | !! ================================================================================================================================ |
|---|
| 76 | !! SUBROUTINE : natural_mortality |
|---|
| 77 | !! |
|---|
| 78 | !>\BRIEF Transfer dead biomass to litter and update stand density for trees |
|---|
| 79 | !! which die of natural causes. |
|---|
| 80 | !! |
|---|
| 81 | !! DESCRIPTION : This routine has a simple purpose: kill individuals by natural causes. |
|---|
| 82 | !! The variable circ_class_kill indicates how many individuals need to be killed by the various |
|---|
| 83 | !! processes in the code, and is calculated in other modules. natural_mortality takes |
|---|
| 84 | !! this variable and decides on the correct order of which to actually kill the |
|---|
| 85 | !! trees, making sure that we don't double count. |
|---|
| 86 | !! |
|---|
| 87 | !! RECENT CHANGE(S): |
|---|
| 88 | !! |
|---|
| 89 | !! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass; ::circ_class_n density of individuals, |
|---|
| 90 | !! ::mortality mortality (fraction of trees that is dying per time step) |
|---|
| 91 | !! |
|---|
| 92 | !! REFERENCE(S) : |
|---|
| 93 | !! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics, |
|---|
| 94 | !! plant geography and terrestrial carbon cycling in the LPJ dynamic |
|---|
| 95 | !! global vegetation model, Global Change Biology, 9, 161-185. |
|---|
| 96 | !! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation |
|---|
| 97 | !! to canopy leaf area." Advances in Ecological Research 13: 327-354. |
|---|
| 98 | !! |
|---|
| 99 | !! FLOWCHART : None |
|---|
| 100 | !!\n |
|---|
| 101 | !_ ================================================================================================================================ |
|---|
| 102 | |
|---|
| 103 | SUBROUTINE natural_mortality (npts, bm_to_litter, & |
|---|
| 104 | circ_class_biomass, circ_class_kill, circ_class_n, & |
|---|
| 105 | veget_max, biomass_cut, plant_status) |
|---|
| 106 | |
|---|
| 107 | !! 0. Variable and parameter declaration |
|---|
| 108 | |
|---|
| 109 | !! 0.1 Input variables |
|---|
| 110 | INTEGER(i_std), INTENT(in) :: npts !! Domain size (-) |
|---|
| 111 | REAL(r_std),DIMENSION(:,:),INTENT(in) :: veget_max !! Maximum fraction of vegetation type |
|---|
| 112 | |
|---|
| 113 | !! 0.2 Output variables |
|---|
| 114 | |
|---|
| 115 | !! 0.3 Modified variables |
|---|
| 116 | REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass !! Biomass of the components of the model |
|---|
| 117 | !! tree within a circumference |
|---|
| 118 | !! class @tex $(gC ind^{-1})$ @endtex |
|---|
| 119 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: circ_class_n !! Number of individuals in each circ class |
|---|
| 120 | !! @tex $(m^{-2})$ @endtex |
|---|
| 121 | REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_kill !! Number of trees within a circ that needs |
|---|
| 122 | !! to be killed @tex $(ind m^{-2})$ @endtex |
|---|
| 123 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: bm_to_litter !! Biomass transfer to litter |
|---|
| 124 | !! @tex $(gC m^{-2})$ @endtex |
|---|
| 125 | REAL(r_std), DIMENSION(:,:,:,:,:,:), INTENT(inout) :: biomass_cut !! Biomass change due to ncut |
|---|
| 126 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: plant_status !! Growth and phenological status of the plant |
|---|
| 127 | !! see constants voor values |
|---|
| 128 | |
|---|
| 129 | !! 0.4 Local variables |
|---|
| 130 | INTEGER(i_std) :: ipts, ivm, ipar !! Indices |
|---|
| 131 | INTEGER(i_std) :: iele, icir, imbc !! Indices |
|---|
| 132 | INTEGER(i_std) :: ifm,icut !! Indices |
|---|
| 133 | INTEGER,DIMENSION(nvm) :: nkilled !! the number of grid points at which a given |
|---|
| 134 | !! given PFT's biomass has been reduced to zero |
|---|
| 135 | REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) :: check_intern !! Contains the components of the internal |
|---|
| 136 | !! mass balance chech for this routine |
|---|
| 137 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 138 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: closure_intern !! Check closure of internal mass balance |
|---|
| 139 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 140 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: pool_start !! Start pool of this routine |
|---|
| 141 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 142 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: pool_end !! End pool of this routine |
|---|
| 143 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 144 | REAL(r_std), DIMENSION(npts,nvm) :: veget_max_begin !! temporary storage of veget_max to check area conservation |
|---|
| 145 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: init_biomass !! Temporary array of the initial biomass |
|---|
| 146 | REAL(r_std), DIMENSION(nparts,nelements) :: actu_biomass !! Temporary array of the actual biomass |
|---|
| 147 | REAL(r_std) :: ndying !! Number of trees that die in a single day (trees/m2) |
|---|
| 148 | !_ ================================================================================================================================ |
|---|
| 149 | |
|---|
| 150 | !! Initialize variables |
|---|
| 151 | |
|---|
| 152 | !! 1.1 Set firstcall flag |
|---|
| 153 | IF ( firstcall_stomate_kill ) THEN |
|---|
| 154 | !! Initialize local printlev |
|---|
| 155 | printlev_loc=get_printlev('stomate_kill') |
|---|
| 156 | firstcall_stomate_kill = .FALSE. |
|---|
| 157 | ENDIF |
|---|
| 158 | |
|---|
| 159 | IF (printlev_loc.GE.2) WRITE(numout,*) 'Entering natural mortality. Use constant mortality = ', & |
|---|
| 160 | ok_constant_mortality |
|---|
| 161 | |
|---|
| 162 | !! 1.2 Initialize variables |
|---|
| 163 | nkilled(:)=0 |
|---|
| 164 | |
|---|
| 165 | ! 1.3 Initialize check for mass balance closure |
|---|
| 166 | IF (err_act.GT.1) THEN |
|---|
| 167 | |
|---|
| 168 | check_intern(:,:,:,:) = zero |
|---|
| 169 | pool_start(:,:,:) = zero |
|---|
| 170 | DO ipar = 1,nparts |
|---|
| 171 | DO iele = 1,nelements |
|---|
| 172 | ! Initial litter and biomass |
|---|
| 173 | DO icir = 1,ncirc |
|---|
| 174 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 175 | (circ_class_biomass(:,:,icir,ipar,iele) * & |
|---|
| 176 | circ_class_n(:,:,icir) * veget_max(:,:)) |
|---|
| 177 | |
|---|
| 178 | ENDDO |
|---|
| 179 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 180 | bm_to_litter(:,:,ipar,iele) * veget_max(:,:) |
|---|
| 181 | ENDDO |
|---|
| 182 | ENDDO |
|---|
| 183 | |
|---|
| 184 | !! 1.3 Initialize check for area conservation |
|---|
| 185 | veget_max_begin(:,:) = veget_max(:,:) |
|---|
| 186 | |
|---|
| 187 | ENDIF ! err_act.GT.1 |
|---|
| 188 | |
|---|
| 189 | ! The total biomass at the start of the routine |
|---|
| 190 | init_biomass = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),& |
|---|
| 191 | circ_class_n(:,:,:)) |
|---|
| 192 | |
|---|
| 193 | |
|---|
| 194 | DO ipts = 1,npts ! loop over land_points |
|---|
| 195 | |
|---|
| 196 | DO ivm = 2,nvm ! loop over #PFT |
|---|
| 197 | |
|---|
| 198 | IF(veget_max(ipts,ivm) == zero)THEN |
|---|
| 199 | ! this vegetation type is not present, so no reason |
|---|
| 200 | ! to do the calculation |
|---|
| 201 | CYCLE |
|---|
| 202 | ENDIF |
|---|
| 203 | |
|---|
| 204 | !! Make unmanaged forest die slowly |
|---|
| 205 | ! This IF statement is used to overcome a huge wood litter input |
|---|
| 206 | ! when a forest has to be killed when it reach dens_target(ivm). |
|---|
| 207 | ! Instead, the forest will slowly die at a rate define by 365*15 |
|---|
| 208 | ! (days. Note that 15 is externalized as ndying_year) in order |
|---|
| 209 | ! to distribute the wood litter over multiple years. During this |
|---|
| 210 | ! state, trees recruitment is disabled. |
|---|
| 211 | IF(SUM(circ_class_n(ipts,ivm,:)) .LT. dens_target(ivm)*ha_to_m2) THEN |
|---|
| 212 | |
|---|
| 213 | DO icir=1,ncirc |
|---|
| 214 | |
|---|
| 215 | ! Number of tree to be removed every days since dens_target |
|---|
| 216 | ! is exceeded. The first time ndying is calculated, the |
|---|
| 217 | ! value will result in circ_calss_n = 0 after ndying years. |
|---|
| 218 | ! But ndying_years is long and trees might get killed for |
|---|
| 219 | ! other reasons as well so circ_class_n might reach zero |
|---|
| 220 | ! in less than ndying_year. Make ndying never exceeds |
|---|
| 221 | ! circ_class_n(:,:,icir). |
|---|
| 222 | ndying = MIN(circ_class_n(ipts,ivm,icir), & |
|---|
| 223 | (dens_target(ivm)/(365*ndying_year(ivm)))*ha_to_m2) |
|---|
| 224 | |
|---|
| 225 | ! Move the dead trees to the bm_to_litter pool |
|---|
| 226 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + & |
|---|
| 227 | circ_class_biomass(ipts,ivm,icir,:,:)*ndying |
|---|
| 228 | |
|---|
| 229 | ! remove the number of individuals that died |
|---|
| 230 | circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir)-& |
|---|
| 231 | ndying |
|---|
| 232 | |
|---|
| 233 | END DO |
|---|
| 234 | |
|---|
| 235 | ! Debug |
|---|
| 236 | IF (printlev_loc>=4) THEN |
|---|
| 237 | WRITE(numout,*) 'Slowly kill PFT, ',ipts,ivm |
|---|
| 238 | WRITE(numout,*) 'ndying, ', ndying |
|---|
| 239 | WRITE(numout,*) 'circ_class_n, ', SUM(circ_class_n(ipts,ivm,:)) |
|---|
| 240 | WRITE(numout,*) 'nb strem thresold,', dens_target(ivm)*0.01*ha_to_m2 |
|---|
| 241 | ENDIF |
|---|
| 242 | !- |
|---|
| 243 | |
|---|
| 244 | ! When only 1% of the dens_target tree remain we kill the |
|---|
| 245 | ! rest of the stand. |
|---|
| 246 | IF(SUM(circ_class_n(ipts,ivm,:)) .LE. dens_target(ivm)*0.01*ha_to_m2)THEN |
|---|
| 247 | |
|---|
| 248 | DO icir = 1,ncirc |
|---|
| 249 | |
|---|
| 250 | ! Move the dead trees to the bm_to_litter pool |
|---|
| 251 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:)+ & |
|---|
| 252 | circ_class_biomass(ipts,ivm,icir,:,:)*& |
|---|
| 253 | circ_class_n(ipts,ivm,icir) |
|---|
| 254 | |
|---|
| 255 | ! zero the number of individuals in this circ class |
|---|
| 256 | circ_class_n(ipts,ivm,icir) = zero |
|---|
| 257 | circ_class_biomass(ipts,ivm,icir,:,:) = zero |
|---|
| 258 | |
|---|
| 259 | END DO |
|---|
| 260 | |
|---|
| 261 | ! No plants left. Set plant_status to idead |
|---|
| 262 | plant_status(ipts,ivm) = idead |
|---|
| 263 | |
|---|
| 264 | ! The PFT is dead so if we already assigned some trees |
|---|
| 265 | ! to be killed in the rest of this module, this is no |
|---|
| 266 | ! longer possible. Set circ_class_kill to zero. |
|---|
| 267 | circ_class_kill(ipts,ivm,:,:,:) = zero |
|---|
| 268 | |
|---|
| 269 | ! Debug |
|---|
| 270 | IF (printlev_loc>=4) THEN |
|---|
| 271 | WRITE(numout,*) 'End of slow killing, ', ipts,ivm |
|---|
| 272 | WRITE(numout,*) 'circ_class_n, ', SUM(circ_class_n(ipts,ivm,:)) |
|---|
| 273 | WRITE(numout,*) 'Plant_status, ',plant_status(ipts,ivm) |
|---|
| 274 | ENDIF |
|---|
| 275 | !- |
|---|
| 276 | |
|---|
| 277 | ENDIF |
|---|
| 278 | |
|---|
| 279 | ! Actual biomass after mortality has been accounted for |
|---|
| 280 | actu_biomass = cc_to_biomass(npts,nvm,& |
|---|
| 281 | circ_class_biomass(ipts,ivm,:,:,:),& |
|---|
| 282 | circ_class_n(ipts,ivm,:)) |
|---|
| 283 | |
|---|
| 284 | biomass_cut(ipts,ivm,:,:,ifm_none,icut_clear) = & |
|---|
| 285 | biomass_cut(ipts,ivm,:,:,ifm_none,icut_clear) + & |
|---|
| 286 | init_biomass(ipts,ivm,:,:) - actu_biomass(:,:) |
|---|
| 287 | |
|---|
| 288 | ! Update the initial biomass to avoid double counting |
|---|
| 289 | init_biomass(ipts,ivm,:,:) = actu_biomass(:,:) |
|---|
| 290 | |
|---|
| 291 | ENDIF |
|---|
| 292 | |
|---|
| 293 | !! 3. Remove individuals that were send to circ_class_kill |
|---|
| 294 | |
|---|
| 295 | ! First, all the plants that are supposed to be killed by |
|---|
| 296 | ! fire are killed. We do not yet know how to handle this, |
|---|
| 297 | ! so this will have to be taken into account when SPITFIRE |
|---|
| 298 | ! is coupled. |
|---|
| 299 | |
|---|
| 300 | ! All of the natural death is grouped |
|---|
| 301 | ! together in one pool since all of the biomass will be left on |
|---|
| 302 | ! site (moved to the litter pools). |
|---|
| 303 | DO ifm=1,nfm_types |
|---|
| 304 | |
|---|
| 305 | DO icut=1,ncut_times |
|---|
| 306 | |
|---|
| 307 | ! Since we gave circ_class_kill the same dimensions as the |
|---|
| 308 | ! harvest pool, we need to explicitly say which combinations |
|---|
| 309 | ! of ifm and icut are killed in which ways. Currently, I am |
|---|
| 310 | ! putting all natural death into ifm_none, even if it happens |
|---|
| 311 | ! in another management type (for example, self-thinning will |
|---|
| 312 | ! happen with ifm_thin, but it's really a natural death). |
|---|
| 313 | IF(ifm .NE. ifm_none)CYCLE |
|---|
| 314 | IF((icut .NE. icut_thin) .AND. & |
|---|
| 315 | (icut .NE. icut_clear) .AND. & |
|---|
| 316 | (icut .NE. icut_beetle) .AND. & |
|---|
| 317 | (icut .NE. icut_storm_break) .AND. & |
|---|
| 318 | (icut .NE. icut_storm_uproot)) CYCLE |
|---|
| 319 | |
|---|
| 320 | ! Killing is done a little differently for trees and |
|---|
| 321 | ! non-trees, since circ_classes are not defined for non-trees. |
|---|
| 322 | IF(is_tree(ivm))THEN |
|---|
| 323 | |
|---|
| 324 | DO icir=1,ncirc |
|---|
| 325 | |
|---|
| 326 | IF (circ_class_kill(ipts,ivm,icir,ifm,icut).EQ.zero) CYCLE |
|---|
| 327 | ! Debug |
|---|
| 328 | IF(test_pft == ivm .AND. test_grid == ipts .AND. & |
|---|
| 329 | printlev_loc>=4) THEN |
|---|
| 330 | WRITE(numout,*) 'killing before: ',ipts,ivm,icir,ifm,icut,& |
|---|
| 331 | circ_class_kill(ipts,ivm,icir,ifm,icut),& |
|---|
| 332 | circ_class_n(ipts,ivm,icir) |
|---|
| 333 | ENDIF |
|---|
| 334 | !- |
|---|
| 335 | |
|---|
| 336 | ! move the dead biomass to the respective litter pool |
|---|
| 337 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + & |
|---|
| 338 | circ_class_biomass(ipts,ivm,icir,:,:) * & |
|---|
| 339 | circ_class_kill(ipts,ivm,icir,ifm,icut) |
|---|
| 340 | |
|---|
| 341 | ! remove the number of individuals that died |
|---|
| 342 | circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir) - & |
|---|
| 343 | circ_class_kill(ipts,ivm,icir,ifm,icut) |
|---|
| 344 | |
|---|
| 345 | ! Here, it's possible that the number of individuals left |
|---|
| 346 | ! will be a very, very small amount. If it's very low, |
|---|
| 347 | ! we will just move all that biomass to the dead pool |
|---|
| 348 | ! and set the number of individuals equal to zero, |
|---|
| 349 | ! effectively killing the circ class. |
|---|
| 350 | IF(circ_class_n(ipts,ivm,icir) .LE. min_stomate)THEN |
|---|
| 351 | |
|---|
| 352 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + & |
|---|
| 353 | circ_class_biomass(ipts,ivm,icir,:,:) * & |
|---|
| 354 | circ_class_n(ipts,ivm,icir) |
|---|
| 355 | |
|---|
| 356 | ! zero the number of individuals in this circ class |
|---|
| 357 | circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir) - & |
|---|
| 358 | circ_class_n(ipts,ivm,icir) |
|---|
| 359 | |
|---|
| 360 | ! If there are no individuals left then the biomass |
|---|
| 361 | ! in that circ should be set to zero. If not some of |
|---|
| 362 | ! the IF-loops will fail because circ_class_n = 0 and |
|---|
| 363 | ! circ_class_biomass = 0 is used as a logic test later |
|---|
| 364 | ! in the code |
|---|
| 365 | circ_class_biomass(ipts,ivm,icir,:,:) = zero |
|---|
| 366 | |
|---|
| 367 | ENDIF |
|---|
| 368 | |
|---|
| 369 | ! Debug |
|---|
| 370 | IF(test_pft == ivm .AND. test_grid == ipts .AND. & |
|---|
| 371 | printlev_loc>=4) THEN |
|---|
| 372 | WRITE(numout,*) 'killing after: ',ipts,ivm,icir,ifm,icut,& |
|---|
| 373 | circ_class_kill(ipts,ivm,icir,ifm,icut),& |
|---|
| 374 | circ_class_n(ipts,ivm,icir) |
|---|
| 375 | ENDIF |
|---|
| 376 | !- |
|---|
| 377 | |
|---|
| 378 | ENDDO ! loop over circ classes |
|---|
| 379 | |
|---|
| 380 | IF (SUM(circ_class_n(ipts,ivm,:)).LT.min_stomate) THEN |
|---|
| 381 | |
|---|
| 382 | IF (SUM(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,:),1),1),1).LT.& |
|---|
| 383 | min_stomate) THEN |
|---|
| 384 | |
|---|
| 385 | ! The PFT is dead. Set plant_status to idead to ensure |
|---|
| 386 | ! plant_status will be set to iprescribe in |
|---|
| 387 | ! mortality_clean. |
|---|
| 388 | plant_status(ipts,ivm) = idead |
|---|
| 389 | |
|---|
| 390 | ELSE |
|---|
| 391 | |
|---|
| 392 | WRITE(numout,*) 'sum of circ_class_n, ', & |
|---|
| 393 | SUM(circ_class_n(ipts,ivm,:)) |
|---|
| 394 | WRITE(numout,*) 'sum of circ_biomass_n - C, ', & |
|---|
| 395 | SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) |
|---|
| 396 | WRITE(numout,*) 'sum of circ_biomass_n - N, ', & |
|---|
| 397 | SUM(SUM(circ_class_biomass(ipts,ivm,:,:,initrogen),1),1) |
|---|
| 398 | CALL ipslerr_p(3,'inconsistency in stomate_kill',& |
|---|
| 399 | 'Both indiviudals and biomass should be zero', & |
|---|
| 400 | 'or both should be above min_stomate','') |
|---|
| 401 | END IF |
|---|
| 402 | END IF |
|---|
| 403 | |
|---|
| 404 | ! Actual biomass after mortality has been accounted for |
|---|
| 405 | actu_biomass = cc_to_biomass(npts,nvm,& |
|---|
| 406 | circ_class_biomass(ipts,ivm,:,:,:),& |
|---|
| 407 | circ_class_n(ipts,ivm,:)) |
|---|
| 408 | |
|---|
| 409 | ! Calculate the biomass change due to ncuts. Add to the values |
|---|
| 410 | ! that were already accumulated in anthropogenic_mortality in |
|---|
| 411 | ! sapiens_kill.f90 |
|---|
| 412 | biomass_cut(ipts,ivm,:,:,ifm,icut) = & |
|---|
| 413 | biomass_cut(ipts,ivm,:,:,ifm,icut) + & |
|---|
| 414 | init_biomass(ipts,ivm,:,:) - actu_biomass(:,:) |
|---|
| 415 | |
|---|
| 416 | ! Update the initial biomass to avoid double counting |
|---|
| 417 | init_biomass(ipts,ivm,:,:) = actu_biomass(:,:) |
|---|
| 418 | |
|---|
| 419 | |
|---|
| 420 | ELSE ! Grasses |
|---|
| 421 | |
|---|
| 422 | IF(natural(ivm)) THEN |
|---|
| 423 | |
|---|
| 424 | IF(circ_class_n(ipts,ivm,1) .GT. min_stomate) THEN |
|---|
| 425 | !! WARNING !! |
|---|
| 426 | ! This is not very clean. We don't use circ classes for grasses |
|---|
| 427 | ! and crops. All mortality is done based on biomass. However, |
|---|
| 428 | ! it's cleaner here to just pass circ_class_kill from |
|---|
| 429 | ! stomate_mark_kill, |
|---|
| 430 | ! and it is in line with what is done for the forests. So we take |
|---|
| 431 | ! the total grass/crop biomass that is scheduled for killing in |
|---|
| 432 | ! stomate_mark_kill and define circ_class_kill(:,:,inatural,1) and |
|---|
| 433 | ! circ_class_biomass(:,:,1,:,:) so that the product of these two |
|---|
| 434 | ! matches the amount of biomass scheduled for killing. |
|---|
| 435 | |
|---|
| 436 | ! move the dead biomass to the respective litter pool |
|---|
| 437 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) +& |
|---|
| 438 | circ_class_biomass(ipts,ivm,1,:,:)*& |
|---|
| 439 | circ_class_kill(ipts,ivm,1,ifm,icut) |
|---|
| 440 | |
|---|
| 441 | ! circ_class_biomass has to change such that the biomass |
|---|
| 442 | ! and circ_class_biomass*circ_class_n are in sync. So we |
|---|
| 443 | ! will just sync it here. This has to be done this way |
|---|
| 444 | ! since circ_class_n never changes for grass/crops. |
|---|
| 445 | ! Below we combine the calculation of the new biomass |
|---|
| 446 | ! biomass = circ_class_biomass * circ_class_n |
|---|
| 447 | ! biomass_killed = circ_class_biomass * circ_class_kill |
|---|
| 448 | ! Given that we keep circ_class_n constant for grass and crops |
|---|
| 449 | ! we recalculate circ_class_biomass as |
|---|
| 450 | ! (biomass-biomass_killed)/circ_class_n |
|---|
| 451 | circ_class_biomass(ipts,ivm,1,:,:) = & |
|---|
| 452 | circ_class_biomass(ipts,ivm,1,:,:) * & |
|---|
| 453 | (circ_class_n(ipts,ivm,1) - & |
|---|
| 454 | circ_class_kill(ipts,ivm,1,ifm,icut)) / & |
|---|
| 455 | circ_class_n(ipts,ivm,1) |
|---|
| 456 | |
|---|
| 457 | IF(SUM(circ_class_biomass(ipts,ivm,1,:,icarbon)) .LE. min_stomate) THEN |
|---|
| 458 | ! The plant is dead. Set plant_status to idead to ensure |
|---|
| 459 | ! plant_status will be set to iprescribe in |
|---|
| 460 | ! mortality_clean. |
|---|
| 461 | plant_status(ipts,ivm) = idead |
|---|
| 462 | |
|---|
| 463 | bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + & |
|---|
| 464 | circ_class_biomass(ipts,ivm,1,:,:)*& |
|---|
| 465 | circ_class_n(ipts,ivm,1) |
|---|
| 466 | |
|---|
| 467 | ! zero the number of individuals in this circ class |
|---|
| 468 | circ_class_n(ipts,ivm,1) = zero |
|---|
| 469 | |
|---|
| 470 | ! If there are no individuals left then the biomass |
|---|
| 471 | ! in that circ should be set to zero. If not some of |
|---|
| 472 | ! the IF-loops will fail because circ_class_n = 0 and |
|---|
| 473 | ! circ_class_biomass = 0 is used as a logic test |
|---|
| 474 | ! laterin the code |
|---|
| 475 | circ_class_biomass(ipts,ivm,1,:,:) = zero |
|---|
| 476 | |
|---|
| 477 | ENDIF |
|---|
| 478 | |
|---|
| 479 | ENDIF |
|---|
| 480 | |
|---|
| 481 | ENDIF ! is.natural |
|---|
| 482 | |
|---|
| 483 | ENDIF ! checking for a tree |
|---|
| 484 | |
|---|
| 485 | ! This PFT should never be killed again. |
|---|
| 486 | ! To make sure of that, reset all the |
|---|
| 487 | ! variables to zero. |
|---|
| 488 | circ_class_kill(ipts,ivm,:,ifm,icut) = zero |
|---|
| 489 | |
|---|
| 490 | ENDDO ! reason of mortality |
|---|
| 491 | |
|---|
| 492 | ENDDO ! management types |
|---|
| 493 | |
|---|
| 494 | ENDDO ! loop over pfts |
|---|
| 495 | |
|---|
| 496 | END DO ! loop over land points |
|---|
| 497 | |
|---|
| 498 | !! 4. Check numerical consistency of this routine |
|---|
| 499 | |
|---|
| 500 | IF (err_act.GT.1) THEN |
|---|
| 501 | |
|---|
| 502 | |
|---|
| 503 | ! 4.2 Check surface area |
|---|
| 504 | CALL check_vegetation_area("stomate_natural_mortality", npts, & |
|---|
| 505 | veget_max_begin, veget_max,'pft') |
|---|
| 506 | |
|---|
| 507 | ! 4.3 Mass balance closure |
|---|
| 508 | pool_end = zero |
|---|
| 509 | DO ipar = 1,nparts |
|---|
| 510 | DO iele = 1,nelements |
|---|
| 511 | DO icir = 1,ncirc |
|---|
| 512 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 513 | (circ_class_biomass(:,:,icir,ipar,iele) * & |
|---|
| 514 | circ_class_n(:,:,icir) * veget_max(:,:)) |
|---|
| 515 | ENDDO |
|---|
| 516 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 517 | bm_to_litter(:,:,ipar,iele) * veget_max(:,:) |
|---|
| 518 | ENDDO |
|---|
| 519 | ENDDO |
|---|
| 520 | |
|---|
| 521 | ! 4.3.2 Calculate mass balance |
|---|
| 522 | ! Common processes |
|---|
| 523 | DO iele=1,nelements |
|---|
| 524 | check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - & |
|---|
| 525 | pool_start(:,:,iele)) |
|---|
| 526 | ENDDO |
|---|
| 527 | |
|---|
| 528 | closure_intern(:,:,:) = zero |
|---|
| 529 | DO imbc = 1,nmbcomp |
|---|
| 530 | DO iele=1,nelements |
|---|
| 531 | ! Debug |
|---|
| 532 | IF (printlev_loc>=4) WRITE(numout,*) & |
|---|
| 533 | 'check_intern, ivm, imbc, iele, ', imbc, & |
|---|
| 534 | iele, check_intern(:,test_pft,imbc,iele) |
|---|
| 535 | !- |
|---|
| 536 | closure_intern(:,:,iele) = closure_intern(:,:,iele) + & |
|---|
| 537 | check_intern(:,:,imbc,iele) |
|---|
| 538 | ENDDO |
|---|
| 539 | ENDDO |
|---|
| 540 | |
|---|
| 541 | ! 4.3.3 Check mass balance closure |
|---|
| 542 | CALL check_mass_balance("stomate_natural_mortality", closure_intern, & |
|---|
| 543 | npts, pool_end, pool_start, veget_max, 'pft') |
|---|
| 544 | |
|---|
| 545 | ENDIF ! err_act.GT.1 |
|---|
| 546 | |
|---|
| 547 | IF (printlev.GE.4) WRITE(numout,*) 'Leaving natural_mortality' |
|---|
| 548 | |
|---|
| 549 | END SUBROUTINE natural_mortality |
|---|
| 550 | |
|---|
| 551 | |
|---|
| 552 | !! ================================================================================================================================ |
|---|
| 553 | !! SUBROUTINE : mortality_clean |
|---|
| 554 | !! |
|---|
| 555 | !>\BRIEF After biomass has been killed, there are some clean-up operations |
|---|
| 556 | !! to do. |
|---|
| 557 | !! |
|---|
| 558 | !! DESCRIPTION : If all the biomass has been killed for a PFT, we want to reset |
|---|
| 559 | !! some counters. There is also the chance that we have |
|---|
| 560 | !! killed all the biomass in a circ class of trees. If this is |
|---|
| 561 | !! the case, we want to redistribute the biomass in the remaining |
|---|
| 562 | !! classes so that all circ classes have some biomass in them. |
|---|
| 563 | !! A circ class with no biomass causes allocation to crash. |
|---|
| 564 | !! |
|---|
| 565 | !! RECENT CHANGE(S): |
|---|
| 566 | !! |
|---|
| 567 | !! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass |
|---|
| 568 | !! |
|---|
| 569 | !! REFERENCE(S) : |
|---|
| 570 | !! |
|---|
| 571 | !! FLOWCHART : None |
|---|
| 572 | !!\n |
|---|
| 573 | !_ ================================================================================================================================ |
|---|
| 574 | |
|---|
| 575 | SUBROUTINE mortality_clean (npts, circ_class_biomass, & |
|---|
| 576 | circ_class_n, age, everywhere, leaf_age, & |
|---|
| 577 | leaf_frac, plant_status, when_growthinit, circ_class_dist, & |
|---|
| 578 | age_stand, PFTpresent, last_cut, mai_count, & |
|---|
| 579 | veget_max, npp_longterm, KF, atm_to_bm, & |
|---|
| 580 | wstress_season, lm_lastyearmax, lignin_struc, lignin_wood, & |
|---|
| 581 | som, litter, dt_days, & |
|---|
| 582 | forest_managed, bm_to_litter, lab_fac, & |
|---|
| 583 | gpp_daily, resp_maint, & |
|---|
| 584 | resp_growth, use_reserve, mai, pai, & |
|---|
| 585 | rue_longterm, previous_wood_volume, species_change_map,& |
|---|
| 586 | longevity_eff_leaf, longevity_eff_sap, longevity_eff_root, vegstress_season,& |
|---|
| 587 | k_latosa_adapt, lpft_replant, cn_leaf_min_season, & |
|---|
| 588 | nstress_season, soil_n_min, n_uptake_daily, p_O2, bact,& |
|---|
| 589 | CN_som_litter_longterm,matrixA,matrixV,vectorB,vectorU, & |
|---|
| 590 | cn_leaf_init_2D, bm_sapl_2D, sugar_load, deepSOM_a, deepSOM_s, & |
|---|
| 591 | deepSOM_p, resp_hetero, n_input_daily, n_fungivores, & |
|---|
| 592 | leaching_daily, emission_daily, qmd_init, dia_init) |
|---|
| 593 | |
|---|
| 594 | !! 0. Variable and parameter declaration |
|---|
| 595 | |
|---|
| 596 | !! 0.1 Input variables |
|---|
| 597 | INTEGER(i_std), INTENT(in) :: npts !! Domain size (-) |
|---|
| 598 | REAL(r_std), DIMENSION(ncirc), INTENT(in) :: circ_class_dist !! The probability distribution of trees |
|---|
| 599 | !! in a circ class in case of a |
|---|
| 600 | !! redistribution (unitless). |
|---|
| 601 | REAL(r_std), DIMENSION(:,:), INTENT(in) :: longevity_eff_root !! Effective root turnover time that accounts |
|---|
| 602 | !! waterstress (days) |
|---|
| 603 | REAL(r_std), DIMENSION(:,:), INTENT(in) :: longevity_eff_sap !! Effective sapwood turnover time that accounts |
|---|
| 604 | !! waterstress (days) |
|---|
| 605 | REAL(r_std), DIMENSION(:,:), INTENT(in) :: longevity_eff_leaf !! Effective leaf turnover time that accounts |
|---|
| 606 | !! waterstress (days) |
|---|
| 607 | REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate (days) |
|---|
| 608 | INTEGER(i_std), DIMENSION (:,:), INTENT(in) :: forest_managed !! forest management flag |
|---|
| 609 | LOGICAL, DIMENSION(:,:), INTENT(in) :: lpft_replant !! Set to true if a PFT has been clearcut |
|---|
| 610 | !! and needs to be replaced by another species |
|---|
| 611 | INTEGER(i_std), DIMENSION (:,:), INTENT(in) :: species_change_map !! A map which gives the PFT number that each |
|---|
| 612 | REAL(r_std),DIMENSION(:,:), INTENT(in) :: cn_leaf_init_2D !! initial leaf C/N ratio |
|---|
| 613 | REAL(r_std), DIMENSION(nvm), INTENT(in) :: qmd_init !! quadratic mean diameter of a newly planted PFT (m) |
|---|
| 614 | REAL(r_std), DIMENSION(:,:), INTENT(in) :: dia_init !! Initial diameter distribution of a newly planted PFT (m) |
|---|
| 615 | |
|---|
| 616 | !! 0.2 Output variables |
|---|
| 617 | |
|---|
| 618 | !! 0.3 Modified variables |
|---|
| 619 | REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass !! Biomass of the components of the model |
|---|
| 620 | !! tree within a circumference |
|---|
| 621 | !! class @tex $(gC ind^{-1})$ @endtex |
|---|
| 622 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: plant_status !! Growth and phenological status of the plant |
|---|
| 623 | !! see constants voor values |
|---|
| 624 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: age !! Mean age (years) |
|---|
| 625 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: when_growthinit !! How many days ago was the beginning of the |
|---|
| 626 | !! growing season (days) |
|---|
| 627 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: everywhere !! Is the PFT everywhere in the grid box or very |
|---|
| 628 | !! localized (after its introduction) |
|---|
| 629 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: leaf_age !! Leaf age (days) |
|---|
| 630 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: leaf_frac !! Fraction of leaves in leaf age class |
|---|
| 631 | !! (unitless;0-1) |
|---|
| 632 | INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: age_stand !! Age of the forest stand (years) |
|---|
| 633 | INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: last_cut !! Years since last thinning (years) |
|---|
| 634 | INTEGER(i_std), DIMENSION(:,:), INTENT(inout) :: mai_count !! The number of times we've |
|---|
| 635 | !! calculated the volume increment |
|---|
| 636 | !! for a stand |
|---|
| 637 | LOGICAL, DIMENSION(:,:), INTENT(inout) :: PFTpresent !! PFT present (0 or 1) |
|---|
| 638 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: KF !! Scaling factor to convert sapwood mass into leaf |
|---|
| 639 | !! mass (m) |
|---|
| 640 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: k_latosa_adapt !! Leaf to sapwood area adapted for long |
|---|
| 641 | !! term water stress (m) |
|---|
| 642 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: veget_max !! "maximal" coverage fraction of a PFT on the ground |
|---|
| 643 | !! (unitless, 0-1) |
|---|
| 644 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: atm_to_bm !! C and N taken from the atmosphere to get C to create |
|---|
| 645 | !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex |
|---|
| 646 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: wstress_season !! Water stress factor, based on hum_rel_daily |
|---|
| 647 | !! (unitless, 0-1) |
|---|
| 648 | |
|---|
| 649 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: npp_longterm !! "long term" net primary productivity |
|---|
| 650 | !! @tex ($gC m^{-2} year^{-1}$) @endtex |
|---|
| 651 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT |
|---|
| 652 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 653 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: lignin_struc !! ratio Lignine/Carbon in structural litter, |
|---|
| 654 | !! above and below ground |
|---|
| 655 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: lignin_wood !! ratio Lignine/Carbon in woody litter, |
|---|
| 656 | !! above and below ground |
|---|
| 657 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: som !! carbon pool: active, slow, or passive |
|---|
| 658 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 659 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: deepSOM_a !! Soil carbon discretized with depth active (g/m**3) |
|---|
| 660 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: deepSOM_s !! Soil carbon discretized with depth slow (g/m**3) |
|---|
| 661 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: deepSOM_p !! Soil carbon discretized with depth passive (g/m**3) |
|---|
| 662 | REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: litter !! metabolic and structural litter, above and |
|---|
| 663 | !! below ground @tex ($gC m^{-2}$) @endtex |
|---|
| 664 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: circ_class_n !! Number of individuals in each circ class |
|---|
| 665 | !! @tex $(ind m^{-2})$ @endtex |
|---|
| 666 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: bm_to_litter !! Transfer of biomass to litter |
|---|
| 667 | !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 668 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: lab_fac !! Activity of labile pool factor (??units??) |
|---|
| 669 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: gpp_daily !! Daily gross primary productivity |
|---|
| 670 | !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 671 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: resp_maint !! Maintenance respiration |
|---|
| 672 | !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 673 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: resp_growth !! Growth respiration |
|---|
| 674 | !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 675 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: use_reserve !! Mass taken from carbohydrate reserve |
|---|
| 676 | !! @tex $(gC m^{-2})$ @endtex |
|---|
| 677 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: mai !! The mean annual increment |
|---|
| 678 | !! @tex $(m**3 / m**2 / year)$ @endtex |
|---|
| 679 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: pai !! The period annual increment |
|---|
| 680 | !! @tex $(m**3 / m**2 / year)$ @endtex |
|---|
| 681 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: rue_longterm !! Longterm radiation use efficiency |
|---|
| 682 | !! (??units??) |
|---|
| 683 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: previous_wood_volume !! The volume of the tree trunks |
|---|
| 684 | !! in a stand for the previous year. |
|---|
| 685 | !! @tex $(m**3 / m**2 )$ @endtex |
|---|
| 686 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: vegstress_season !! Mean growingseason moisture |
|---|
| 687 | !! availability (0 to 1, unitless) |
|---|
| 688 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: cn_leaf_min_season !! Seasonal min CN ratio of leaves |
|---|
| 689 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: nstress_season !! N-related seasonal stress (used for allocation) |
|---|
| 690 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: soil_n_min !! mineral nitrogen in the soil (gN/m**2) |
|---|
| 691 | !! (first index=npts, second index=nvm, third index=nnspec) |
|---|
| 692 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: n_uptake_daily !! Daily N uptake by plants |
|---|
| 693 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: p_O2 !! partial pressure of oxigen in the soil (hPa) |
|---|
| 694 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: bact !! denitrifier biomass (gC/m**2) |
|---|
| 695 | REAL(r_std), DIMENSION(:,:,:),INTENT(inout) :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN) |
|---|
| 696 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: matrixA !! Matrix containing the fluxes between the carbon |
|---|
| 697 | !! pools per sechiba time step @tex $(gC.m^2.day^{-1})$ |
|---|
| 698 | !! @endtex |
|---|
| 699 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: vectorB !! Vector containing the litter increase per sechiba |
|---|
| 700 | !! time step @tex $(gCm^{-2})$ @endtex |
|---|
| 701 | REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: matrixV !! Matrix containing the accumulated values of matrixA |
|---|
| 702 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: vectorU !! Matrix containing the accumulated values of VectorB |
|---|
| 703 | REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: bm_sapl_2D !! Sapling biomass for the functional allocation |
|---|
| 704 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: sugar_load !! Relative sugar loading of the labile pool (unitless) |
|---|
| 705 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: resp_hetero !! Heterotrophic respiration |
|---|
| 706 | !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 707 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: leaching_daily !! mineral nitrogen leached from the soil |
|---|
| 708 | !! (gN/m**2/day) |
|---|
| 709 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: emission_daily !! volatile losses of nitrogen |
|---|
| 710 | !! (gN/m**2/day) |
|---|
| 711 | REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: n_input_daily !! nitrogen inputs into the soil (gN/m**2/day) |
|---|
| 712 | !! NH4 and NOX from the atmosphere, NH4 from BNF, |
|---|
| 713 | !! agricultural fertiliser as NH4/NO3 |
|---|
| 714 | REAL(r_std), DIMENSION(:,:), INTENT(inout) :: n_fungivores !! Fraction of N released for plant uptake due to |
|---|
| 715 | !! fungivore consumption. |
|---|
| 716 | |
|---|
| 717 | |
|---|
| 718 | !! 0.4 Local variables |
|---|
| 719 | REAL(r_std) :: share_young !! Share of the veget_max of the youngest age class |
|---|
| 720 | !! (unitless, 0-1) |
|---|
| 721 | INTEGER(i_std) :: ipts,ivm,ilage !! Indices |
|---|
| 722 | INTEGER(i_std) :: icir,jcir,ilev !! Indices |
|---|
| 723 | INTEGER(i_std) :: ipar,iele,imbc !! Indices |
|---|
| 724 | INTEGER(i_std) :: ilit,icarb,igrn !! Indices |
|---|
| 725 | INTEGER(i_std) :: inc, ispec !! Indices |
|---|
| 726 | LOGICAL :: lredistribute !! Flag if we need to redistribute individuals |
|---|
| 727 | !! among the circ classes |
|---|
| 728 | INTEGER,DIMENSION(nvm) :: nkilled !! the number of grid points at which a given |
|---|
| 729 | !! given PFT's biomass has been reduced to |
|---|
| 730 | !! zero |
|---|
| 731 | REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)& |
|---|
| 732 | :: check_intern !! Contains the components of the internal |
|---|
| 733 | !! mass balance chech for this routine |
|---|
| 734 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 735 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: closure_intern !! Check closure of internal mass balance |
|---|
| 736 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 737 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: pool_start !! Start pool of this routine |
|---|
| 738 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 739 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: pool_end !! End pool of this routine |
|---|
| 740 | !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex |
|---|
| 741 | REAL(r_std), DIMENSION(ncirc) :: old_trees_left |
|---|
| 742 | REAL(r_std), DIMENSION(ncirc) :: circ_class_n_new |
|---|
| 743 | REAL(r_std), DIMENSION(ncirc,nparts,nelements) :: circ_class_biomass_new |
|---|
| 744 | REAL(r_std) :: trees_needed |
|---|
| 745 | LOGICAL :: lyoungest |
|---|
| 746 | REAL(r_std), DIMENSION(npts,nvm,nleafages) :: new_leaf_frac !! Temporary variable for leaf_frac (unitless;0-1) |
|---|
| 747 | REAL(r_std), DIMENSION(ncirc) :: est_circ_class_n !! Temporary variable for circ_class_n of the |
|---|
| 748 | !! established vegetation @tex $(ind m^{-2})$ @endtex |
|---|
| 749 | REAL(r_std), DIMENSION(ncirc) :: tmp_circ_class_n !! Temporary variable for circ_class_n of the |
|---|
| 750 | !! established vegetation @tex $(ind m^{-2})$ @endtex |
|---|
| 751 | REAL(r_std), DIMENSION(npts,nvm,ncirc) :: new_circ_class_n !! Temporary variable for circ_class_n of the |
|---|
| 752 | !! new vegetation |
|---|
| 753 | !! @tex $(ind m^{-2})$ @endtex |
|---|
| 754 | REAL(r_std), DIMENSION(ncirc,nparts,nelements) :: est_circ_class_biomass !! Temporary variable for circ_class_biomass of the |
|---|
| 755 | !! established vegetation @tex $(g C ind^{-1})$ @endtex |
|---|
| 756 | REAL(r_std), DIMENSION(ncirc,nparts,nelements) :: tmp_circ_class_biomass !! Temporary variable for circ_class_biomass of the |
|---|
| 757 | !! established vegetation @tex $(g C ind^{-1})$ @endtex |
|---|
| 758 | REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements) & |
|---|
| 759 | :: new_circ_class_biomass !! Temporary variable for circ_class_biomass of the |
|---|
| 760 | !! new vegetation @tex $(g C ind^{-1})$ @endtex |
|---|
| 761 | REAL(r_std), DIMENSION(ncirc) :: est_circ_class_dia !! Variable to store temporary values for |
|---|
| 762 | !! circ_class (m) |
|---|
| 763 | REAL(r_std), DIMENSION(ncirc) :: tmp_circ_class_dia !! Variable to store temporary values for |
|---|
| 764 | !! circ_class (m) |
|---|
| 765 | REAL(r_std), DIMENSION(npts,nvm,ncirc) :: new_circ !! Temporary variable for circ (m) |
|---|
| 766 | REAL(r_std), DIMENSION(npts,nvm,nelements) :: new_atm_to_bm !! Temporary variable for atm_to_bm |
|---|
| 767 | !! @tex (gC.m^{-2}dt^{-1})$ @endtex |
|---|
| 768 | REAL(r_std), DIMENSION(npts,nvm) :: new_age !! Temporary variable for age (years) |
|---|
| 769 | REAL(r_std), DIMENSION(npts,nvm) :: new_lm_lastyearmax !! Temporary variable for lm_last_year |
|---|
| 770 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 771 | REAL(r_std), DIMENSION(npts,nvm) :: new_everywhere !! Temporary variable for everywhere (unitless, 0-1) |
|---|
| 772 | REAL(r_std), DIMENSION(npts,nvm) :: dum_when_growthinit !! Dummy for when_growthinit (days) |
|---|
| 773 | REAL(r_std), DIMENSION(npts,nvm) :: dum_npp_longterm !! Dummy for npp_longterm |
|---|
| 774 | !! @tex ($gC m^{-2} year^{-1}$) @endtex |
|---|
| 775 | INTEGER(i_std) :: ivma |
|---|
| 776 | LOGICAL, DIMENSION(npts,nvm) :: dum_PFTpresent !! Dummy for PFTpresent (0 or 1) |
|---|
| 777 | REAL(r_std), DIMENSION(npts,nvm) :: dum_plant_status !! Dummy for plant_status (true/false) |
|---|
| 778 | REAL(r_std) :: moi_bank !! bank to store vegstress_season of the cleared |
|---|
| 779 | !! PFT's (unitless; 0-1) |
|---|
| 780 | REAL(r_std), DIMENSION(npts,nvm) :: loss_gain !! The same as delta_veget but distributed of all |
|---|
| 781 | !! age classes and thus taking the age-classes into |
|---|
| 782 | !! account (unitless, 0-1) |
|---|
| 783 | REAL(r_std) :: total_losses !! Sum of losses only in delta_veget (unitless, 0-1) |
|---|
| 784 | REAL(r_std), DIMENSION(nlitt,nlevs,nelements) :: litter_bank !! Bank to store the litter that becomes available when |
|---|
| 785 | !! part of a PFT is removed @tex ($gC m^{-2}$) @endtex |
|---|
| 786 | REAL(r_std), DIMENSION(ncarb) :: soil_bank !! Bank to store soil carbon that becomes available when |
|---|
| 787 | !! part of a PFT is removed @tex ($gC m^{-2}$) @endtex |
|---|
| 788 | REAL(r_std), DIMENSION(nlevs) :: struct_ltr_bank !! Bank to store the lignin in structural litter that |
|---|
| 789 | !! becomes available when part of a PFT is removed |
|---|
| 790 | !! (0-1,unitless) |
|---|
| 791 | REAL(r_std),DIMENSION(nlevs) :: woody_ltr_bank !! Bank to store the lignin in woody litter that |
|---|
| 792 | !! becomes available when part of a PFT is removed |
|---|
| 793 | !! (0-1,unitless) |
|---|
| 794 | REAL(r_std),DIMENSION(nvm,nparts,nelements) :: fresh_litter !! Pool of fresh litter that is being released during |
|---|
| 795 | !! LCC @tex ($gC m^{-2}$) @endtex |
|---|
| 796 | REAL(r_std),DIMENSION(nparts,nelements) :: fresh_ltr_bank !! Bank to store all the fresh litter from site |
|---|
| 797 | !! clearing during LCC. Weighted value of fresh_litter |
|---|
| 798 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 799 | INTEGER(i_std) :: iyoung !! index of the youngest age class of that species |
|---|
| 800 | REAL(r_std), DIMENSION(npts,nvm,norphans,nelements) & |
|---|
| 801 | :: orphan_flux_local !! Storage for fluxes of PFTs that no longer exist. |
|---|
| 802 | !! This is only for co2bm at the moment, since that |
|---|
| 803 | !! is the only one used in this routine. Following the |
|---|
| 804 | !! total destruction of a PFT by death |
|---|
| 805 | !! (veget_max_new = 0), a flux from before death needs |
|---|
| 806 | !! storage @tex $(gC m^{-2} dtslow^{-1})$ @endtex |
|---|
| 807 | REAL(r_std), DIMENSION(nlitt,nlevs) :: litter_weight_young !! The fraction of litter on the young |
|---|
| 808 | !! PFT. |
|---|
| 809 | !! @tex $-$ @endtex |
|---|
| 810 | REAL(r_std), DIMENSION(npts,nvm) :: veget_max_begin !! Temporairy variable to check area conservation |
|---|
| 811 | REAL(r_std), DIMENSION(npts,nvm,nlevels_tot) :: dummy1 !! Dummy variable for prescribe |
|---|
| 812 | REAL(r_std), DIMENSION(npts,nvm) :: new_ind !! Number of recruits grown (trees m-2 day-2). Not used in sapiens_lcchange. |
|---|
| 813 | !! Added to avoid using OPTINAL arguments. |
|---|
| 814 | |
|---|
| 815 | !_ ================================================================================================================================ |
|---|
| 816 | |
|---|
| 817 | IF (printlev.GE.2) WRITE(numout,*) 'Entering mortality_clean.' |
|---|
| 818 | |
|---|
| 819 | !! 1. Initialize check for mass balance closure |
|---|
| 820 | |
|---|
| 821 | !! 1.2 Initialize check for mass balance closure |
|---|
| 822 | IF (err_act.GT.1) THEN |
|---|
| 823 | |
|---|
| 824 | check_intern(:,:,:,:) = zero |
|---|
| 825 | pool_start(:,:,:) = zero |
|---|
| 826 | DO iele = 1,nelements |
|---|
| 827 | DO ipar = 1,nparts |
|---|
| 828 | DO icir = 1,ncirc |
|---|
| 829 | ! Initial biomass |
|---|
| 830 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 831 | (circ_class_biomass(:,:,icir,ipar,iele) * & |
|---|
| 832 | circ_class_n(:,:,icir) * veget_max(:,:)) |
|---|
| 833 | ENDDO |
|---|
| 834 | ! bm_to_litter |
|---|
| 835 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 836 | bm_to_litter(:,:,ipar,iele) * veget_max(:,:) |
|---|
| 837 | ENDDO |
|---|
| 838 | |
|---|
| 839 | ! The litter and soil carbon pools can be moved around |
|---|
| 840 | ! if age classes are changed. |
|---|
| 841 | |
|---|
| 842 | ! Litter pool (gC m-2) * (m2 m-2) |
|---|
| 843 | DO ilit = 1,nlitt |
|---|
| 844 | DO ilev = 1,nlevs |
|---|
| 845 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 846 | litter(:,ilit,:,ilev,iele) * veget_max(:,:) |
|---|
| 847 | ENDDO |
|---|
| 848 | ENDDO |
|---|
| 849 | |
|---|
| 850 | IF (ok_soil_carbon_discretization) THEN |
|---|
| 851 | ! Soil carbon (gC m-3) * (m2 m-2) |
|---|
| 852 | DO igrn = 1,ngrnd |
|---|
| 853 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 854 | (deepSOM_a(:,igrn,:,iele) + deepSOM_s(:,igrn,:,iele) + & |
|---|
| 855 | deepSOM_p(:,igrn,:,iele)) * veget_max(:,:) |
|---|
| 856 | END DO |
|---|
| 857 | ELSE |
|---|
| 858 | ! Soil carbon (gC m-2) * (m2 m-2) |
|---|
| 859 | DO icarb = 1,ncarb |
|---|
| 860 | pool_start(:,:,iele) = pool_start(:,:,iele) + & |
|---|
| 861 | som(:,icarb,:,iele) * veget_max(:,:) |
|---|
| 862 | ENDDO |
|---|
| 863 | ENDIF |
|---|
| 864 | |
|---|
| 865 | check_intern(:,:,iatm2land,iele) = -un * & |
|---|
| 866 | atm_to_bm(:,:,iele) * veget_max(:,:) |
|---|
| 867 | |
|---|
| 868 | ENDDO |
|---|
| 869 | |
|---|
| 870 | ! Denitrifying bacteria (only C) |
|---|
| 871 | pool_start(:,:,icarbon) = pool_start(:,:,icarbon) + & |
|---|
| 872 | bact(:,:) * veget_max(:,:) |
|---|
| 873 | |
|---|
| 874 | ! Nitrogen only |
|---|
| 875 | DO ispec = 1,nnspec |
|---|
| 876 | pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + & |
|---|
| 877 | soil_n_min(:,:,ispec) * veget_max(:,:) |
|---|
| 878 | ENDDO |
|---|
| 879 | |
|---|
| 880 | ! Specific fluxes |
|---|
| 881 | ! The fluxes should not be accounted for here because this |
|---|
| 882 | ! code deals with mortality. Following mortality the veget_max |
|---|
| 883 | ! has to be moved to the youngest age class but the fluxes should |
|---|
| 884 | ! stay in the age class for which they were generated. Clearly, |
|---|
| 885 | ! closing the mass balance with the fluxes, requires moving |
|---|
| 886 | ! the fluxes. If done so, the NBP consistency check will fail |
|---|
| 887 | ! because those fluxes are double counted: once after iage |
|---|
| 888 | ! in the old age class and once after imor in the youngest |
|---|
| 889 | ! age class. NThe mass balance is still checked for the pools |
|---|
| 890 | |
|---|
| 891 | !! 1.3 Initialize check for area conservation |
|---|
| 892 | veget_max_begin(:,:) = veget_max(:,:) |
|---|
| 893 | |
|---|
| 894 | ENDIF ! err_act.GT.1 |
|---|
| 895 | |
|---|
| 896 | |
|---|
| 897 | !! 2. Redistribute biomass |
|---|
| 898 | |
|---|
| 899 | DO ipts = 1,npts ! loop over land_points |
|---|
| 900 | |
|---|
| 901 | DO ivm = 2,nvm ! loop over #PFT |
|---|
| 902 | |
|---|
| 903 | IF(veget_max(ipts,ivm) == zero)THEN |
|---|
| 904 | ! this vegetation type is not present, so no reason to do the |
|---|
| 905 | ! calculation. |
|---|
| 906 | CYCLE |
|---|
| 907 | ENDIF |
|---|
| 908 | |
|---|
| 909 | ! First we check to see if one of the circ classes is empty. |
|---|
| 910 | ! We only need to do this if there is some biomass, since we |
|---|
| 911 | ! don't care if all of the circ classes are empty. |
|---|
| 912 | IF(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .GT. min_stomate)THEN |
|---|
| 913 | |
|---|
| 914 | IF(is_tree(ivm))THEN |
|---|
| 915 | |
|---|
| 916 | ! By setting this to .TRUE. redistribution |
|---|
| 917 | ! will be taken care of every day. Initially this flag was |
|---|
| 918 | ! only true at the end of the year but that resulted in |
|---|
| 919 | ! spikes and pulses. |
|---|
| 920 | lredistribute=.TRUE. |
|---|
| 921 | |
|---|
| 922 | IF(lredistribute) THEN |
|---|
| 923 | |
|---|
| 924 | ! Debug |
|---|
| 925 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 926 | WRITE(numout,*) 'Start of redistributing biomass in mortality_clean' |
|---|
| 927 | WRITE(numout,*) 'ipts,ivm',ipts,ivm |
|---|
| 928 | WRITE(numout,*) 'circ_class_n, ',circ_class_n(ipts,ivm,:) |
|---|
| 929 | WRITE(numout,*) 'circ_class_biomass, ', & |
|---|
| 930 | SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2) |
|---|
| 931 | ENDIF |
|---|
| 932 | !- |
|---|
| 933 | |
|---|
| 934 | ! What we want to do is recreate the circumference class distribution, |
|---|
| 935 | ! since if we have hit this point we have at least one class that |
|---|
| 936 | ! is empty and this will cause the allocation to crash. |
|---|
| 937 | |
|---|
| 938 | ! The first step is to decide of the distribution of individuals |
|---|
| 939 | ! that we want in each class, for example, a uniform or exponential |
|---|
| 940 | ! distribution. This was made with an input parameter. Note |
|---|
| 941 | ! that this is a decisison with very high consequences. The diamter |
|---|
| 942 | ! range may vary but the distribution is always the same. |
|---|
| 943 | |
|---|
| 944 | ! Now we need to populate the new distribution of trees among |
|---|
| 945 | ! the circumference classes, and move the heartwood and sap masses |
|---|
| 946 | ! to the new distributions. We also need to move the other pools. |
|---|
| 947 | ! This is tricky because the allometric relations for the new |
|---|
| 948 | ! tree sizes will NOT give the same amount of biomass for |
|---|
| 949 | ! the non-woody pools. Let us first try it just distributing |
|---|
| 950 | ! everything equally, and then if that doesn't work we can |
|---|
| 951 | ! redistribute the non-woody pools more cleverly, even if that |
|---|
| 952 | ! means we change the total amount of biomass we have in this |
|---|
| 953 | ! stand. I want to try it this way because we conserve biomass |
|---|
| 954 | ! this way, and I hope that the stress on the trees will be |
|---|
| 955 | ! small enough that it doesn't cause problems. This |
|---|
| 956 | ! redistribution should only happen rarely, so the trees |
|---|
| 957 | ! should have a chance to equilibrate. |
|---|
| 958 | old_trees_left(:)=circ_class_n(ipts,ivm,:) |
|---|
| 959 | |
|---|
| 960 | ! now we populate the new classes |
|---|
| 961 | circ_class_n_new(:)=circ_class_dist(:)*SUM(circ_class_n(ipts,ivm,:)) |
|---|
| 962 | circ_class_biomass_new(:,:,:)=zero |
|---|
| 963 | |
|---|
| 964 | ! The subsequent calculation nicely closes the carbon |
|---|
| 965 | ! balance but within the precision 10-16. If there are |
|---|
| 966 | ! enough trees (first case in the IF-loop), we introduce |
|---|
| 967 | ! a precision error in the number of trees. This implies |
|---|
| 968 | ! that when the number of trees is very small, the |
|---|
| 969 | ! precision issue can become a numerical issue. This is |
|---|
| 970 | ! especially true for the largest circumference classes |
|---|
| 971 | ! because they contain the fewest individuals. |
|---|
| 972 | ! We observed the largest circumference classes |
|---|
| 973 | ! containing 10-4 to 10-5 gC less than the previous |
|---|
| 974 | ! class. The rest of the code shouldn't care too much |
|---|
| 975 | ! whether the circumferences classes are in order or not |
|---|
| 976 | ! but to reduce the chances this problem occurs |
|---|
| 977 | ! we inverted the DO-loops. That way the precision error |
|---|
| 978 | ! is carried to the smaller diameter classes |
|---|
| 979 | ! which have more individuals and so the precision error |
|---|
| 980 | ! stays a precision issue. Note that this routine is |
|---|
| 981 | ! called every day so the problem is likely to be |
|---|
| 982 | ! corrected the next day. |
|---|
| 983 | DO icir=ncirc,1,-1 |
|---|
| 984 | |
|---|
| 985 | trees_needed=circ_class_n_new(icir) |
|---|
| 986 | |
|---|
| 987 | DO jcir=ncirc,1,-1 |
|---|
| 988 | |
|---|
| 989 | IF(trees_needed .LE. zero)EXIT |
|---|
| 990 | |
|---|
| 991 | ! Debug |
|---|
| 992 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 993 | WRITE(numout,*) 'start of loop' |
|---|
| 994 | WRITE(numout,*) 'circ_class_biomass_new, C',& |
|---|
| 995 | icir,SUM(circ_class_biomass_new(icir,:,icarbon)) |
|---|
| 996 | WRITE(numout,*) 'circ_class_biomass_new, N',& |
|---|
| 997 | icir,SUM(circ_class_biomass_new(icir,:,initrogen)) |
|---|
| 998 | WRITE(numout,*) 'old_trees_left, ', & |
|---|
| 999 | jcir, old_trees_left(jcir) |
|---|
| 1000 | WRITE(numout,*) 'trees needed, ',trees_needed |
|---|
| 1001 | ENDIF |
|---|
| 1002 | !- |
|---|
| 1003 | |
|---|
| 1004 | IF(old_trees_left(jcir) .GE. trees_needed )THEN |
|---|
| 1005 | |
|---|
| 1006 | ! we can get all the trees we need from this class |
|---|
| 1007 | ! and don't have to continue searching |
|---|
| 1008 | circ_class_biomass_new(icir,:,:)=circ_class_biomass_new(icir,:,:)+& |
|---|
| 1009 | circ_class_biomass(ipts,ivm,jcir,:,:)*trees_needed |
|---|
| 1010 | old_trees_left(jcir)=old_trees_left(jcir)-trees_needed |
|---|
| 1011 | trees_needed = zero |
|---|
| 1012 | |
|---|
| 1013 | ! Debug |
|---|
| 1014 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 1015 | WRITE(numout,*) 'enough trees' |
|---|
| 1016 | ENDIF |
|---|
| 1017 | !- |
|---|
| 1018 | |
|---|
| 1019 | EXIT |
|---|
| 1020 | |
|---|
| 1021 | ELSE |
|---|
| 1022 | |
|---|
| 1023 | ! the trees in this class are not sufficient, so we |
|---|
| 1024 | ! need to move all of them to the new class. |
|---|
| 1025 | circ_class_biomass_new(icir,:,:)=circ_class_biomass_new(icir,:,:)+& |
|---|
| 1026 | circ_class_biomass(ipts,ivm,jcir,:,:)*& |
|---|
| 1027 | old_trees_left(jcir) |
|---|
| 1028 | trees_needed = trees_needed-old_trees_left(jcir) |
|---|
| 1029 | old_trees_left(jcir)=zero |
|---|
| 1030 | |
|---|
| 1031 | ! Debug |
|---|
| 1032 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 1033 | WRITE(numout,*) 'not enough trees' |
|---|
| 1034 | ENDIF |
|---|
| 1035 | !- |
|---|
| 1036 | |
|---|
| 1037 | ENDIF |
|---|
| 1038 | |
|---|
| 1039 | ! Debug |
|---|
| 1040 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 1041 | WRITE(numout,*) 'start of loop' |
|---|
| 1042 | WRITE(numout,*) 'circ_class_biomass_new, C',& |
|---|
| 1043 | icir,SUM(circ_class_biomass_new(icir,:,icarbon)) |
|---|
| 1044 | WRITE(numout,*) 'circ_class_biomass_new, N',& |
|---|
| 1045 | icir,SUM(circ_class_biomass_new(icir,:,initrogen)) |
|---|
| 1046 | WRITE(numout,*) 'old_trees_left, ', & |
|---|
| 1047 | jcir, old_trees_left(jcir) |
|---|
| 1048 | WRITE(numout,*) 'trees needed, ',trees_needed |
|---|
| 1049 | ENDIF |
|---|
| 1050 | !- |
|---|
| 1051 | |
|---|
| 1052 | ENDDO ! jcir=1,ncirc |
|---|
| 1053 | |
|---|
| 1054 | ENDDO ! icir=1,ncirc |
|---|
| 1055 | |
|---|
| 1056 | ! right now, circ_class_biomass_new gives the total biomass |
|---|
| 1057 | ! in each class, but it should only be for a model tree. |
|---|
| 1058 | ! So let's normalize it. |
|---|
| 1059 | DO icir=1,ncirc |
|---|
| 1060 | circ_class_biomass_new(icir,:,:) = & |
|---|
| 1061 | circ_class_biomass_new(icir,:,:)/& |
|---|
| 1062 | circ_class_n_new(icir) |
|---|
| 1063 | ENDDO |
|---|
| 1064 | |
|---|
| 1065 | ! Check whether the order was preserved. We only want to |
|---|
| 1066 | ! preserve the order for the carbon biomass. Nitrogen follows |
|---|
| 1067 | ! carbon. We expect that the biomass of an individual tree |
|---|
| 1068 | ! increases with an increasing circ class. This is probably |
|---|
| 1069 | ! not important for the correct functioning of the model. So, |
|---|
| 1070 | ! if this turns out to be computationally expensive it is |
|---|
| 1071 | ! worth trying without. We try to preserve the order as |
|---|
| 1072 | ! an additional mean to control the quality of the simulations. |
|---|
| 1073 | ! A strict order also helps to interpret the output. Hence, |
|---|
| 1074 | ! if the order was not preserved we will sort the biomasses. |
|---|
| 1075 | ! Note that this subroutine first checks whether the order |
|---|
| 1076 | ! was preseverd. |
|---|
| 1077 | CALL sort_circ_class_biomass(circ_class_biomass_new,& |
|---|
| 1078 | circ_class_n_new) |
|---|
| 1079 | |
|---|
| 1080 | ! Now update the variables that pass this information around |
|---|
| 1081 | DO icir=1,ncirc |
|---|
| 1082 | circ_class_biomass(ipts,ivm,icir,:,:) = & |
|---|
| 1083 | circ_class_biomass_new(icir,:,:) |
|---|
| 1084 | circ_class_n(ipts,ivm,icir) = circ_class_n_new(icir) |
|---|
| 1085 | ENDDO |
|---|
| 1086 | |
|---|
| 1087 | ENDIF ! redistribute |
|---|
| 1088 | |
|---|
| 1089 | ! Debug |
|---|
| 1090 | IF(printlev_loc>=4 .AND. ivm==test_pft)THEN |
|---|
| 1091 | WRITE(numout,*) 'End of redistributing biomass in mortality_clean' |
|---|
| 1092 | WRITE(numout,*) 'ipts,ivm',ipts,ivm |
|---|
| 1093 | WRITE(numout,*) 'circ_class_n, ',circ_class_n(ipts,ivm,:) |
|---|
| 1094 | WRITE(numout,*) 'circ_class_biomass - C, ', & |
|---|
| 1095 | SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2) |
|---|
| 1096 | WRITE(numout,*) 'circ_class_biomass - N, ', & |
|---|
| 1097 | SUM(circ_class_biomass(ipts,ivm,:,:,initrogen),2) |
|---|
| 1098 | ENDIF |
|---|
| 1099 | !- |
|---|
| 1100 | |
|---|
| 1101 | ENDIF |
|---|
| 1102 | |
|---|
| 1103 | ELSEIF (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LT. & |
|---|
| 1104 | min_stomate .AND. & |
|---|
| 1105 | plant_status(ipts,ivm) .EQ. idead) THEN |
|---|
| 1106 | |
|---|
| 1107 | ! All the biomass was killed for this site. Some flags to |
|---|
| 1108 | ! be reset in this case. It is OK to kill the PFT even if |
|---|
| 1109 | ! we are using species change but we can not replant yet |
|---|
| 1110 | ! because we want to replant with a different species this is |
|---|
| 1111 | ! basically the same as a land cover change and so it is best |
|---|
| 1112 | ! taken care of with the sapiens_lcchange code. To end up |
|---|
| 1113 | ! here we need a veget_max for this PFT. Another check is |
|---|
| 1114 | ! through using ::PFTpresent. |
|---|
| 1115 | IF(PFTpresent(ipts,ivm))THEN |
|---|
| 1116 | |
|---|
| 1117 | nkilled(ivm)=nkilled(ivm)+1 ! purely an informational variable |
|---|
| 1118 | |
|---|
| 1119 | !! 1.5 Reinitialize vegetation characteristics in STOMATE |
|---|
| 1120 | plant_status(ipts,ivm) = iprescribe |
|---|
| 1121 | age(ipts,ivm) = zero |
|---|
| 1122 | sugar_load(ipts,ivm) = un |
|---|
| 1123 | |
|---|
| 1124 | ! Specific variables for forest stands |
|---|
| 1125 | IF(is_tree(ivm))THEN |
|---|
| 1126 | when_growthinit(ipts,ivm) = large_value |
|---|
| 1127 | last_cut(ipts,ivm) = zero |
|---|
| 1128 | mai_count(ipts,ivm) = zero |
|---|
| 1129 | age_stand(ipts,ivm) = zero |
|---|
| 1130 | ENDIF |
|---|
| 1131 | |
|---|
| 1132 | !! 1.6 Update leaf ages |
|---|
| 1133 | DO ilage = 1, nleafages |
|---|
| 1134 | |
|---|
| 1135 | leaf_age(ipts,ivm,ilage) = zero |
|---|
| 1136 | leaf_frac(ipts,ivm,ilage) = zero |
|---|
| 1137 | |
|---|
| 1138 | ENDDO |
|---|
| 1139 | |
|---|
| 1140 | ! This used to be done in lpj_kill. If we have grasses, |
|---|
| 1141 | ! we reset the long term GPP. This value as 500 in the |
|---|
| 1142 | ! old code. We externalized the variable, but we are |
|---|
| 1143 | ! leaving the default at 500. Many PFTs should have |
|---|
| 1144 | ! a long term value of less than 500, so someone could |
|---|
| 1145 | ! do some work on this in the future. |
|---|
| 1146 | IF (.NOT. is_tree(ivm) .AND. .NOT. ok_constant_mortality) THEN |
|---|
| 1147 | |
|---|
| 1148 | npp_longterm(ipts,ivm) = npp_reset_value(ivm) |
|---|
| 1149 | |
|---|
| 1150 | ENDIF |
|---|
| 1151 | |
|---|
| 1152 | ENDIF ! is PFT present? |
|---|
| 1153 | |
|---|
| 1154 | ENDIF ! check if biomass is equal to zero |
|---|
| 1155 | |
|---|
| 1156 | ! If we have no vegetation left, this stand has been completely cleared. |
|---|
| 1157 | ! We have to reset the age, regardless if it was for natural or human reasons. |
|---|
| 1158 | IF(is_tree(ivm))THEN |
|---|
| 1159 | |
|---|
| 1160 | ! This is essentially the same code that is found in land cover change, |
|---|
| 1161 | ! since the same process happens there. Notice that here we do not |
|---|
| 1162 | ! need to use the _bank variables, since we assume that if a stand dies |
|---|
| 1163 | ! due to natural causes it will always be replaced by the same species. |
|---|
| 1164 | ! We also assume that if a stand is clearcut, the model will replace it |
|---|
| 1165 | ! by the same species. To do so otherwise would require something more |
|---|
| 1166 | ! like a DGVM. That is what is being done in the species change code. |
|---|
| 1167 | ! If the species change code is used, the PFT will be replanted at the |
|---|
| 1168 | ! end of the year. Not in the middle of the year as being done here. |
|---|
| 1169 | |
|---|
| 1170 | ! If we are using age classes, we need to reset a lot of counters |
|---|
| 1171 | ! and change veget_max, moving veget_max from this age class to |
|---|
| 1172 | ! the lowest age class. If veget_max is greater than zero and there |
|---|
| 1173 | ! is no biomass, prescribe will attempt to grow trees here in the |
|---|
| 1174 | ! next timestep. This is fine if we have no age classes, but it doesn't |
|---|
| 1175 | ! make any sense to prescribe trees that are 50 years old. We should |
|---|
| 1176 | ! only prescribe trees which are 0 years old. |
|---|
| 1177 | IF( SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LT. & |
|---|
| 1178 | min_stomate .AND. (agec_group(ivm)==species_change_map(ipts,ivm) .OR. & |
|---|
| 1179 | .NOT.lpft_replant(ipts,ivm))) THEN |
|---|
| 1180 | |
|---|
| 1181 | ! Debug |
|---|
| 1182 | IF(printlev_loc>=4)THEN |
|---|
| 1183 | WRITE(numout,*) 'Getting reset in mortality_clean' |
|---|
| 1184 | WRITE(numout,*) 'ivm,ipts',ivm,ipts |
|---|
| 1185 | ENDIF |
|---|
| 1186 | !- |
|---|
| 1187 | |
|---|
| 1188 | IF(nagec .GT. 1)THEN |
|---|
| 1189 | |
|---|
| 1190 | ! First, we need to find the youngest age class of this PFT. |
|---|
| 1191 | iyoung=start_index(agec_group(ivm)) |
|---|
| 1192 | IF(ivm == iyoung)THEN |
|---|
| 1193 | lyoungest=.TRUE. |
|---|
| 1194 | ELSE |
|---|
| 1195 | lyoungest=.FALSE. |
|---|
| 1196 | ENDIF |
|---|
| 1197 | |
|---|
| 1198 | IF(lyoungest)THEN |
|---|
| 1199 | |
|---|
| 1200 | ! We don't need to do anything. Things will be handled properly with |
|---|
| 1201 | ! prescribe in the next step. |
|---|
| 1202 | |
|---|
| 1203 | ELSE |
|---|
| 1204 | |
|---|
| 1205 | ! All of our counters for this stand are zero. We need to merge that |
|---|
| 1206 | ! with the youngest age class. There are a couple possibilities. |
|---|
| 1207 | ! One is that nothing exists right now in the youngest age class, in |
|---|
| 1208 | ! which case the veget_max of the old age class becomes that of the |
|---|
| 1209 | ! youngest and we prescribe. Another possibility is that something |
|---|
| 1210 | ! does exist in the youngest age class, in which case we prescribe |
|---|
| 1211 | ! to the current age class and then merge biomass with the youngest. |
|---|
| 1212 | ! A third is that both the youngest age class and the current age |
|---|
| 1213 | ! class have died. In that case we can do the same thing as if there |
|---|
| 1214 | ! is no vegetation in the young age class, we just have to make sure |
|---|
| 1215 | ! to add the veget_max and not replace it. |
|---|
| 1216 | ! Veget_max after PFT expansion. As ::veget_max is used in the |
|---|
| 1217 | ! IF-statements we won't update it until the end of this routine. If |
|---|
| 1218 | ! we would update before that, the same PFT may be subject to |
|---|
| 1219 | ! conflicting actions. |
|---|
| 1220 | share_young = veget_max(ipts,iyoung) / & |
|---|
| 1221 | ( veget_max(ipts,iyoung) + veget_max(ipts,ivm) ) |
|---|
| 1222 | |
|---|
| 1223 | ! We also need a scaling factor which includes the litter |
|---|
| 1224 | DO ilev=1,nlevs |
|---|
| 1225 | DO ilit=1,nlitt |
|---|
| 1226 | IF(litter(ipts,ilit,iyoung,ilev,icarbon) .GT. min_stomate)THEN |
|---|
| 1227 | |
|---|
| 1228 | litter_weight_young(ilit,ilev)=& |
|---|
| 1229 | litter(ipts,ilit,iyoung,ilev,icarbon)*& |
|---|
| 1230 | veget_max(ipts,iyoung)/ & |
|---|
| 1231 | (litter(ipts,ilit,ivm,ilev,icarbon)*veget_max(ipts,ivm) + & |
|---|
| 1232 | litter(ipts,ilit,iyoung,ilev,icarbon)*& |
|---|
| 1233 | veget_max(ipts,iyoung)) |
|---|
| 1234 | |
|---|
| 1235 | ELSE |
|---|
| 1236 | |
|---|
| 1237 | litter_weight_young(ilit,ilev)=zero |
|---|
| 1238 | |
|---|
| 1239 | ENDIF |
|---|
| 1240 | END DO |
|---|
| 1241 | ENDDO |
|---|
| 1242 | |
|---|
| 1243 | IF( SUM(SUM(circ_class_biomass(ipts,iyoung,:,:,icarbon),1),1) .LT. & |
|---|
| 1244 | min_stomate)THEN |
|---|
| 1245 | |
|---|
| 1246 | ! Debug |
|---|
| 1247 | IF(printlev_loc>=4)THEN |
|---|
| 1248 | WRITE(numout,*) 'Merging our biomass to the youngest age class.' |
|---|
| 1249 | WRITE(numout,*) 'No current biomass in the youngest age class.' |
|---|
| 1250 | WRITE(numout,*) 'ipts,iyoung,ivm: ',ipts,iyoung,ivm |
|---|
| 1251 | WRITE(numout,*) 'share_young: ',share_young |
|---|
| 1252 | WRITE(numout,*) 'veget_max(young and current): ',& |
|---|
| 1253 | veget_max(ipts,iyoung),veget_max(ipts,ivm) |
|---|
| 1254 | ENDIF |
|---|
| 1255 | !- |
|---|
| 1256 | |
|---|
| 1257 | ! Is there anything in the smallest age class? It |
|---|
| 1258 | ! does not matter if the youngest age class died in this |
|---|
| 1259 | ! step or not. |
|---|
| 1260 | plant_status(ipts,iyoung) = iprescribe |
|---|
| 1261 | plant_status(ipts,ivm) = idead |
|---|
| 1262 | |
|---|
| 1263 | veget_max(ipts,iyoung) = veget_max(ipts,iyoung)+veget_max(ipts,ivm) |
|---|
| 1264 | |
|---|
| 1265 | vegstress_season(ipts,iyoung) = & |
|---|
| 1266 | share_young * vegstress_season(ipts,iyoung) + & |
|---|
| 1267 | vegstress_season(ipts,ivm) * & |
|---|
| 1268 | (un - share_young) |
|---|
| 1269 | |
|---|
| 1270 | sugar_load(ipts,iyoung) = share_young * sugar_load(ipts,iyoung) + & |
|---|
| 1271 | (un-share_young) * sugar_load(ipts,ivm) |
|---|
| 1272 | |
|---|
| 1273 | !+++CHECK+++ |
|---|
| 1274 | ! Not sure why we merge wstress here. wstress is recalculated |
|---|
| 1275 | ! everyday from vegstress_season. |
|---|
| 1276 | wstress_season(ipts,iyoung) = & |
|---|
| 1277 | share_young * wstress_season(ipts,iyoung) + & |
|---|
| 1278 | wstress_season(ipts,ivm) * (un - share_young) |
|---|
| 1279 | nstress_season(ipts,iyoung) = & |
|---|
| 1280 | share_young * nstress_season(ipts,iyoung) + & |
|---|
| 1281 | nstress_season(ipts,ivm) * (un - share_young) |
|---|
| 1282 | !++++++++++++ |
|---|
| 1283 | |
|---|
| 1284 | ! The litter variables also need to be merged, since these will not |
|---|
| 1285 | ! get updated in prescribe in the next step. |
|---|
| 1286 | litter(ipts,:,iyoung,:,:) = & |
|---|
| 1287 | share_young * litter(ipts,:,iyoung,:,:) + & |
|---|
| 1288 | litter(ipts,:,ivm,:,:) * & |
|---|
| 1289 | (un - share_young) |
|---|
| 1290 | IF (ok_soil_carbon_discretization) THEN |
|---|
| 1291 | deepSOM_a(ipts,:,iyoung,:) = & |
|---|
| 1292 | share_young * deepSOM_a(ipts,:,iyoung,:) + & |
|---|
| 1293 | deepSOM_a(ipts,:,ivm,:) * (un - share_young) |
|---|
| 1294 | deepSOM_s(ipts,:,iyoung,:) = & |
|---|
| 1295 | share_young * deepSOM_s(ipts,:,iyoung,:) + & |
|---|
| 1296 | deepSOM_s(ipts,:,ivm,:) * (un - share_young) |
|---|
| 1297 | deepSOM_p(ipts,:,iyoung,:) = & |
|---|
| 1298 | share_young * deepSOM_p(ipts,:,iyoung,:) + & |
|---|
| 1299 | deepSOM_p(ipts,:,ivm,:) * (un - share_young) |
|---|
| 1300 | ELSE |
|---|
| 1301 | som(ipts,:,iyoung,:) = & |
|---|
| 1302 | share_young * som(ipts,:,iyoung,:) + & |
|---|
| 1303 | som(ipts,:,ivm,:) * (un - share_young) |
|---|
| 1304 | END IF |
|---|
| 1305 | |
|---|
| 1306 | DO ilev=1,nlevs |
|---|
| 1307 | lignin_struc(ipts,iyoung,ilev) = & |
|---|
| 1308 | litter_weight_young(istructural,ilev) * & |
|---|
| 1309 | lignin_struc(ipts,iyoung,ilev) + & |
|---|
| 1310 | (un - litter_weight_young(istructural,ilev)) * & |
|---|
| 1311 | lignin_struc(ipts,ivm,ilev) |
|---|
| 1312 | lignin_wood(ipts,iyoung,ilev) = & |
|---|
| 1313 | litter_weight_young(iwoody,ilev) * & |
|---|
| 1314 | lignin_wood(ipts,iyoung,ilev) + & |
|---|
| 1315 | (un - litter_weight_young(iwoody,ilev) ) * & |
|---|
| 1316 | lignin_wood(ipts,ivm,ilev) |
|---|
| 1317 | ENDDO |
|---|
| 1318 | |
|---|
| 1319 | bm_to_litter(ipts,iyoung,:,:) = & |
|---|
| 1320 | share_young * bm_to_litter(ipts,iyoung,:,:) + & |
|---|
| 1321 | bm_to_litter(ipts,ivm,:,:) * & |
|---|
| 1322 | (un - share_young) |
|---|
| 1323 | |
|---|
| 1324 | ! Update the soil pools |
|---|
| 1325 | soil_n_min(ipts,iyoung,:) = & |
|---|
| 1326 | share_young * soil_n_min(ipts,iyoung,:) + & |
|---|
| 1327 | soil_n_min(ipts,ivm,:) * & |
|---|
| 1328 | (un - share_young) |
|---|
| 1329 | p_O2(ipts,iyoung) = & |
|---|
| 1330 | share_young * p_O2(ipts,iyoung) + & |
|---|
| 1331 | p_O2(ipts,ivm) * (un - share_young) |
|---|
| 1332 | bact(ipts,iyoung) = & |
|---|
| 1333 | share_young * bact(ipts,iyoung) + & |
|---|
| 1334 | bact(ipts,ivm) * (un - share_young) |
|---|
| 1335 | |
|---|
| 1336 | ! Leaf properties |
|---|
| 1337 | cn_leaf_min_season(ipts,iyoung) = & |
|---|
| 1338 | share_young * cn_leaf_min_season(ipts,iyoung) + & |
|---|
| 1339 | cn_leaf_min_season(ipts,ivm) * (un - share_young) |
|---|
| 1340 | |
|---|
| 1341 | ! For the analytic spinup, we need longterm CN ratios |
|---|
| 1342 | ! calculated over the spinup period. If the tree grows |
|---|
| 1343 | ! and move to an older age class, this is taken care of |
|---|
| 1344 | ! by age_class_distr, but if PFT is killed we need to |
|---|
| 1345 | ! move CN back to the first age class as well. |
|---|
| 1346 | ! Otherwise, we will not get a CN ratio for soil and |
|---|
| 1347 | ! litter pools the corresponds to the spinup period. |
|---|
| 1348 | IF(spinup_analytic)THEN |
|---|
| 1349 | CN_som_litter_longterm(ipts,iyoung,:)=& |
|---|
| 1350 | share_young * CN_som_litter_longterm(ipts,iyoung,:) + & |
|---|
| 1351 | CN_som_litter_longterm(ipts,ivm,:) * (un - share_young) |
|---|
| 1352 | matrixA(ipts,iyoung,:,:)=& |
|---|
| 1353 | share_young *matrixA(ipts,iyoung,:,:) + & |
|---|
| 1354 | matrixA(ipts,ivm,:,:) * (un -share_young) |
|---|
| 1355 | matrixV(ipts,iyoung,:,:)=& |
|---|
| 1356 | share_young *matrixV(ipts,iyoung,:,:) + & |
|---|
| 1357 | matrixV(ipts,ivm,:,:) * (un -share_young) |
|---|
| 1358 | vectorB(ipts,iyoung,:)=& |
|---|
| 1359 | share_young *vectorB(ipts,iyoung,:) + & |
|---|
| 1360 | vectorB(ipts,ivm,:) * (un -share_young) |
|---|
| 1361 | vectorU(ipts,iyoung,:)=& |
|---|
| 1362 | share_young *vectorB(ipts,iyoung,:) + & |
|---|
| 1363 | vectorB(ipts,ivm,:) * (un -share_young) |
|---|
| 1364 | |
|---|
| 1365 | ENDIF |
|---|
| 1366 | |
|---|
| 1367 | ELSE |
|---|
| 1368 | |
|---|
| 1369 | ! There are two important things to do here. First, |
|---|
| 1370 | ! we need to prescribe biomass to this PFT, since part of it |
|---|
| 1371 | ! is currently empty. Then we need to merge this biomass |
|---|
| 1372 | ! with what is already in the youngest age class of this PFT. |
|---|
| 1373 | |
|---|
| 1374 | ! We want to make use of prescribe but it should |
|---|
| 1375 | ! be noted that the youngest PFT already contains biomass. |
|---|
| 1376 | ! Therefore we will create a temporary PFT without biomass which |
|---|
| 1377 | ! can be used to establish the new vegetation within the |
|---|
| 1378 | ! youngest. For most of the INTENT(inout) variables of |
|---|
| 1379 | ! prescribe we receive temporary variables back this |
|---|
| 1380 | ! helps us to calculate the weighted mean of the newly established |
|---|
| 1381 | ! vegetation and the vegetation that is already there. For some |
|---|
| 1382 | ! other variables we receive dummies as we are simply not |
|---|
| 1383 | ! going to use these values but will continue using the values of the |
|---|
| 1384 | ! vegetation that is already there. |
|---|
| 1385 | |
|---|
| 1386 | ! Debug |
|---|
| 1387 | IF(printlev_loc>=4)THEN |
|---|
| 1388 | WRITE(numout,*) 'Merging our biomass to the youngest age class.' |
|---|
| 1389 | WRITE(numout,*) 'Biomass already in the youngest age class.' |
|---|
| 1390 | WRITE(numout,*) 'ipts,iyoung,ivm: ',ipts,iyoung,ivm |
|---|
| 1391 | WRITE(numout,*) 'share_young: ',share_young |
|---|
| 1392 | WRITE(numout,*) 'veget_max(young and current): ',& |
|---|
| 1393 | veget_max(ipts,iyoung),veget_max(ipts,ivm) |
|---|
| 1394 | ENDIF |
|---|
| 1395 | !- |
|---|
| 1396 | |
|---|
| 1397 | !! 5.2.3.1 Initialize new and dummy variables |
|---|
| 1398 | new_circ_class_biomass(:,:,:,:,:) = zero |
|---|
| 1399 | new_circ_class_n(:,:,:) = zero |
|---|
| 1400 | new_lm_lastyearmax(:,:) = zero |
|---|
| 1401 | new_age(:,:) = zero |
|---|
| 1402 | new_leaf_frac(:,:,:) = zero |
|---|
| 1403 | new_atm_to_bm(:,:,:) = zero |
|---|
| 1404 | new_everywhere(:,:) = zero |
|---|
| 1405 | dum_when_growthinit(:,:) = large_value |
|---|
| 1406 | dum_npp_longterm(:,:) = zero |
|---|
| 1407 | dum_PFTpresent(:,:) = .TRUE. |
|---|
| 1408 | dum_plant_status(:,:) = iprescribe |
|---|
| 1409 | |
|---|
| 1410 | !! 5.2.3.2 Merge the new and already available vegetation |
|---|
| 1411 | |
|---|
| 1412 | ! Assign value to vegstress_season |
|---|
| 1413 | ! We do this differently from LCC, because we are replanting |
|---|
| 1414 | ! the same stand that we just cut. |
|---|
| 1415 | vegstress_season(ipts,iyoung) = & |
|---|
| 1416 | vegstress_season(ipts,iyoung) * & |
|---|
| 1417 | share_young + vegstress_season(ipts,ivm) * & |
|---|
| 1418 | (un - share_young) |
|---|
| 1419 | wstress_season(ipts,iyoung) = wstress_season(ipts,iyoung) * & |
|---|
| 1420 | share_young + wstress_season(ipts,ivm) * (un - share_young) |
|---|
| 1421 | nstress_season(ipts,iyoung) = nstress_season(ipts,iyoung) * & |
|---|
| 1422 | share_young + nstress_season(ipts,ivm) * (un - share_young) |
|---|
| 1423 | |
|---|
| 1424 | |
|---|
| 1425 | !! 5.2.3.3 Initialize the newly established vegetation: |
|---|
| 1426 | ! Initialize the newly established vegetation: density of |
|---|
| 1427 | ! individuals, biomass, allocation factors, leaf age distribution, |
|---|
| 1428 | ! etc to some reasonable value ::veget_max is not updated yet, |
|---|
| 1429 | ! therefore loss_gain is passed in the argument list. |
|---|
| 1430 | ! For loss_gain, we only want to replant the current PFT. |
|---|
| 1431 | ! If lpft_replat is TRUE we should never be here in the |
|---|
| 1432 | ! first place but to be safe lpft_replant is passed into |
|---|
| 1433 | ! prescribe. This is an optional variable that will prevent |
|---|
| 1434 | ! prescribing biomass if species change is used. |
|---|
| 1435 | |
|---|
| 1436 | ! Debug |
|---|
| 1437 | IF(printlev_loc>=4)THEN |
|---|
| 1438 | IF(lpft_replant(ipts,ivm))THEN |
|---|
| 1439 | WRITE(numout,*) 'ERROR - mortality_clean should never be here' |
|---|
| 1440 | IF (err_act.GT.1) CALL ipslerr_p(3, & |
|---|
| 1441 | 'mortality_clean in stomate_kill.f90',& |
|---|
| 1442 | 'species change was activated, replanting needed',& |
|---|
| 1443 | 'do not replant in mortality_clean, wait for lcchange','') |
|---|
| 1444 | ENDIF |
|---|
| 1445 | ENDIF |
|---|
| 1446 | !- |
|---|
| 1447 | |
|---|
| 1448 | loss_gain(:,:)=zero |
|---|
| 1449 | loss_gain(ipts,ivm)=veget_max(ipts,ivm) |
|---|
| 1450 | |
|---|
| 1451 | ! In gap_clean stomate_prescribe is only used to establish new |
|---|
| 1452 | ! vegetation. The variables required for recruitment are not |
|---|
| 1453 | ! passed all the way into this routine but are made dummy |
|---|
| 1454 | ! variables. A more elegant solution is to use OPTIONAL variables |
|---|
| 1455 | ! but the code became a bit confused because lpft_replant is |
|---|
| 1456 | ! already an OPTIONAL variable but for a completly different |
|---|
| 1457 | ! functionality. |
|---|
| 1458 | ! Dummy for light_tran_tot_season |
|---|
| 1459 | dummy1(:,:,:) = un |
|---|
| 1460 | CALL prescribe (npts,loss_gain, dt_days, & |
|---|
| 1461 | dum_PFTpresent, new_everywhere, dum_when_growthinit, & |
|---|
| 1462 | new_leaf_frac, circ_class_dist, new_circ_class_n, & |
|---|
| 1463 | new_circ_class_biomass, new_atm_to_bm, forest_managed, & |
|---|
| 1464 | KF, dum_plant_status, new_age, dum_npp_longterm, & |
|---|
| 1465 | new_lm_lastyearmax, longevity_eff_leaf, longevity_eff_sap, & |
|---|
| 1466 | longevity_eff_root, k_latosa_adapt, dummy1, & |
|---|
| 1467 | lpft_replant,species_change_map, & |
|---|
| 1468 | cn_leaf_init_2D, bm_sapl_2D, new_ind, qmd_init, & |
|---|
| 1469 | dia_init) |
|---|
| 1470 | |
|---|
| 1471 | !! 5.2.3.3.1 Merge biomass of new and already available trees |
|---|
| 1472 | ! Unlike LCC, we are only at this point if we are dealing |
|---|
| 1473 | ! with forests, so we don't have to check for that here. |
|---|
| 1474 | |
|---|
| 1475 | ! Copy the number of individuals and the biomass of the established |
|---|
| 1476 | ! vegetation to a temporary variable. In the subroutine ::circ_class_n |
|---|
| 1477 | ! and ::circ_class_biomass will be overwritten with the characteristics |
|---|
| 1478 | ! of the merged vegetation |
|---|
| 1479 | ! The term "established" here refers to the youngest age class, while |
|---|
| 1480 | ! "tmp" is the prescribed vegetation that we just created. |
|---|
| 1481 | est_circ_class_n(:) = circ_class_n(ipts,iyoung,:) |
|---|
| 1482 | est_circ_class_biomass(:,:,:) = circ_class_biomass(ipts,iyoung,:,:,:) |
|---|
| 1483 | tmp_circ_class_n(:) = new_circ_class_n(ipts,ivm,:) |
|---|
| 1484 | tmp_circ_class_biomass(:,:,:) = new_circ_class_biomass(ipts,ivm,:,:,:) |
|---|
| 1485 | |
|---|
| 1486 | ! Store circumference (m) in a temporary variable that can be |
|---|
| 1487 | ! sorted from small to large - note that the dimension of these |
|---|
| 1488 | ! variables are 2*ncirc |
|---|
| 1489 | est_circ_class_dia(:) = & |
|---|
| 1490 | wood_to_dia(est_circ_class_biomass(:,:,icarbon),ivm) |
|---|
| 1491 | tmp_circ_class_dia(:) = & |
|---|
| 1492 | wood_to_dia(tmp_circ_class_biomass(:,:,icarbon),ivm) |
|---|
| 1493 | |
|---|
| 1494 | ! Debug |
|---|
| 1495 | IF(printlev_loc>=4)THEN |
|---|
| 1496 | WRITE(numout,*) 'rest, ', SUM(circ_class_n(ipts,ivm,:)), & |
|---|
| 1497 | SUM(est_circ_class_n), SUM(tmp_circ_class_n), & |
|---|
| 1498 | SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2),1), & |
|---|
| 1499 | SUM(est_circ_class_biomass), & |
|---|
| 1500 | SUM(tmp_circ_class_biomass), & |
|---|
| 1501 | ipts, iyoung, SUM(est_circ_class_dia), SUM(tmp_circ_class_dia), & |
|---|
| 1502 | lpft_replant(ipts,ivm) |
|---|
| 1503 | ENDIF |
|---|
| 1504 | !- |
|---|
| 1505 | |
|---|
| 1506 | ! Merge the biomass |
|---|
| 1507 | CALL merge_biomass_pfts(npts, share_young, circ_class_n, & |
|---|
| 1508 | est_circ_class_n, tmp_circ_class_n, circ_class_biomass, & |
|---|
| 1509 | est_circ_class_biomass, & |
|---|
| 1510 | tmp_circ_class_biomass, circ_class_dist, & |
|---|
| 1511 | ipts, iyoung, est_circ_class_dia, tmp_circ_class_dia) |
|---|
| 1512 | |
|---|
| 1513 | !! 5.2.3.4 Calculate the PFT characteristics of the merged PFT |
|---|
| 1514 | ! Take the weighted mean of the existing vegetation and the new |
|---|
| 1515 | ! vegetation in this PFT. Note that co2_to_bm is in gC. m-2 dt-1 |
|---|
| 1516 | ! so we should also take the weighted mean (rather than sum if |
|---|
| 1517 | ! this where absolute values). |
|---|
| 1518 | lm_lastyearmax(ipts,iyoung) = share_young * & |
|---|
| 1519 | lm_lastyearmax(ipts,iyoung) + & |
|---|
| 1520 | (un - share_young) * new_lm_lastyearmax(ipts,ivm) |
|---|
| 1521 | age(ipts,iyoung) = share_young * age(ipts,iyoung) + & |
|---|
| 1522 | (un - share_young) * new_age(ipts,ivm) |
|---|
| 1523 | leaf_frac(ipts,iyoung,:) = share_young * leaf_frac(ipts,iyoung,:) + & |
|---|
| 1524 | (un - share_young) * new_leaf_frac(ipts,ivm,:) |
|---|
| 1525 | |
|---|
| 1526 | ! Note that the purpose of the prescribe subroutine is |
|---|
| 1527 | ! to get biomass (seedlings) without having to simulate |
|---|
| 1528 | ! seed germination and growth of very small plants. |
|---|
| 1529 | ! This means that through prescribe we get biomass |
|---|
| 1530 | ! without GPP, Ra and Rg. They are accounted for for |
|---|
| 1531 | ! consistency reasons. Germination and growth of |
|---|
| 1532 | ! seedlings is by-passed through new_atm_to_bm so this |
|---|
| 1533 | ! really needs to ba accounted for. |
|---|
| 1534 | atm_to_bm(ipts,iyoung,:) = share_young * atm_to_bm(ipts,iyoung,:) + & |
|---|
| 1535 | (un - share_young) * new_atm_to_bm(ipts,ivm,:) |
|---|
| 1536 | gpp_daily(ipts,iyoung) = share_young * gpp_daily(ipts,iyoung) + & |
|---|
| 1537 | (un - share_young) * gpp_daily(ipts,ivm) |
|---|
| 1538 | resp_maint(ipts,iyoung) = share_young * resp_maint(ipts,iyoung) + & |
|---|
| 1539 | (un - share_young) * resp_maint(ipts,ivm) |
|---|
| 1540 | resp_growth(ipts,iyoung) = share_young * resp_growth(ipts,iyoung) + & |
|---|
| 1541 | (un - share_young) * resp_growth(ipts,ivm) |
|---|
| 1542 | sugar_load(ipts,iyoung) = share_young * sugar_load(ipts,iyoung) + & |
|---|
| 1543 | (un - share_young) * sugar_load(ipts,ivm) |
|---|
| 1544 | resp_hetero(ipts,iyoung) = share_young * resp_hetero(ipts,iyoung) + & |
|---|
| 1545 | (un-share_young) * resp_hetero(ipts,ivm) |
|---|
| 1546 | |
|---|
| 1547 | ! Everywhere deals with the migration of vegetation. Copy the |
|---|
| 1548 | ! status of the most migrated vegetation for the whole PFT |
|---|
| 1549 | everywhere(ipts,iyoung) = MAX(everywhere(ipts,iyoung), & |
|---|
| 1550 | new_everywhere(ipts,ivm)) |
|---|
| 1551 | |
|---|
| 1552 | ! The new soil&litter pools are the weighted mean of the newly |
|---|
| 1553 | ! established vegetation for that PFT and the vegetation that |
|---|
| 1554 | ! already exists in that PFT. Notice that we do not use the |
|---|
| 1555 | ! "bank" concept present in LCC because we are replanting |
|---|
| 1556 | ! the same PFT which already existed, just in a younger class. |
|---|
| 1557 | litter(ipts,:,iyoung,:,:) = share_young * litter(ipts,:,iyoung,:,:) + & |
|---|
| 1558 | (un - share_young) * litter(ipts,:,ivm,:,:) |
|---|
| 1559 | IF (ok_soil_carbon_discretization) THEN |
|---|
| 1560 | deepSOM_a(ipts,:,iyoung,:) = share_young * deepSOM_a(ipts,:,iyoung,:) + & |
|---|
| 1561 | (un - share_young) * deepSOM_a(ipts,:,ivm,:) |
|---|
| 1562 | deepSOM_s(ipts,:,iyoung,:) = share_young * deepSOM_s(ipts,:,iyoung,:) + & |
|---|
| 1563 | (un - share_young) * deepSOM_s(ipts,:,ivm,:) |
|---|
| 1564 | deepSOM_p(ipts,:,iyoung,:) = share_young * deepSOM_p(ipts,:,iyoung,:) + & |
|---|
| 1565 | (un - share_young) * deepSOM_p(ipts,:,ivm,:) |
|---|
| 1566 | ELSE |
|---|
| 1567 | som(ipts,:,iyoung,:) = share_young * som(ipts,:,iyoung,:) + & |
|---|
| 1568 | (un - share_young) * som(ipts,:,ivm,:) |
|---|
| 1569 | ENDIF |
|---|
| 1570 | DO ilev=1,nlevs |
|---|
| 1571 | lignin_struc(ipts,iyoung,ilev) = & |
|---|
| 1572 | litter_weight_young(istructural,ilev) * & |
|---|
| 1573 | lignin_struc(ipts,iyoung,ilev) + & |
|---|
| 1574 | (un - litter_weight_young(istructural,ilev)) * & |
|---|
| 1575 | lignin_struc(ipts,ivm,ilev) |
|---|
| 1576 | lignin_wood(ipts,iyoung,ilev) = & |
|---|
| 1577 | litter_weight_young(iwoody,ilev) * & |
|---|
| 1578 | lignin_wood(ipts,iyoung,ilev) + & |
|---|
| 1579 | (un - litter_weight_young(iwoody,ilev) ) * & |
|---|
| 1580 | lignin_wood(ipts,ivm,ilev) |
|---|
| 1581 | ENDDO |
|---|
| 1582 | bm_to_litter(ipts,iyoung,:,:) = share_young * & |
|---|
| 1583 | bm_to_litter(ipts,iyoung,:,:) + & |
|---|
| 1584 | (un - share_young) * bm_to_litter(ipts,ivm,:,:) |
|---|
| 1585 | |
|---|
| 1586 | ! Update the soil pools |
|---|
| 1587 | soil_n_min(ipts,iyoung,:) = & |
|---|
| 1588 | share_young * soil_n_min(ipts,iyoung,:) + & |
|---|
| 1589 | soil_n_min(ipts,ivm,:) * (un - share_young) |
|---|
| 1590 | p_O2(ipts,iyoung) = share_young * p_O2(ipts,iyoung) + & |
|---|
| 1591 | p_O2(ipts,ivm) * (un - share_young) |
|---|
| 1592 | bact(ipts,iyoung) = share_young * bact(ipts,iyoung) + & |
|---|
| 1593 | bact(ipts,ivm) * (un - share_young) |
|---|
| 1594 | |
|---|
| 1595 | ! Update plant N uptake |
|---|
| 1596 | n_uptake_daily(ipts,iyoung,:) = share_young * n_uptake_daily(ipts,iyoung,:) + & |
|---|
| 1597 | n_uptake_daily(ipts,ivm,:) * (un - share_young) |
|---|
| 1598 | n_input_daily(ipts,iyoung,:) = share_young * n_input_daily(ipts,iyoung,:) + & |
|---|
| 1599 | (un-share_young) * n_input_daily(ipts,ivm,:) |
|---|
| 1600 | n_fungivores(ipts,iyoung) = share_young * n_fungivores(ipts,iyoung) + & |
|---|
| 1601 | (un-share_young) * n_fungivores(ipts,ivm) |
|---|
| 1602 | leaching_daily(ipts,iyoung,:) = share_young * leaching_daily(ipts,iyoung,:) + & |
|---|
| 1603 | (un-share_young) * leaching_daily(ipts,ivm,:) |
|---|
| 1604 | emission_daily(ipts,iyoung,:) = share_young * emission_daily(ipts,iyoung,:) + & |
|---|
| 1605 | (un-share_young) * emission_daily(ipts,ivm,:) |
|---|
| 1606 | |
|---|
| 1607 | ! Leaf properties |
|---|
| 1608 | cn_leaf_min_season(ipts,iyoung) = & |
|---|
| 1609 | share_young * cn_leaf_min_season(ipts,iyoung) + & |
|---|
| 1610 | cn_leaf_min_season(ipts,ivm) * (un - share_young) |
|---|
| 1611 | |
|---|
| 1612 | ! For the analytic spinup, we need longterm CN ratios |
|---|
| 1613 | ! calculated over the spinup period. If the tree grows |
|---|
| 1614 | ! and move to an older age class, this is taken care of |
|---|
| 1615 | ! by age_class_distr, but if PFT is killed we need to |
|---|
| 1616 | ! move CN back to the first age class as well. |
|---|
| 1617 | ! Otherwise, we will not get a CN ratio for soil and |
|---|
| 1618 | ! litter pools the corresponds to the spinup period. |
|---|
| 1619 | IF(spinup_analytic)THEN |
|---|
| 1620 | CN_som_litter_longterm(ipts,iyoung,:)=& |
|---|
| 1621 | share_young * CN_som_litter_longterm(ipts,iyoung,:)+ & |
|---|
| 1622 | CN_som_litter_longterm(ipts,ivm,:) * (un -share_young) |
|---|
| 1623 | matrixA(ipts,iyoung,:,:)=& |
|---|
| 1624 | share_young *matrixA(ipts,iyoung,:,:) + & |
|---|
| 1625 | matrixA(ipts,ivm,:,:) * (un -share_young) |
|---|
| 1626 | matrixV(ipts,iyoung,:,:)=& |
|---|
| 1627 | share_young *matrixV(ipts,iyoung,:,:) + & |
|---|
| 1628 | matrixV(ipts,ivm,:,:) * (un -share_young) |
|---|
| 1629 | vectorB(ipts,iyoung,:)=& |
|---|
| 1630 | share_young *vectorB(ipts,iyoung,:) + & |
|---|
| 1631 | vectorB(ipts,ivm,:) * (un -share_young) |
|---|
| 1632 | vectorU(ipts,iyoung,:)=& |
|---|
| 1633 | share_young *vectorB(ipts,iyoung,:) + & |
|---|
| 1634 | vectorB(ipts,ivm,:) * (un -share_young) |
|---|
| 1635 | |
|---|
| 1636 | ENDIF |
|---|
| 1637 | |
|---|
| 1638 | ! Now move the veget_max from the current class to the young one. |
|---|
| 1639 | veget_max(ipts,iyoung)=veget_max(ipts,iyoung)+veget_max(ipts,ivm) |
|---|
| 1640 | |
|---|
| 1641 | ENDIF |
|---|
| 1642 | |
|---|
| 1643 | ! Reset all these variables, since the PFT is dead. |
|---|
| 1644 | PFTpresent(ipts,ivm) = .FALSE. |
|---|
| 1645 | veget_max(ipts,ivm) = zero |
|---|
| 1646 | lm_lastyearmax(ipts,ivm) = zero |
|---|
| 1647 | age(ipts,ivm) = zero |
|---|
| 1648 | leaf_frac(ipts,ivm,:) = zero |
|---|
| 1649 | atm_to_bm(ipts,ivm,:) = zero |
|---|
| 1650 | gpp_daily(ipts,ivm) = zero |
|---|
| 1651 | resp_maint(ipts,ivm) = zero |
|---|
| 1652 | resp_growth(ipts,ivm) = zero |
|---|
| 1653 | resp_hetero(ipts,ivm) = zero |
|---|
| 1654 | everywhere(ipts,ivm) = zero |
|---|
| 1655 | litter(ipts,:,ivm,:,:) = zero |
|---|
| 1656 | som(ipts,:,ivm,:) = zero |
|---|
| 1657 | deepSOM_a(ipts,:,ivm,:) = zero |
|---|
| 1658 | deepSOM_s(ipts,:,ivm,:) = zero |
|---|
| 1659 | deepSOM_p(ipts,:,ivm,:) = zero |
|---|
| 1660 | lignin_struc(ipts,ivm,:) = zero |
|---|
| 1661 | lignin_wood(ipts,ivm,:) = zero |
|---|
| 1662 | bm_to_litter(ipts,ivm,:,:) = zero |
|---|
| 1663 | n_uptake_daily(ipts,ivm,:) = zero |
|---|
| 1664 | soil_n_min(ipts,ivm,:) = zero |
|---|
| 1665 | leaching_daily(ipts,ivm,:) = zero |
|---|
| 1666 | emission_daily(ipts,ivm,:) = zero |
|---|
| 1667 | n_input_daily(ipts,ivm,:) = zero |
|---|
| 1668 | n_fungivores(:,:) = zero |
|---|
| 1669 | bact(ipts,ivm) = zero |
|---|
| 1670 | p_O2(ipts,ivm) = zero |
|---|
| 1671 | nstress_season(ipts,ivm) = zero |
|---|
| 1672 | CN_som_litter_longterm(ipts,ivm,:)=zero |
|---|
| 1673 | matrixA(ipts,ivm,:,:) = zero |
|---|
| 1674 | matrixV(ipts,ivm,:,:) = zero |
|---|
| 1675 | vectorB(ipts,ivm,:) = zero |
|---|
| 1676 | vectorU(ipts,ivm,:) = zero |
|---|
| 1677 | sugar_load(ipts,ivm) = un |
|---|
| 1678 | circ_class_biomass(ipts,ivm,:,:,:) = zero |
|---|
| 1679 | circ_class_n(ipts,ivm,:) = zero |
|---|
| 1680 | |
|---|
| 1681 | ! Initialize. cn_leaf_min_season is only calculated the |
|---|
| 1682 | ! day AFTER phenology. We need an initial value if we |
|---|
| 1683 | ! want to (re)grow this PFT. |
|---|
| 1684 | cn_leaf_min_season(ipts,ivm) = cn_leaf_init_2D(ipts,ivm) |
|---|
| 1685 | |
|---|
| 1686 | ENDIF ! If this is the youngest age class |
|---|
| 1687 | |
|---|
| 1688 | ENDIF ! If we are using age classes |
|---|
| 1689 | |
|---|
| 1690 | ENDIF ! All biomass in ivm and plant the same species |
|---|
| 1691 | |
|---|
| 1692 | ENDIF ! is_tree |
|---|
| 1693 | |
|---|
| 1694 | ENDDO ! loop over pfts |
|---|
| 1695 | |
|---|
| 1696 | END DO ! loop over land points |
|---|
| 1697 | |
|---|
| 1698 | |
|---|
| 1699 | !! 3. Check numerical consistency of this routine |
|---|
| 1700 | |
|---|
| 1701 | IF (err_act.GT.1) THEN |
|---|
| 1702 | |
|---|
| 1703 | ! 3.2 Check surface area |
|---|
| 1704 | CALL check_vegetation_area("mortality_clean", npts, veget_max_begin, & |
|---|
| 1705 | veget_max,'ageclass') |
|---|
| 1706 | |
|---|
| 1707 | ! 3.3 Mass balance closure |
|---|
| 1708 | ! 3.3.1 Calculate final biomass |
|---|
| 1709 | pool_end(:,:,:) = zero |
|---|
| 1710 | |
|---|
| 1711 | DO iele = 1,nelements |
|---|
| 1712 | DO ipar = 1,nparts |
|---|
| 1713 | DO icir = 1,ncirc |
|---|
| 1714 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 1715 | (circ_class_biomass(:,:,icir,ipar,iele) * & |
|---|
| 1716 | circ_class_n(:,:,icir) * veget_max(:,:)) |
|---|
| 1717 | ENDDO |
|---|
| 1718 | ! bm_to_litter |
|---|
| 1719 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 1720 | bm_to_litter(:,:,ipar,iele) * veget_max(:,:) |
|---|
| 1721 | ENDDO |
|---|
| 1722 | |
|---|
| 1723 | ! Litter pool (gC m-2) * (m2 m-2) |
|---|
| 1724 | DO ilit = 1,nlitt |
|---|
| 1725 | DO ilev = 1,nlevs |
|---|
| 1726 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 1727 | litter(:,ilit,:,ilev,iele) * veget_max(:,:) |
|---|
| 1728 | ENDDO |
|---|
| 1729 | ENDDO |
|---|
| 1730 | |
|---|
| 1731 | IF (ok_soil_carbon_discretization) THEN |
|---|
| 1732 | ! Soil carbon (gC m-3) * (m2 m-2) |
|---|
| 1733 | DO igrn = 1,ngrnd |
|---|
| 1734 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 1735 | (deepSOM_a(:,igrn,:,iele) + deepSOM_s(:,igrn,:,iele) + & |
|---|
| 1736 | deepSOM_p(:,igrn,:,iele)) * veget_max(:,:) |
|---|
| 1737 | END DO |
|---|
| 1738 | ELSE |
|---|
| 1739 | ! Soil carbon (gC m-2) * (m2 m-2) |
|---|
| 1740 | DO icarb = 1,ncarb |
|---|
| 1741 | pool_end(:,:,iele) = pool_end(:,:,iele) + & |
|---|
| 1742 | som(:,icarb,:,iele) * veget_max(:,:) |
|---|
| 1743 | ENDDO |
|---|
| 1744 | ENDIF |
|---|
| 1745 | |
|---|
| 1746 | |
|---|
| 1747 | |
|---|
| 1748 | ENDDO |
|---|
| 1749 | |
|---|
| 1750 | ! Denitrifying bacteria (only C) |
|---|
| 1751 | pool_end(:,:,icarbon) = pool_end(:,:,icarbon) + & |
|---|
| 1752 | bact(:,:) * veget_max(:,:) |
|---|
| 1753 | |
|---|
| 1754 | ! Nitrogen only |
|---|
| 1755 | DO ispec = 1,nnspec |
|---|
| 1756 | pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + & |
|---|
| 1757 | soil_n_min(:,:,ispec) * veget_max(:,:) |
|---|
| 1758 | ENDDO |
|---|
| 1759 | |
|---|
| 1760 | ! 3.3.2 Calculate mass balance |
|---|
| 1761 | ! Common processes |
|---|
| 1762 | DO iele=1,nelements |
|---|
| 1763 | check_intern(:,:,iatm2land,iele) = & |
|---|
| 1764 | check_intern(:,:,iatm2land,iele) + & |
|---|
| 1765 | atm_to_bm(:,:,iele) * veget_max(:,:) |
|---|
| 1766 | check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - & |
|---|
| 1767 | pool_start(:,:,iele)) |
|---|
| 1768 | ENDDO |
|---|
| 1769 | |
|---|
| 1770 | ! Specific fluxes |
|---|
| 1771 | ! The fluxes should not be accounted for here because this |
|---|
| 1772 | ! code deals with mortality. Following mortality the veget_max |
|---|
| 1773 | ! has to be moved to the youngest age class but the fluxes should |
|---|
| 1774 | ! stay in the age class for which they were generated. Clearly, |
|---|
| 1775 | ! closing the mass balance with the fluxes, requires moving |
|---|
| 1776 | ! the fluxes. If done so, the NBP consistency check will fail |
|---|
| 1777 | ! because those fluxes are double counted: once after iage |
|---|
| 1778 | ! in the old age class and once after imor in the youngest |
|---|
| 1779 | ! age class. NThe mass balance is still checked for the pools |
|---|
| 1780 | closure_intern(:,:,:) = zero |
|---|
| 1781 | DO imbc = 1,nmbcomp |
|---|
| 1782 | DO iele=1,nelements |
|---|
| 1783 | ! Debug |
|---|
| 1784 | IF (printlev_loc>=4) WRITE(numout,*) & |
|---|
| 1785 | 'check_intern, ivm, imbc, iele, ', imbc, & |
|---|
| 1786 | iele, check_intern(:,test_pft,imbc,iele) |
|---|
| 1787 | !- |
|---|
| 1788 | closure_intern(:,:,iele) = closure_intern(:,:,iele) + & |
|---|
| 1789 | check_intern(:,:,imbc,iele) |
|---|
| 1790 | ENDDO |
|---|
| 1791 | ENDDO |
|---|
| 1792 | |
|---|
| 1793 | ! 4.3.3 Check mass balance closure |
|---|
| 1794 | CALL check_mass_balance("mortality_clean", closure_intern, npts, & |
|---|
| 1795 | pool_end, pool_start, veget_max, 'ageclass') |
|---|
| 1796 | |
|---|
| 1797 | ENDIF ! err_act.GT.1 |
|---|
| 1798 | |
|---|
| 1799 | IF (printlev.GE.4) WRITE(numout,*) 'Leaving mortality_clean' |
|---|
| 1800 | |
|---|
| 1801 | END SUBROUTINE mortality_clean |
|---|
| 1802 | |
|---|
| 1803 | END MODULE stomate_kill |
|---|
