| 1 | ! ================================================================================================================================= |
|---|
| 2 | ! MODULE : stomate_lcchange |
|---|
| 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 Impact of land cover change on carbon stocks |
|---|
| 10 | !! |
|---|
| 11 | !!\n DESCRIPTION: None |
|---|
| 12 | !! |
|---|
| 13 | !! RECENT CHANGE(S): Including permafrost carbon |
|---|
| 14 | !! |
|---|
| 15 | !! REFERENCE(S) : None |
|---|
| 16 | !! |
|---|
| 17 | !! SVN : |
|---|
| 18 | !! $HeadURL$ |
|---|
| 19 | !! $Date$ |
|---|
| 20 | !! $Revision$ |
|---|
| 21 | !! \n |
|---|
| 22 | !_ ================================================================================================================================ |
|---|
| 23 | |
|---|
| 24 | |
|---|
| 25 | MODULE stomate_lcchange |
|---|
| 26 | |
|---|
| 27 | ! modules used: |
|---|
| 28 | |
|---|
| 29 | USE ioipsl_para |
|---|
| 30 | USE stomate_data |
|---|
| 31 | USE pft_parameters |
|---|
| 32 | USE constantes |
|---|
| 33 | USE constantes_soil_var |
|---|
| 34 | |
|---|
| 35 | IMPLICIT NONE |
|---|
| 36 | |
|---|
| 37 | PRIVATE |
|---|
| 38 | PUBLIC lcchange_main |
|---|
| 39 | PUBLIC lcchange_deffire |
|---|
| 40 | PUBLIC lcchange_main_agripeat |
|---|
| 41 | PUBLIC agripeat_adjust_fractions |
|---|
| 42 | CONTAINS |
|---|
| 43 | |
|---|
| 44 | |
|---|
| 45 | !! ================================================================================================================================ |
|---|
| 46 | !! SUBROUTINE : lcchange_main |
|---|
| 47 | !! |
|---|
| 48 | !>\BRIEF Impact of land cover change on carbon stocks |
|---|
| 49 | !! |
|---|
| 50 | !! DESCRIPTION : This subroutine is always activate if VEGET_UPDATE>0Y in the configuration file, which means that the |
|---|
| 51 | !! vegetation map is updated regulary. lcchange_main is called from stomateLpj the first time step after the vegetation |
|---|
| 52 | !! map has been changed. |
|---|
| 53 | !! The impact of land cover change on carbon stocks is computed in this subroutine. The land cover change is written |
|---|
| 54 | !! by the difference of current and previous "maximal" coverage fraction of a PFT. |
|---|
| 55 | !! On the basis of this difference, the amount of 'new establishment'/'biomass export', |
|---|
| 56 | !! and increase/decrease of each component, are estimated.\n |
|---|
| 57 | !! |
|---|
| 58 | !! Main structure of lpj_establish.f90 is: |
|---|
| 59 | !! 1. Initialization |
|---|
| 60 | !! 2. Calculation of changes in carbon stocks and biomass by land cover change |
|---|
| 61 | !! 3. Update 10 year- and 100 year-turnover pool contents |
|---|
| 62 | !! 4. History |
|---|
| 63 | !! |
|---|
| 64 | !! RECENT CHANGE(S) : None |
|---|
| 65 | !! |
|---|
| 66 | !! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100, |
|---|
| 67 | !! :: cflux_prod10 and :: cflux_prod100 |
|---|
| 68 | !! |
|---|
| 69 | !! REFERENCES : None |
|---|
| 70 | !! |
|---|
| 71 | !! FLOWCHART : |
|---|
| 72 | !! \latexonly |
|---|
| 73 | !! \includegraphics[scale=0.5]{lcchange.png} |
|---|
| 74 | !! \endlatexonly |
|---|
| 75 | !! \n |
|---|
| 76 | !_ ================================================================================================================================ |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | SUBROUTINE lcchange_main ( npts, dt_days, veget_max, veget_max_old, & |
|---|
| 80 | biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, & |
|---|
| 81 | co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, & |
|---|
| 82 | prod10,prod100,& |
|---|
| 83 | convflux,& |
|---|
| 84 | cflux_prod10,cflux_prod100, leaf_frac,& |
|---|
| 85 | npp_longterm, lm_lastyearmax, litter, litter_avail, litter_not_avail, & |
|---|
| 86 | carbon,& |
|---|
| 87 | deepC_a, deepC_s, deepC_p,& |
|---|
| 88 | fuel_1hr,fuel_10hr,fuel_100hr,fuel_1000hr) |
|---|
| 89 | |
|---|
| 90 | IMPLICIT NONE |
|---|
| 91 | |
|---|
| 92 | !! 0. Variable and parameter declaration |
|---|
| 93 | |
|---|
| 94 | !! 0.1 Input variables |
|---|
| 95 | |
|---|
| 96 | INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless) |
|---|
| 97 | REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate |
|---|
| 98 | !! (days) |
|---|
| 99 | REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl !! biomass of sapling |
|---|
| 100 | !! @tex ($gC individual^{-1}$) @endtex |
|---|
| 101 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max !! "maximal" coverage fraction of a PFT (LAI -> |
|---|
| 102 | !! infinity) on ground (unitless) |
|---|
| 103 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old !! previous "maximal" coverage fraction of a PFT (LAI |
|---|
| 104 | !! -> infinity) on ground |
|---|
| 105 | |
|---|
| 106 | !! 0.2 Output variables |
|---|
| 107 | |
|---|
| 108 | REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover |
|---|
| 109 | !! change |
|---|
| 110 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover |
|---|
| 111 | !! pool @tex ($gC m^{-2}$) @endtex |
|---|
| 112 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year- |
|---|
| 113 | !! turnover pool @tex ($gC m^{-2}$) @endtex |
|---|
| 114 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates |
|---|
| 115 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 116 | |
|---|
| 117 | !! 0.3 Modified variables |
|---|
| 118 | |
|---|
| 119 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 120 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex |
|---|
| 121 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years) |
|---|
| 122 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set |
|---|
| 123 | !! to .FALSE. if PFT is introduced or killed |
|---|
| 124 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless) |
|---|
| 125 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very |
|---|
| 126 | !! localized (unitless) |
|---|
| 127 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the |
|---|
| 128 | !! growing season (days) |
|---|
| 129 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken |
|---|
| 130 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 131 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter |
|---|
| 132 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 133 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals |
|---|
| 134 | !! @tex ($m^{2}$) @endtex |
|---|
| 135 | REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover |
|---|
| 136 | !! pool after the annual release for each |
|---|
| 137 | !! compartment (10 + 1 : input from year of land |
|---|
| 138 | !! cover change) |
|---|
| 139 | REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover |
|---|
| 140 | !! pool after the annual release for each |
|---|
| 141 | !! compartment (100 + 1 : input from year of land |
|---|
| 142 | !! cover change) |
|---|
| 143 | REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover |
|---|
| 144 | !! pool compartments |
|---|
| 145 | REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover |
|---|
| 146 | !! pool compartments |
|---|
| 147 | REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class |
|---|
| 148 | !! (unitless) |
|---|
| 149 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT |
|---|
| 150 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 151 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity |
|---|
| 152 | !! @tex ($gC m^{-2} year^{-1}$) @endtex |
|---|
| 153 | REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and |
|---|
| 154 | !! below ground @tex ($gC m^{-2}$) @endtex |
|---|
| 155 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail |
|---|
| 156 | REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail |
|---|
| 157 | REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon !! carbon pool: active, slow, or passive |
|---|
| 158 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 159 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_a !! Permafrost soil carbon (g/m**3) active |
|---|
| 160 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_s !! Permafrost soil carbon (g/m**3) slow |
|---|
| 161 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_p !! Permafrost soil carbon (g/m**3) passive |
|---|
| 162 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1hr |
|---|
| 163 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_10hr |
|---|
| 164 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_100hr |
|---|
| 165 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1000hr |
|---|
| 166 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements) :: fuel_all_type |
|---|
| 167 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements,4) :: fuel_type_frac |
|---|
| 168 | |
|---|
| 169 | !! 0.4 Local variables |
|---|
| 170 | |
|---|
| 171 | INTEGER(i_std) :: i, j, k, l, m !! indices (unitless) |
|---|
| 172 | REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex |
|---|
| 173 | REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex |
|---|
| 174 | REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 175 | REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex |
|---|
| 176 | REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex |
|---|
| 177 | REAL(r_std),DIMENSION(npts,ndeep,ncarb) :: dilu_soil_carbon_vertres !!vertically-resolved Soil Carbondilution (gC/m²) |
|---|
| 178 | |
|---|
| 179 | REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT |
|---|
| 180 | REAL(r_std) :: delta_veg_sum !! sum of delta_veg |
|---|
| 181 | REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals |
|---|
| 182 | !_ ================================================================================================================================ |
|---|
| 183 | |
|---|
| 184 | IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main' |
|---|
| 185 | |
|---|
| 186 | !! 1. initialization |
|---|
| 187 | |
|---|
| 188 | prod10(:,0) = zero |
|---|
| 189 | prod100(:,0) = zero |
|---|
| 190 | above = zero |
|---|
| 191 | convflux(:) = zero |
|---|
| 192 | cflux_prod10(:) = zero |
|---|
| 193 | cflux_prod100(:) = zero |
|---|
| 194 | delta_ind(:,:) = zero |
|---|
| 195 | delta_veg(:) = zero |
|---|
| 196 | dilu_soil_carbon_vertres(:,:,:) = zero |
|---|
| 197 | !! 2. calculation of changes in carbon stocks and biomass by land cover change\n |
|---|
| 198 | |
|---|
| 199 | DO i = 1, npts ! Loop over # pixels - domain size |
|---|
| 200 | |
|---|
| 201 | !! 2.1 initialization of carbon stocks\n |
|---|
| 202 | delta_veg(:) = veget_max(i,:)-veget_max_old(i,:) |
|---|
| 203 | delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.) |
|---|
| 204 | |
|---|
| 205 | dilu_lit(i,:,:,:) = zero |
|---|
| 206 | dilu_soil_carbon(i,:) = zero |
|---|
| 207 | biomass_loss(i,:,:) = zero |
|---|
| 208 | |
|---|
| 209 | !! 2.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n |
|---|
| 210 | DO j=2, nvm |
|---|
| 211 | IF ( delta_veg(j) < -min_stomate ) THEN |
|---|
| 212 | dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum |
|---|
| 213 | biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum |
|---|
| 214 | IF ( ok_pc ) THEN |
|---|
| 215 | dilu_soil_carbon_vertres(i,:,iactive)=dilu_soil_carbon_vertres(i,:,iactive) + & |
|---|
| 216 | delta_veg(j) * deepC_a(i,:,j) / delta_veg_sum |
|---|
| 217 | dilu_soil_carbon_vertres(i,:,islow)=dilu_soil_carbon_vertres(i,:,islow) + & |
|---|
| 218 | delta_veg(j) * deepC_s(i,:,j) / delta_veg_sum |
|---|
| 219 | dilu_soil_carbon_vertres(i,:,ipassive)=dilu_soil_carbon_vertres(i,:,ipassive) + & |
|---|
| 220 | delta_veg(j) * deepC_p(i,:,j) / delta_veg_sum |
|---|
| 221 | ELSE |
|---|
| 222 | dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum |
|---|
| 223 | ENDIF |
|---|
| 224 | ENDIF |
|---|
| 225 | ENDDO |
|---|
| 226 | |
|---|
| 227 | !! 2.3 |
|---|
| 228 | DO j=2, nvm ! Loop over # PFTs |
|---|
| 229 | |
|---|
| 230 | !! 2.3.1 The case that vegetation coverage of PFTj increases |
|---|
| 231 | IF ( delta_veg(j) > min_stomate) THEN |
|---|
| 232 | |
|---|
| 233 | !! 2.3.1.1 Initial setting of new establishment |
|---|
| 234 | IF (veget_max_old(i,j) .LT. min_stomate) THEN |
|---|
| 235 | IF (is_tree(j)) THEN |
|---|
| 236 | |
|---|
| 237 | ! cn_sapl(j)=0.5; stomate_data.f90 |
|---|
| 238 | cn_ind(i,j) = cn_sapl(j) |
|---|
| 239 | ELSE |
|---|
| 240 | cn_ind(i,j) = un |
|---|
| 241 | ENDIF |
|---|
| 242 | ind(i,j)= delta_veg(j) / cn_ind(i,j) |
|---|
| 243 | PFTpresent(i,j) = .TRUE. |
|---|
| 244 | everywhere(i,j) = 1. |
|---|
| 245 | senescence(i,j) = .FALSE. |
|---|
| 246 | age(i,j) = zero |
|---|
| 247 | |
|---|
| 248 | ! large_value = 1.E33_r_std |
|---|
| 249 | when_growthinit(i,j) = large_value |
|---|
| 250 | leaf_frac(i,j,1) = 1.0 |
|---|
| 251 | npp_longterm(i,j) = npp_longterm_init |
|---|
| 252 | lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j) |
|---|
| 253 | ENDIF |
|---|
| 254 | IF ( cn_ind(i,j) > min_stomate ) THEN |
|---|
| 255 | delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) |
|---|
| 256 | ENDIF |
|---|
| 257 | |
|---|
| 258 | !! 2.3.1.2 Update of biomass in each each carbon stock component |
|---|
| 259 | !! Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow, |
|---|
| 260 | !> heartabove, heartbelow, root, fruit, and carbres)\n |
|---|
| 261 | DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 |
|---|
| 262 | DO l = 1,nelements ! loop over # elements |
|---|
| 263 | |
|---|
| 264 | bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l) |
|---|
| 265 | IF (veget_max_old(i,j) .GT. min_stomate) THEN |
|---|
| 266 | |
|---|
| 267 | ! in the case that bm_new is overestimated compared with biomass? |
|---|
| 268 | IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN |
|---|
| 269 | bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j) |
|---|
| 270 | ENDIF |
|---|
| 271 | ENDIF |
|---|
| 272 | biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max_old(i,j) + bm_new(i,l) ) / veget_max(i,j) |
|---|
| 273 | co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max(i,j)) |
|---|
| 274 | END DO ! loop over # elements |
|---|
| 275 | ENDDO ! loop over # carbon stock components |
|---|
| 276 | |
|---|
| 277 | !! 2.3.1.3 Calculation of dilution in litter, soil carbon, and input of litter |
|---|
| 278 | !! In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon |
|---|
| 279 | !! could be shortend?? Are the following formulas correct? |
|---|
| 280 | |
|---|
| 281 | ! Litter |
|---|
| 282 | litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + & |
|---|
| 283 | dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max(i,j) |
|---|
| 284 | !gmjc available and not available litter for grazing |
|---|
| 285 | ! only not available litter increase/decrease, available litter will not |
|---|
| 286 | ! change, due to tree litter can not be eaten |
|---|
| 287 | IF (is_grassland_manag(j) .AND. is_grassland_grazed(j)) THEN |
|---|
| 288 | litter_avail(i,:,j) = litter_avail(i,:,j) * veget_max_old(i,j) / veget_max(i,j) |
|---|
| 289 | litter_not_avail(i,:,j) = litter(i,:,j,iabove,icarbon) - litter_avail(i,:,j) |
|---|
| 290 | ENDIF |
|---|
| 291 | !end gmjc |
|---|
| 292 | IF ( ok_pc ) THEN |
|---|
| 293 | deepC_a(i,:,j)=(deepC_a(i,:,j) * veget_max_old(i,j) + & |
|---|
| 294 | dilu_soil_carbon_vertres(i,:,iactive) * delta_veg(j)) / veget_max(i,j) |
|---|
| 295 | deepC_s(i,:,j)=(deepC_s(i,:,j) * veget_max_old(i,j) + & |
|---|
| 296 | dilu_soil_carbon_vertres(i,:,islow) * delta_veg(j)) / veget_max(i,j) |
|---|
| 297 | deepC_p(i,:,j)=(deepC_p(i,:,j) * veget_max_old(i,j) + & |
|---|
| 298 | dilu_soil_carbon_vertres(i,:,ipassive) * delta_veg(j)) / veget_max(i,j) |
|---|
| 299 | ELSE |
|---|
| 300 | ! Soil carbon |
|---|
| 301 | carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max(i,j) |
|---|
| 302 | ENDIF |
|---|
| 303 | |
|---|
| 304 | DO l = 1,nelements |
|---|
| 305 | |
|---|
| 306 | ! Litter input |
|---|
| 307 | bm_to_litter(i,j,isapbelow,l) = (bm_to_litter(i,j,isapbelow,l)*veget_max_old(i,j) + & |
|---|
| 308 | & biomass_loss(i,isapbelow,l)*delta_veg(j))/ veget_max(i,j) |
|---|
| 309 | bm_to_litter(i,j,iheartbelow,l) = (bm_to_litter(i,j,iheartbelow,l)*veget_max_old(i,j) + & |
|---|
| 310 | biomass_loss(i,iheartbelow,l)*delta_veg(j))/ veget_max(i,j) |
|---|
| 311 | bm_to_litter(i,j,iroot,l) = (bm_to_litter(i,j,iroot,l)*veget_max_old(i,j) + & |
|---|
| 312 | biomass_loss(i,iroot,l)*delta_veg(j))/ veget_max(i,j) |
|---|
| 313 | bm_to_litter(i,j,ifruit,l) = (bm_to_litter(i,j,ifruit,l)*veget_max_old(i,j) + & |
|---|
| 314 | biomass_loss(i,ifruit,l)*delta_veg(j))/ veget_max(i,j) |
|---|
| 315 | bm_to_litter(i,j,icarbres,l) =(bm_to_litter(i,j,icarbres,l)*veget_max_old(i,j) + & |
|---|
| 316 | & biomass_loss(i,icarbres,l)*delta_veg(j)) / veget_max(i,j) |
|---|
| 317 | bm_to_litter(i,j,ileaf,l) = (bm_to_litter(i,j,ileaf,l)*veget_max_old(i,j) + & |
|---|
| 318 | biomass_loss(i,ileaf,l)*delta_veg(j) )/ veget_max(i,j) |
|---|
| 319 | |
|---|
| 320 | END DO |
|---|
| 321 | |
|---|
| 322 | age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max(i,j) |
|---|
| 323 | |
|---|
| 324 | !! 2.3.2 The case that vegetation coverage of PFTj is no change or decreases |
|---|
| 325 | ELSE |
|---|
| 326 | |
|---|
| 327 | !! 2.3.2.1 Biomass export |
|---|
| 328 | ! coeff_lcchange_*: Coeff of biomass export for the year, decade, and century |
|---|
| 329 | above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon) |
|---|
| 330 | convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) ) |
|---|
| 331 | prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) ) |
|---|
| 332 | prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) ) |
|---|
| 333 | |
|---|
| 334 | IF (veget_max(i,j) .LT. min_stomate )THEN |
|---|
| 335 | ind(i,j) = zero |
|---|
| 336 | biomass(i,j,:,:) = zero |
|---|
| 337 | PFTpresent(i,j) = .FALSE. |
|---|
| 338 | senescence(i,j) = .FALSE. |
|---|
| 339 | age(i,j) = zero |
|---|
| 340 | when_growthinit(i,j) = undef |
|---|
| 341 | everywhere(i,j) = zero |
|---|
| 342 | carbon(i,:,j) = zero |
|---|
| 343 | litter(i,:,j,:,:) = zero |
|---|
| 344 | bm_to_litter(i,j,:,:) = zero |
|---|
| 345 | turnover_daily(i,j,:,:) = zero |
|---|
| 346 | IF (ok_pc) THEN |
|---|
| 347 | deepC_a(i,:,j)=zero |
|---|
| 348 | deepC_s(i,:,j)=zero |
|---|
| 349 | deepC_p(i,:,j)=zero |
|---|
| 350 | ENDIF |
|---|
| 351 | ENDIF |
|---|
| 352 | |
|---|
| 353 | ENDIF ! End if PFT's coverage reduction |
|---|
| 354 | |
|---|
| 355 | ENDDO ! Loop over # PFTs |
|---|
| 356 | |
|---|
| 357 | !! 2.4 update 10 year-turnover pool content following flux emission |
|---|
| 358 | !! (linear decay (10%) of the initial carbon input) |
|---|
| 359 | DO l = 0, 8 |
|---|
| 360 | m = 10 - l |
|---|
| 361 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,m) |
|---|
| 362 | prod10(i,m) = prod10(i,m-1) - flux10(i,m-1) |
|---|
| 363 | flux10(i,m) = flux10(i,m-1) |
|---|
| 364 | |
|---|
| 365 | IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero |
|---|
| 366 | ENDDO |
|---|
| 367 | |
|---|
| 368 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) |
|---|
| 369 | flux10(i,1) = 0.1 * prod10(i,0) |
|---|
| 370 | prod10(i,1) = prod10(i,0) |
|---|
| 371 | |
|---|
| 372 | !! 2.5 update 100 year-turnover pool content following flux emission\n |
|---|
| 373 | DO l = 0, 98 |
|---|
| 374 | m = 100 - l |
|---|
| 375 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,m) |
|---|
| 376 | prod100(i,m) = prod100(i,m-1) - flux100(i,m-1) |
|---|
| 377 | flux100(i,m) = flux100(i,m-1) |
|---|
| 378 | |
|---|
| 379 | IF (prod100(i,m).LT.1.0) prod100(i,m) = zero |
|---|
| 380 | ENDDO |
|---|
| 381 | |
|---|
| 382 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,1) |
|---|
| 383 | flux100(i,1) = 0.01 * prod100(i,0) |
|---|
| 384 | prod100(i,1) = prod100(i,0) |
|---|
| 385 | prod10(i,0) = zero |
|---|
| 386 | prod100(i,0) = zero |
|---|
| 387 | |
|---|
| 388 | |
|---|
| 389 | |
|---|
| 390 | ENDDO ! Loop over # pixels - domain size |
|---|
| 391 | |
|---|
| 392 | !! We redistribute the updated litter into four fuel classes, so that |
|---|
| 393 | !! the balance between aboveground litter and fuel is mainted. The subtraction |
|---|
| 394 | !! of fuel burned by land cover change fires from the fuel pool is made here. |
|---|
| 395 | fuel_all_type(:,:,:,:) = fuel_1hr(:,:,:,:) + fuel_10hr(:,:,:,:) + & |
|---|
| 396 | fuel_100hr(:,:,:,:) + fuel_1000hr(:,:,:,:) |
|---|
| 397 | fuel_type_frac(:,:,:,:,:) = 0.25 |
|---|
| 398 | WHERE(fuel_all_type(:,:,:,:) > min_stomate) |
|---|
| 399 | fuel_type_frac(:,:,:,:,1) = fuel_1hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 400 | fuel_type_frac(:,:,:,:,2) = fuel_10hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 401 | fuel_type_frac(:,:,:,:,3) = fuel_100hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 402 | fuel_type_frac(:,:,:,:,4) = fuel_1000hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 403 | ENDWHERE |
|---|
| 404 | DO j=1,nvm |
|---|
| 405 | fuel_1hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,1) |
|---|
| 406 | fuel_10hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,2) |
|---|
| 407 | fuel_100hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,3) |
|---|
| 408 | fuel_1000hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,4) |
|---|
| 409 | END DO |
|---|
| 410 | |
|---|
| 411 | !! 3. history |
|---|
| 412 | convflux = convflux/one_year*dt_days |
|---|
| 413 | cflux_prod10 = cflux_prod10/one_year*dt_days |
|---|
| 414 | cflux_prod100 = cflux_prod100/one_year*dt_days |
|---|
| 415 | |
|---|
| 416 | IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main' |
|---|
| 417 | |
|---|
| 418 | END SUBROUTINE lcchange_main |
|---|
| 419 | |
|---|
| 420 | |
|---|
| 421 | !! The lcchange modelling including consideration of deforestation fires |
|---|
| 422 | SUBROUTINE lcchange_deffire ( npts, dt_days, veget_max, veget_max_new,& |
|---|
| 423 | biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, & |
|---|
| 424 | co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, & |
|---|
| 425 | prod10,prod100,& |
|---|
| 426 | convflux,& |
|---|
| 427 | cflux_prod10,cflux_prod100, leaf_frac,& |
|---|
| 428 | npp_longterm, lm_lastyearmax, litter, litter_avail, litter_not_avail, & |
|---|
| 429 | carbon,& |
|---|
| 430 | deepC_a, deepC_s, deepC_p,& |
|---|
| 431 | fuel_1hr,fuel_10hr,fuel_100hr,fuel_1000hr,& |
|---|
| 432 | lcc,bafrac_deforest_accu,emideforest_litter_accu,emideforest_biomass_accu,& |
|---|
| 433 | deflitsup_total,defbiosup_total) |
|---|
| 434 | |
|---|
| 435 | IMPLICIT NONE |
|---|
| 436 | |
|---|
| 437 | !! 0. Variable and parameter declaration |
|---|
| 438 | |
|---|
| 439 | !! 0.1 Input variables |
|---|
| 440 | |
|---|
| 441 | INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless) |
|---|
| 442 | REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate |
|---|
| 443 | !! (days) |
|---|
| 444 | REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl !! biomass of sapling |
|---|
| 445 | !! @tex ($gC individual^{-1}$) @endtex |
|---|
| 446 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: bafrac_deforest_accu !!cumulative deforestation fire burned fraction, unitless |
|---|
| 447 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in) :: emideforest_litter_accu !!cumulative deforestation fire carbon emissions from litter |
|---|
| 448 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: emideforest_biomass_accu !!cumulative deforestation fire carbon emissions from tree biomass |
|---|
| 449 | REAL(r_std), DIMENSION(npts,nvm),INTENT(in) :: lcc !! land cover change happened at this day |
|---|
| 450 | |
|---|
| 451 | !! 0.2 Output variables |
|---|
| 452 | |
|---|
| 453 | REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover |
|---|
| 454 | !! change |
|---|
| 455 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover |
|---|
| 456 | !! pool @tex ($gC m^{-2}$) @endtex |
|---|
| 457 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year- |
|---|
| 458 | !! turnover pool @tex ($gC m^{-2}$) @endtex |
|---|
| 459 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates |
|---|
| 460 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 461 | |
|---|
| 462 | !! 0.3 Modified variables |
|---|
| 463 | |
|---|
| 464 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max !! "maximal" coverage fraction of a PFT (LAI -> |
|---|
| 465 | !! infinity) on ground (unitless) |
|---|
| 466 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max_new !! new "maximal" coverage fraction of a PFT (LAI |
|---|
| 467 | !! -> infinity) on ground |
|---|
| 468 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 469 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex |
|---|
| 470 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years) |
|---|
| 471 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set |
|---|
| 472 | !! to .FALSE. if PFT is introduced or killed |
|---|
| 473 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless) |
|---|
| 474 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very |
|---|
| 475 | !! localized (unitless) |
|---|
| 476 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the |
|---|
| 477 | !! growing season (days) |
|---|
| 478 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken |
|---|
| 479 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 480 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter |
|---|
| 481 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 482 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals |
|---|
| 483 | !! @tex ($m^{2}$) @endtex |
|---|
| 484 | REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover |
|---|
| 485 | !! pool after the annual release for each |
|---|
| 486 | !! compartment (10 + 1 : input from year of land |
|---|
| 487 | !! cover change) |
|---|
| 488 | REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover |
|---|
| 489 | !! pool after the annual release for each |
|---|
| 490 | !! compartment (100 + 1 : input from year of land |
|---|
| 491 | !! cover change) |
|---|
| 492 | REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover |
|---|
| 493 | !! pool compartments |
|---|
| 494 | REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover |
|---|
| 495 | !! pool compartments |
|---|
| 496 | REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class |
|---|
| 497 | !! (unitless) |
|---|
| 498 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT |
|---|
| 499 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 500 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity |
|---|
| 501 | !! @tex ($gC m^{-2} year^{-1}$) @endtex |
|---|
| 502 | REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and |
|---|
| 503 | !! below ground @tex ($gC m^{-2}$) @endtex |
|---|
| 504 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail |
|---|
| 505 | REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail |
|---|
| 506 | REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon !! carbon pool: active, slow, or passive |
|---|
| 507 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 508 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_a !! Permafrost soil carbon (g/m**3) active |
|---|
| 509 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_s !! Permafrost soil carbon (g/m**3) slow |
|---|
| 510 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_p !! Permafrost soil carbon (g/m**3) passive |
|---|
| 511 | |
|---|
| 512 | REAL(r_std),DIMENSION(npts,nvm), INTENT(inout) :: deflitsup_total |
|---|
| 513 | REAL(r_std),DIMENSION(npts,nvm), INTENT(inout) :: defbiosup_total |
|---|
| 514 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1hr |
|---|
| 515 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_10hr |
|---|
| 516 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_100hr |
|---|
| 517 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1000hr |
|---|
| 518 | |
|---|
| 519 | !! 0.4 Local variables |
|---|
| 520 | |
|---|
| 521 | INTEGER(i_std) :: i, j, k, l, m, ilit, ipart !! indices (unitless) |
|---|
| 522 | REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex |
|---|
| 523 | REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex |
|---|
| 524 | REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 525 | REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex |
|---|
| 526 | REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex |
|---|
| 527 | REAL(r_std),DIMENSION(npts,ndeep,ncarb) :: dilu_soil_carbon_vertres !!vertically-resolved Soil Carbondilution (gC/m²) |
|---|
| 528 | |
|---|
| 529 | REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT |
|---|
| 530 | REAL(r_std) :: delta_veg_sum !! sum of delta_veg |
|---|
| 531 | REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals |
|---|
| 532 | REAL(r_std),DIMENSION(npts,nvm,nlitt) :: deforest_litter_surplus !! Surplus in ground litter for deforested land after |
|---|
| 533 | !! accounting for fire emissions |
|---|
| 534 | REAL(r_std),DIMENSION(npts,nvm,nparts) :: deforest_biomass_surplus !!Surplus in live biomass for deforested forest |
|---|
| 535 | !!after accounting for fire emissions |
|---|
| 536 | REAL(r_std),DIMENSION(npts,nvm,nlitt) :: deforest_litter_deficit |
|---|
| 537 | REAL(r_std),DIMENSION(npts,nvm,nparts) :: deforest_biomass_deficit |
|---|
| 538 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements) :: fuel_all_type |
|---|
| 539 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements,4) :: fuel_type_frac |
|---|
| 540 | |
|---|
| 541 | REAL(r_std),DIMENSION(npts,nvm) :: pool_start_pft !! change in number of individuals |
|---|
| 542 | REAL(r_std),DIMENSION(npts) :: pool_start !! change in number of individuals |
|---|
| 543 | REAL(r_std),DIMENSION(npts,nvm) :: pool_end_pft !! change in number of individuals |
|---|
| 544 | REAL(r_std),DIMENSION(npts) :: pool_end !! change in number of individuals |
|---|
| 545 | REAL(r_std),DIMENSION(npts) :: outflux !! change in number of individuals |
|---|
| 546 | !_ ================================================================================================================================ |
|---|
| 547 | |
|---|
| 548 | |
|---|
| 549 | |
|---|
| 550 | pool_start_pft(:,:) = SUM(biomass(:,:,:,icarbon),DIM=3) & |
|---|
| 551 | + SUM(SUM(litter(:,:,:,:,icarbon),DIM=2),DIM=3) & |
|---|
| 552 | + SUM(carbon(:,:,:),DIM=2) & |
|---|
| 553 | + SUM(bm_to_litter(:,:,:,icarbon),DIM=3) & |
|---|
| 554 | + SUM(turnover_daily(:,:,:,icarbon),DIM=3) |
|---|
| 555 | |
|---|
| 556 | pool_start(:) = SUM(pool_start_pft(:,:)*veget_max(:,:),DIM=2) & |
|---|
| 557 | + SUM(prod10(:,:),DIM=2) + SUM(prod100(:,:),DIM=2) |
|---|
| 558 | |
|---|
| 559 | |
|---|
| 560 | deforest_biomass_surplus(:,:,:) = zero |
|---|
| 561 | deforest_litter_surplus(:,:,:) = zero |
|---|
| 562 | deforest_biomass_deficit(:,:,:) = zero |
|---|
| 563 | deforest_litter_deficit(:,:,:) = zero |
|---|
| 564 | |
|---|
| 565 | IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main' |
|---|
| 566 | |
|---|
| 567 | !! 1. initialization |
|---|
| 568 | |
|---|
| 569 | prod10(:,0) = zero |
|---|
| 570 | prod100(:,0) = zero |
|---|
| 571 | above = zero |
|---|
| 572 | convflux(:) = zero |
|---|
| 573 | cflux_prod10(:) = zero |
|---|
| 574 | cflux_prod100(:) = zero |
|---|
| 575 | delta_ind(:,:) = zero |
|---|
| 576 | delta_veg(:) = zero |
|---|
| 577 | dilu_soil_carbon_vertres(:,:,:) =zero |
|---|
| 578 | !! 2. calculation of changes in carbon stocks and biomass by land cover change\n |
|---|
| 579 | |
|---|
| 580 | DO i = 1, npts ! Loop over # pixels - domain size |
|---|
| 581 | |
|---|
| 582 | !! 2.1 initialization of carbon stocks\n |
|---|
| 583 | delta_veg(:) = veget_max_new(i,:)-veget_max(i,:) |
|---|
| 584 | delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.) !note `delta_veg_sum` is a negative number |
|---|
| 585 | |
|---|
| 586 | dilu_lit(i,:,:,:) = zero |
|---|
| 587 | dilu_soil_carbon(i,:) = zero |
|---|
| 588 | biomass_loss(i,:,:) = zero |
|---|
| 589 | |
|---|
| 590 | !! 2.2 Compute dilution pool of litter, soil carbon, and biomass for |
|---|
| 591 | !! decreasing PFTs. |
|---|
| 592 | DO j=2, nvm |
|---|
| 593 | IF ( delta_veg(j) < -min_stomate ) THEN |
|---|
| 594 | |
|---|
| 595 | ! We make distinction between tree and grass because tree cover reduction might be due to fires. |
|---|
| 596 | ! The litter that is burned in fire should be excluded from diluting litter pool. |
|---|
| 597 | IF (is_tree(j)) THEN |
|---|
| 598 | deforest_litter_surplus(i,j,:) = -1*delta_veg(j)*litter(i,:,j,iabove,icarbon) - emideforest_litter_accu(i,j,:,icarbon) |
|---|
| 599 | |
|---|
| 600 | ! Here we compensate the litter burned by deforestation fire if it's higher than the litter available for |
|---|
| 601 | ! burning. It follows the same logic as biomass which is described below. |
|---|
| 602 | DO ilit = 1,nlitt |
|---|
| 603 | IF (deforest_litter_surplus(i,j,ilit) < zero) THEN |
|---|
| 604 | IF (veget_max_new(i,j) < min_stomate) THEN |
|---|
| 605 | !WRITE (numout,*) 'Cumulative deforestation fire emission exceeds litter for point',i,',PFT ',j, & |
|---|
| 606 | ! 'However the new veget_max is zero, there is not remaining litter to be diluted' |
|---|
| 607 | !STOP |
|---|
| 608 | deforest_litter_deficit(i,j,ilit) = deforest_litter_surplus(i,j,ilit) |
|---|
| 609 | |
|---|
| 610 | ELSE IF (litter(i,ilit,j,iabove,icarbon)*veget_max_new(i,j) < -deforest_litter_surplus(i,j,ilit)) THEN |
|---|
| 611 | !WRITE (numout,*) 'Cumulative deforestation fire emission exceeds litter for point',i,',PFT ',j, & |
|---|
| 612 | ! 'However the remaing litter is not engough for diluting' |
|---|
| 613 | !STOP |
|---|
| 614 | deforest_litter_deficit(i,j,ilit) = deforest_litter_surplus(i,j,ilit) |
|---|
| 615 | ELSE |
|---|
| 616 | litter(i,ilit,j,iabove,icarbon) = ( litter(i,ilit,j,iabove,icarbon)*veget_max_new(i,j) & |
|---|
| 617 | + deforest_litter_surplus(i,j,ilit) )/veget_max_new(i,j) |
|---|
| 618 | END IF |
|---|
| 619 | ELSE |
|---|
| 620 | dilu_lit(i,ilit,iabove,icarbon) = dilu_lit(i,ilit,iabove,icarbon) -1 * deforest_litter_surplus(i,j,ilit) |
|---|
| 621 | END IF |
|---|
| 622 | END DO |
|---|
| 623 | dilu_lit(i,:,ibelow,:) = dilu_lit(i,:,ibelow,:) + delta_veg(j)*litter(i,:,j,ibelow,:) |
|---|
| 624 | ELSE |
|---|
| 625 | dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) |
|---|
| 626 | END IF |
|---|
| 627 | |
|---|
| 628 | IF (is_tree(j)) THEN |
|---|
| 629 | deforest_biomass_surplus(i,j,:) = -1*delta_veg(j)*biomass(i,j,:,icarbon) - emideforest_biomass_accu(i,j,:,icarbon) |
|---|
| 630 | ! Here we check if the biomass burned by deforestation fires is higher than the amount |
|---|
| 631 | ! that could be deforested, if yes, the extra burned biomass is compensated by the biomass |
|---|
| 632 | ! that is not deforested. Here we assume that if this happens for one deforested tree PFT, |
|---|
| 633 | ! it happens for all deforested tree PFTs, so that we don't assume this extra burned biomass |
|---|
| 634 | ! could be compenstated by other tree PFTs. |
|---|
| 635 | DO ipart = 1,nparts |
|---|
| 636 | IF (deforest_biomass_surplus(i,j,ipart) < zero) THEN |
|---|
| 637 | IF (veget_max_new(i,j) < min_stomate) THEN |
|---|
| 638 | !WRITE (numout,*) 'Cumulative deforestation fire emission exceeds biomass for point',i,',PFT ',j, & |
|---|
| 639 | ! 'However the new veget_max is zero, there is not remaining biomass to be diluted' |
|---|
| 640 | !STOP |
|---|
| 641 | deforest_biomass_deficit(i,j,ipart) = deforest_biomass_surplus(i,j,ipart) |
|---|
| 642 | |
|---|
| 643 | ELSE IF (biomass(i,j,ipart,icarbon)*veget_max_new(i,j) < -deforest_biomass_surplus(i,j,ipart)) THEN |
|---|
| 644 | !WRITE (numout,*) 'Cumulative deforestation fire emission exceeds biomass for point',i,',PFT ',j, & |
|---|
| 645 | ! 'However the remaing biomass is not engough for diluting' |
|---|
| 646 | !STOP |
|---|
| 647 | deforest_biomass_deficit(i,j,ipart) = deforest_biomass_surplus(i,j,ipart) |
|---|
| 648 | ELSE |
|---|
| 649 | biomass(i,j,ipart,icarbon) = ( biomass(i,j,ipart,icarbon)*veget_max_new(i,j) & |
|---|
| 650 | + deforest_biomass_surplus(i,j,ipart) )/veget_max_new(i,j) |
|---|
| 651 | END IF |
|---|
| 652 | ELSE |
|---|
| 653 | biomass_loss(i,ipart,icarbon) = biomass_loss(i,ipart,icarbon) -1 * deforest_biomass_surplus(i,j,ipart) |
|---|
| 654 | END IF |
|---|
| 655 | END DO |
|---|
| 656 | ELSE |
|---|
| 657 | biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) |
|---|
| 658 | END IF |
|---|
| 659 | |
|---|
| 660 | !IF (ANY( deforest_biomass_surplus(i,j,:) .LT. 0.0 ) .OR. ANY( deforest_litter_surplus(i,j,:) .LT. 0.0 ) ) THEN |
|---|
| 661 | ! STOP 'Negative biomass or litter surplus' |
|---|
| 662 | !ENDIF |
|---|
| 663 | |
|---|
| 664 | IF ( ok_pc ) THEN |
|---|
| 665 | dilu_soil_carbon_vertres(i,:,iactive)=dilu_soil_carbon_vertres(i,:,iactive) + & |
|---|
| 666 | delta_veg(j) * deepC_a(i,:,j) / delta_veg_sum |
|---|
| 667 | dilu_soil_carbon_vertres(i,:,islow)=dilu_soil_carbon_vertres(i,:,islow) + & |
|---|
| 668 | delta_veg(j) * deepC_s(i,:,j) / delta_veg_sum |
|---|
| 669 | dilu_soil_carbon_vertres(i,:,ipassive)=dilu_soil_carbon_vertres(i,:,ipassive) + & |
|---|
| 670 | delta_veg(j) * deepC_p(i,:,j) / delta_veg_sum |
|---|
| 671 | ELSE |
|---|
| 672 | dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum |
|---|
| 673 | ENDIF |
|---|
| 674 | ENDIF |
|---|
| 675 | ENDDO !nbpts |
|---|
| 676 | |
|---|
| 677 | |
|---|
| 678 | ! Note here `biomass_loss` and `dilu_lit` will change their sign from negative to positive |
|---|
| 679 | IF ( delta_veg_sum < -min_stomate ) THEN |
|---|
| 680 | biomass_loss(i,:,:) = biomass_loss(i,:,:) / delta_veg_sum |
|---|
| 681 | dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) / delta_veg_sum |
|---|
| 682 | END IF |
|---|
| 683 | |
|---|
| 684 | |
|---|
| 685 | !! 2.3 Dilut the litter, soil carbon from decreasing PFTs to increasing ones. |
|---|
| 686 | !! Establish new biomass for increasing PFTs. |
|---|
| 687 | DO j=2, nvm ! Loop over # PFTs |
|---|
| 688 | |
|---|
| 689 | !! 2.3.1 The case that vegetation coverage of PFTj increases |
|---|
| 690 | IF ( delta_veg(j) > min_stomate) THEN |
|---|
| 691 | |
|---|
| 692 | !! 2.3.1.1 The PFTj increased from zero to non-zeor, we have to |
|---|
| 693 | !! initialize it by setting new establishment |
|---|
| 694 | IF (veget_max(i,j) .LT. min_stomate) THEN |
|---|
| 695 | IF (is_tree(j)) THEN |
|---|
| 696 | cn_ind(i,j) = cn_sapl(j) ! cn_sapl(j)=0.5; stomate_data.f90 |
|---|
| 697 | ELSE |
|---|
| 698 | cn_ind(i,j) = un |
|---|
| 699 | ENDIF |
|---|
| 700 | |
|---|
| 701 | ind(i,j)= delta_veg(j) / cn_ind(i,j) |
|---|
| 702 | PFTpresent(i,j) = .TRUE. |
|---|
| 703 | everywhere(i,j) = 1. |
|---|
| 704 | senescence(i,j) = .FALSE. |
|---|
| 705 | age(i,j) = zero |
|---|
| 706 | when_growthinit(i,j) = large_value ! large_value = 1.E33_r_std |
|---|
| 707 | leaf_frac(i,j,1) = 1.0 |
|---|
| 708 | npp_longterm(i,j) = npp_longterm_init |
|---|
| 709 | lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j) |
|---|
| 710 | ENDIF |
|---|
| 711 | |
|---|
| 712 | |
|---|
| 713 | ! Calculate individual density increase because of coverage increase |
|---|
| 714 | IF ( cn_ind(i,j) > min_stomate ) THEN |
|---|
| 715 | delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) |
|---|
| 716 | ENDIF |
|---|
| 717 | !! 2.3.1.2 The increase in `ind` should be companied by increase in |
|---|
| 718 | !! biomass, we do this by assuming increased `ind` are saplings. |
|---|
| 719 | DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 |
|---|
| 720 | DO l = 1,nelements ! loop over # elements |
|---|
| 721 | bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l) |
|---|
| 722 | IF (veget_max(i,j) .GT. min_stomate) THEN |
|---|
| 723 | ! Adjust bm_new equal to existing biomass if it's |
|---|
| 724 | ! larger than the latter |
|---|
| 725 | IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN |
|---|
| 726 | bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j) |
|---|
| 727 | ENDIF |
|---|
| 728 | ENDIF |
|---|
| 729 | biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max(i,j) + bm_new(i,l) ) / veget_max_new(i,j) |
|---|
| 730 | co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max_new(i,j)) |
|---|
| 731 | END DO ! loop over # elements |
|---|
| 732 | ENDDO ! loop over # carbon stock components |
|---|
| 733 | |
|---|
| 734 | !! 2.3.1.3 Tow tasks are done here: |
|---|
| 735 | !! A. We transfer the litter and soil carbon from the |
|---|
| 736 | !! reduced PFTs to the increases PFTs. |
|---|
| 737 | |
|---|
| 738 | ! Litter |
|---|
| 739 | litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max(i,j) + & |
|---|
| 740 | dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max_new(i,j) |
|---|
| 741 | |
|---|
| 742 | !!######################This part needs to be discussed with JinFeng ############ |
|---|
| 743 | !gmjc available and not available litter for grazing |
|---|
| 744 | ! only not available litter increase/decrease, available litter will not |
|---|
| 745 | ! change, due to tree litter can not be eaten |
|---|
| 746 | IF (is_grassland_manag(j) .AND. is_grassland_grazed(j)) THEN |
|---|
| 747 | litter_avail(i,:,j) = litter_avail(i,:,j) * veget_max(i,j) / veget_max_new(i,j) |
|---|
| 748 | litter_not_avail(i,:,j) = litter(i,:,j,iabove,icarbon) - litter_avail(i,:,j) |
|---|
| 749 | ENDIF |
|---|
| 750 | !end gmjc |
|---|
| 751 | !!############################################################################### |
|---|
| 752 | |
|---|
| 753 | ! Soil carbon |
|---|
| 754 | IF ( ok_pc ) THEN |
|---|
| 755 | deepC_a(i,:,j)=(deepC_a(i,:,j) * veget_max(i,j) + & |
|---|
| 756 | dilu_soil_carbon_vertres(i,:,iactive) * delta_veg(j)) / veget_max_new(i,j) |
|---|
| 757 | deepC_s(i,:,j)=(deepC_s(i,:,j) * veget_max(i,j) + & |
|---|
| 758 | dilu_soil_carbon_vertres(i,:,islow) * delta_veg(j)) / veget_max_new(i,j) |
|---|
| 759 | deepC_p(i,:,j)=(deepC_p(i,:,j) * veget_max(i,j) + & |
|---|
| 760 | dilu_soil_carbon_vertres(i,:,ipassive) * delta_veg(j)) / veget_max_new(i,j) |
|---|
| 761 | ELSE |
|---|
| 762 | carbon(i,:,j)=(carbon(i,:,j) * veget_max(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_new(i,j) |
|---|
| 763 | ENDIF |
|---|
| 764 | |
|---|
| 765 | !! B. For the biomass pool of reducing PFTs, we cannot transfer them directly to the |
|---|
| 766 | !! increasing PFTs, because the latter ones are treated with new sapling estalishement |
|---|
| 767 | !! in section 2.3.1.2. So we assume the non-harvestable biomass of reducing PFTs will |
|---|
| 768 | !! go to litter pool via `bm_to_litter`, and these are further directly transferred to |
|---|
| 769 | !! the increasing PFTs. |
|---|
| 770 | !! |
|---|
| 771 | !! The non-harvestable parts are: isapbelow,iheartbelow,iroot,icarbres,ileaf,ifruit |
|---|
| 772 | !! Note that the icarbres,ileaf,ifruit could be burned in deforestation fires, the |
|---|
| 773 | !! emissions from these parts are already subtracted from `biomass_loss`, as done |
|---|
| 774 | !! in section 2.2. The harvestable biomass parts go to harvest pool and this will done |
|---|
| 775 | !! in the section for the reducing PFTs. |
|---|
| 776 | DO l = 1,nelements |
|---|
| 777 | |
|---|
| 778 | bm_to_litter(i,j,isapbelow,l) = bm_to_litter(i,j,isapbelow,l) + & |
|---|
| 779 | & biomass_loss(i,isapbelow,l)*delta_veg(j) / veget_max_new(i,j) |
|---|
| 780 | bm_to_litter(i,j,iheartbelow,l) = bm_to_litter(i,j,iheartbelow,l) + biomass_loss(i,iheartbelow,l) *delta_veg(j) & |
|---|
| 781 | & / veget_max_new(i,j) |
|---|
| 782 | bm_to_litter(i,j,iroot,l) = bm_to_litter(i,j,iroot,l) + biomass_loss(i,iroot,l)*delta_veg(j) / veget_max_new(i,j) |
|---|
| 783 | bm_to_litter(i,j,ifruit,l) = bm_to_litter(i,j,ifruit,l) + biomass_loss(i,ifruit,l)*delta_veg(j) / veget_max_new(i,j) |
|---|
| 784 | bm_to_litter(i,j,icarbres,l) = bm_to_litter(i,j,icarbres,l) + & |
|---|
| 785 | & biomass_loss(i,icarbres,l) *delta_veg(j) / veget_max_new(i,j) |
|---|
| 786 | bm_to_litter(i,j,ileaf,l) = bm_to_litter(i,j,ileaf,l) + biomass_loss(i,ileaf,l)*delta_veg(j) / veget_max_new(i,j) |
|---|
| 787 | END DO |
|---|
| 788 | |
|---|
| 789 | age(i,j)=age(i,j)*veget_max(i,j)/veget_max_new(i,j) |
|---|
| 790 | |
|---|
| 791 | !! 2.3.2 The case that vegetation coverage of PFTj has no change or decreases. |
|---|
| 792 | ELSE |
|---|
| 793 | |
|---|
| 794 | !! 2.3.2.1 Complete disappearing of PFTj, i.e., changes from non-zero |
|---|
| 795 | !! to zero. |
|---|
| 796 | IF ( veget_max_new(i,j) .LT. min_stomate ) THEN |
|---|
| 797 | veget_max_new(i,j)= zero |
|---|
| 798 | ind(i,j) = zero |
|---|
| 799 | biomass(i,j,:,:) = zero |
|---|
| 800 | PFTpresent(i,j) = .FALSE. |
|---|
| 801 | senescence(i,j) = .FALSE. |
|---|
| 802 | age(i,j) = zero |
|---|
| 803 | when_growthinit(i,j) = undef |
|---|
| 804 | everywhere(i,j) = zero |
|---|
| 805 | carbon(i,:,j) = zero |
|---|
| 806 | litter(i,:,j,:,:) = zero |
|---|
| 807 | litter_avail(i,:,j) = zero |
|---|
| 808 | litter_not_avail(i,:,j) = zero |
|---|
| 809 | bm_to_litter(i,j,:,:) = zero |
|---|
| 810 | turnover_daily(i,j,:,:) = zero |
|---|
| 811 | deepC_a(i,:,j) = zero |
|---|
| 812 | deepC_s(i,:,j) = zero |
|---|
| 813 | deepC_p(i,:,j) = zero |
|---|
| 814 | ENDIF |
|---|
| 815 | ENDIF ! The end the two cases: PFT-coverage reduction versus |
|---|
| 816 | ! non-change-or-increase |
|---|
| 817 | ENDDO ! 2.3 Loop over # PFTs |
|---|
| 818 | |
|---|
| 819 | !! 2.4 Biomass harvest and turnover of different harvest pools |
|---|
| 820 | |
|---|
| 821 | !!?? Here we have some problem regarding grassland/cropland area dereasing, |
|---|
| 822 | !!?? Because their sapwood/heartwood aboveground are also treated as |
|---|
| 823 | !!?? wood products. |
|---|
| 824 | |
|---|
| 825 | !! 2.4.1 We have already deforestation fire fluxes from sapwood/hearwood aboveground, |
|---|
| 826 | !! now we just assume the remaining unburned parts are harvested, as 10-year and |
|---|
| 827 | !! 100-year product pool. |
|---|
| 828 | |
|---|
| 829 | print *,'delta_veg_sum',delta_veg_sum |
|---|
| 830 | print *,'prod10_in_lcc_before_assign',prod10(:,:) |
|---|
| 831 | print *,'biomass_loss',biomass_loss(:,:,:) |
|---|
| 832 | ! Note before we divide biomass_loss by `delta_veg_sum` to convert it based on PFT area, |
|---|
| 833 | ! Now we multiply it again by `delta_veg_sum` to convert it back based on grid cell area. |
|---|
| 834 | ! Also note `delta_veg_sum` is negative, so we should multiply again by (-1) |
|---|
| 835 | above = (biomass_loss(i,isapabove,icarbon) + biomass_loss(i,iheartabove,icarbon))*delta_veg_sum*(-1) |
|---|
| 836 | convflux(i) = SUM(emideforest_biomass_accu(i,:,isapabove,icarbon)+emideforest_biomass_accu(i,:,iheartabove,icarbon)) |
|---|
| 837 | prod10(i,0) = 0.4* above |
|---|
| 838 | prod100(i,0) = 0.6 * above |
|---|
| 839 | print *,'above_in_lcc_before_assign',above |
|---|
| 840 | |
|---|
| 841 | !! 2.4.2 update 10 year-turnover pool content following flux emission |
|---|
| 842 | !! (linear decay (10%) of the initial carbon input) |
|---|
| 843 | DO l = 0, 8 |
|---|
| 844 | m = 10 - l |
|---|
| 845 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,m) |
|---|
| 846 | prod10(i,m) = prod10(i,m-1) - flux10(i,m-1) |
|---|
| 847 | flux10(i,m) = flux10(i,m-1) |
|---|
| 848 | IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero |
|---|
| 849 | ENDDO |
|---|
| 850 | |
|---|
| 851 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) |
|---|
| 852 | flux10(i,1) = 0.1 * prod10(i,0) |
|---|
| 853 | prod10(i,1) = prod10(i,0) |
|---|
| 854 | |
|---|
| 855 | !! 2.4.3 update 100 year-turnover pool content following flux emission\n |
|---|
| 856 | DO l = 0, 98 |
|---|
| 857 | m = 100 - l |
|---|
| 858 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,m) |
|---|
| 859 | prod100(i,m) = prod100(i,m-1) - flux100(i,m-1) |
|---|
| 860 | flux100(i,m) = flux100(i,m-1) |
|---|
| 861 | |
|---|
| 862 | IF (prod100(i,m).LT.1.0) prod100(i,m) = zero |
|---|
| 863 | ENDDO |
|---|
| 864 | |
|---|
| 865 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,1) |
|---|
| 866 | flux100(i,1) = 0.01 * prod100(i,0) |
|---|
| 867 | prod100(i,1) = prod100(i,0) |
|---|
| 868 | prod10(i,0) = zero |
|---|
| 869 | prod100(i,0) = zero |
|---|
| 870 | |
|---|
| 871 | ENDDO ! Loop over # pixels - domain size |
|---|
| 872 | print *,'prod10_in_lcc_after_assign',prod10(:,:) |
|---|
| 873 | |
|---|
| 874 | !!Jinfeng's grassland management module might should also be put here. |
|---|
| 875 | |
|---|
| 876 | !! We redistribute the updated litter into four fuel classes, so that |
|---|
| 877 | !! the balance between aboveground litter and fuel is mainted. The subtraction |
|---|
| 878 | !! of fuel burned by land cover change fires from the fuel pool is made here. |
|---|
| 879 | fuel_all_type(:,:,:,:) = fuel_1hr(:,:,:,:) + fuel_10hr(:,:,:,:) + & |
|---|
| 880 | fuel_100hr(:,:,:,:) + fuel_1000hr(:,:,:,:) |
|---|
| 881 | fuel_type_frac(:,:,:,:,:) = 0.25 |
|---|
| 882 | WHERE(fuel_all_type(:,:,:,:) > min_stomate) |
|---|
| 883 | fuel_type_frac(:,:,:,:,1) = fuel_1hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 884 | fuel_type_frac(:,:,:,:,2) = fuel_10hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 885 | fuel_type_frac(:,:,:,:,3) = fuel_100hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 886 | fuel_type_frac(:,:,:,:,4) = fuel_1000hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 887 | ENDWHERE |
|---|
| 888 | DO j=1,nvm |
|---|
| 889 | fuel_1hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,1) |
|---|
| 890 | fuel_10hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,2) |
|---|
| 891 | fuel_100hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,3) |
|---|
| 892 | fuel_1000hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,4) |
|---|
| 893 | END DO |
|---|
| 894 | |
|---|
| 895 | !! 3. history |
|---|
| 896 | |
|---|
| 897 | veget_max(:,:) = veget_max_new(:,:) |
|---|
| 898 | convflux = convflux/one_year*dt_days |
|---|
| 899 | cflux_prod10 = cflux_prod10/one_year*dt_days |
|---|
| 900 | cflux_prod100 = cflux_prod100/one_year*dt_days |
|---|
| 901 | |
|---|
| 902 | |
|---|
| 903 | pool_end_pft(:,:) = SUM(biomass(:,:,:,icarbon),DIM=3) & |
|---|
| 904 | + SUM(SUM(litter(:,:,:,:,icarbon),DIM=2),DIM=3) & |
|---|
| 905 | + SUM(carbon(:,:,:),DIM=2) & |
|---|
| 906 | + SUM(bm_to_litter(:,:,:,icarbon),DIM=3) & |
|---|
| 907 | + SUM(turnover_daily(:,:,:,icarbon),DIM=3) |
|---|
| 908 | |
|---|
| 909 | pool_end(:) = SUM(pool_end_pft(:,:)*veget_max(:,:),DIM=2) & |
|---|
| 910 | + SUM(prod10(:,:),DIM=2) + SUM(prod100(:,:),DIM=2) |
|---|
| 911 | |
|---|
| 912 | |
|---|
| 913 | outflux(:) = SUM(SUM(emideforest_biomass_accu(:,:,:,icarbon),DIM=3),DIM=2) & |
|---|
| 914 | + SUM(SUM(emideforest_litter_accu(:,:,:,icarbon),DIM=3),DIM=2) & |
|---|
| 915 | + SUM(flux10(:,:),DIM=2) + SUM(flux100,DIM=2) & |
|---|
| 916 | - SUM(co2_to_bm(:,:)*veget_max(:,:),DIM=2) |
|---|
| 917 | |
|---|
| 918 | print *,"pool_start: ",pool_start(:) |
|---|
| 919 | print *,"pool_end: ",pool_end(:) |
|---|
| 920 | print *,"outflux: ",outflux(:) |
|---|
| 921 | print *,"pool_change: ",pool_start(:)-pool_end(:) |
|---|
| 922 | print *,'prod10_end_lcc',prod10(:,:) |
|---|
| 923 | |
|---|
| 924 | deflitsup_total(:,:) = SUM(deforest_litter_surplus(:,:,:),dim=3) |
|---|
| 925 | defbiosup_total(:,:) = SUM(deforest_biomass_surplus(:,:,:),dim=3) |
|---|
| 926 | |
|---|
| 927 | CALL histwrite (hist_id_stomate, 'dilu_lit_met', itime, & |
|---|
| 928 | dilu_lit(:,imetabolic,iabove,icarbon), npts, hori_index) |
|---|
| 929 | CALL histwrite (hist_id_stomate, 'dilu_lit_str', itime, & |
|---|
| 930 | dilu_lit(:,istructural,iabove,icarbon), npts, hori_index) |
|---|
| 931 | |
|---|
| 932 | |
|---|
| 933 | CALL histwrite (hist_id_stomate, 'SurpBioLEAF', itime, & |
|---|
| 934 | deforest_biomass_surplus(:,:,ileaf), npts*nvm, horipft_index) |
|---|
| 935 | CALL histwrite (hist_id_stomate, 'SurpBioRESERVE', itime, & |
|---|
| 936 | deforest_biomass_surplus(:,:,icarbres), npts*nvm, horipft_index) |
|---|
| 937 | CALL histwrite (hist_id_stomate, 'SurpBioFRUIT', itime, & |
|---|
| 938 | deforest_biomass_surplus(:,:,ifruit), npts*nvm, horipft_index) |
|---|
| 939 | CALL histwrite (hist_id_stomate, 'SurpBioSapABOVE', itime, & |
|---|
| 940 | deforest_biomass_surplus(:,:,isapabove), npts*nvm, horipft_index) |
|---|
| 941 | CALL histwrite (hist_id_stomate, 'SurpBioHeartABOVE', itime, & |
|---|
| 942 | deforest_biomass_surplus(:,:,iheartabove), npts*nvm, horipft_index) |
|---|
| 943 | CALL histwrite (hist_id_stomate, 'SurpBioSapBELOW', itime, & |
|---|
| 944 | deforest_biomass_surplus(:,:,isapbelow), npts*nvm, horipft_index) |
|---|
| 945 | CALL histwrite (hist_id_stomate, 'SurpBioHeartBELOW', itime, & |
|---|
| 946 | deforest_biomass_surplus(:,:,iheartbelow), npts*nvm, horipft_index) |
|---|
| 947 | CALL histwrite (hist_id_stomate, 'SurpBioROOT', itime, & |
|---|
| 948 | deforest_biomass_surplus(:,:,iroot), npts*nvm, horipft_index) |
|---|
| 949 | CALL histwrite (hist_id_stomate, 'SurpLitMET', itime, & |
|---|
| 950 | deforest_litter_surplus(:,:,imetabolic), npts*nvm, horipft_index) |
|---|
| 951 | CALL histwrite (hist_id_stomate, 'SurpLitSTR', itime, & |
|---|
| 952 | deforest_litter_surplus(:,:,istructural), npts*nvm, horipft_index) |
|---|
| 953 | |
|---|
| 954 | CALL histwrite (hist_id_stomate, 'DefiBioLEAF', itime, & |
|---|
| 955 | deforest_biomass_deficit(:,:,ileaf), npts*nvm, horipft_index) |
|---|
| 956 | CALL histwrite (hist_id_stomate, 'DefiBioRESERVE', itime, & |
|---|
| 957 | deforest_biomass_deficit(:,:,icarbres), npts*nvm, horipft_index) |
|---|
| 958 | CALL histwrite (hist_id_stomate, 'DefiBioFRUIT', itime, & |
|---|
| 959 | deforest_biomass_deficit(:,:,ifruit), npts*nvm, horipft_index) |
|---|
| 960 | CALL histwrite (hist_id_stomate, 'DefiBioSapABOVE', itime, & |
|---|
| 961 | deforest_biomass_deficit(:,:,isapabove), npts*nvm, horipft_index) |
|---|
| 962 | CALL histwrite (hist_id_stomate, 'DefiBioHeartABOVE', itime, & |
|---|
| 963 | deforest_biomass_deficit(:,:,iheartabove), npts*nvm, horipft_index) |
|---|
| 964 | CALL histwrite (hist_id_stomate, 'DefiBioSapBELOW', itime, & |
|---|
| 965 | deforest_biomass_deficit(:,:,isapbelow), npts*nvm, horipft_index) |
|---|
| 966 | CALL histwrite (hist_id_stomate, 'DefiBioHeartBELOW', itime, & |
|---|
| 967 | deforest_biomass_deficit(:,:,iheartbelow), npts*nvm, horipft_index) |
|---|
| 968 | CALL histwrite (hist_id_stomate, 'DefiBioROOT', itime, & |
|---|
| 969 | deforest_biomass_deficit(:,:,iroot), npts*nvm, horipft_index) |
|---|
| 970 | CALL histwrite (hist_id_stomate, 'DefiLitMET', itime, & |
|---|
| 971 | deforest_litter_deficit(:,:,imetabolic), npts*nvm, horipft_index) |
|---|
| 972 | CALL histwrite (hist_id_stomate, 'DefiLitSTR', itime, & |
|---|
| 973 | deforest_litter_deficit(:,:,istructural), npts*nvm, horipft_index) |
|---|
| 974 | |
|---|
| 975 | |
|---|
| 976 | IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main' |
|---|
| 977 | |
|---|
| 978 | END SUBROUTINE lcchange_deffire |
|---|
| 979 | |
|---|
| 980 | |
|---|
| 981 | !SUBROUTINE lcc_neighbour_shift(ipts,neighbours,veget_max,lcc,veget_max_new) |
|---|
| 982 | ! INTEGER(i_std), DIMENSION(npts,8), INTENT(in) :: neighbours !! indices of the 8 neighbours of each grid point |
|---|
| 983 | ! !! (unitless); |
|---|
| 984 | ! !! [1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW] |
|---|
| 985 | |
|---|
| 986 | |
|---|
| 987 | !END SUBROUTINE lcc_neighbour_shift |
|---|
| 988 | |
|---|
| 989 | !print *,'end_biomass',SUM(SUM(biomass(:,:,:,icarbon),DIM=3)*veget_max(:,:),DIM=2) |
|---|
| 990 | !print *,'end_litter',SUM(SUM(SUM(litter(:,:,:,:,icarbon),DIM=2),DIM=3)*veget_max(:,:),DIM=2) |
|---|
| 991 | !print *, 'end_soil',SUM(SUM(carbon(:,:,:),DIM=2)*veget_max(:,:),DIM=2) |
|---|
| 992 | !print *,'end_bm2lit',sum(SUM(bm_to_litter(:,:,:,icarbon),DIM=3)*veget_max(:,:),dim=2) |
|---|
| 993 | !print *,'end_turnover',sum(SUM(turnover_daily(:,:,:,icarbon),DIM=3)*veget_max(:,:),dim=2) |
|---|
| 994 | !print *,'end_prod10', SUM(prod10(:,:),DIM=2) |
|---|
| 995 | !print *,'end_prod100',SUM(prod100(:,:),DIM=2) |
|---|
| 996 | |
|---|
| 997 | ! !!block to check |
|---|
| 998 | ! pool_end_pft(:,:) = SUM(biomass(:,:,:,icarbon),DIM=3) & |
|---|
| 999 | ! + SUM(SUM(litter(:,:,:,:,icarbon),DIM=2),DIM=3) & |
|---|
| 1000 | ! + SUM(carbon(:,:,:),DIM=2) & |
|---|
| 1001 | ! + SUM(bm_to_litter(:,:,:,icarbon),DIM=3) & |
|---|
| 1002 | ! + SUM(turnover_daily(:,:,:,icarbon),DIM=3) |
|---|
| 1003 | ! |
|---|
| 1004 | ! pool_end(:) = SUM(pool_end_pft(:,:)*veget_max(:,:),DIM=2) & |
|---|
| 1005 | ! + SUM(prod10(:,:),DIM=2) + SUM(prod100(:,:),DIM=2) |
|---|
| 1006 | ! |
|---|
| 1007 | ! outflux(:) = SUM(SUM(emideforest_biomass_accu(:,:,:,icarbon),DIM=3),DIM=2) & |
|---|
| 1008 | ! + SUM(SUM(emideforest_litter_accu(:,:,:,icarbon),DIM=3),DIM=2) & |
|---|
| 1009 | ! + SUM(flux10(:,:),DIM=2) + SUM(flux100,DIM=2) & |
|---|
| 1010 | ! - SUM(co2_to_bm(:,:)*veget_max(:,:),DIM=2) |
|---|
| 1011 | ! |
|---|
| 1012 | ! print *,"pool_start: ",pool_start(:) |
|---|
| 1013 | ! print *,"pool_end: ",pool_end(:) |
|---|
| 1014 | ! print *,"outflux: ",outflux(:) |
|---|
| 1015 | ! print *,"pool_change: ",pool_start(:)-pool_end(:) |
|---|
| 1016 | ! !!end block to check |
|---|
| 1017 | |
|---|
| 1018 | |
|---|
| 1019 | !! ================================================================================================================================ |
|---|
| 1020 | !! SUBROUTINE : lcchange_main_agripeat |
|---|
| 1021 | !! |
|---|
| 1022 | !>\BRIEF Impact of land cover change on carbon stocks, when peatland modules are activated |
|---|
| 1023 | !! |
|---|
| 1024 | !! DESCRIPTION : This subroutine is activate if DGVM=T during spinups, and then during historical simulations VEGET_UPDATE>0Y and AGRI_PEAT=True |
|---|
| 1025 | !! lcchange_main_agripeat is called from stomateLpj the first time step after the vegetation map has been changed. |
|---|
| 1026 | !! After the vegetation map has been read, natural peatland area occupy each PFT in proportion to grid cell area of the PFT. |
|---|
| 1027 | !! Crops occupied by peatland become new PFTs (PFT15, PFT16) (CALL SUBROUTINE agripeat_adjust_fractions). |
|---|
| 1028 | !! The impact of land cover change on carbon stocks is computed in this subroutine. |
|---|
| 1029 | !! On the basis of this difference, the amount of 'new establishment'/'biomass export',and increase/decrease of each component, are estimated. |
|---|
| 1030 | !! |
|---|
| 1031 | !_ ================================================================================================================================ |
|---|
| 1032 | SUBROUTINE lcchange_main_agripeat ( npts, dt_days, veget_max, veget_max_old, & |
|---|
| 1033 | biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, & |
|---|
| 1034 | co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, & |
|---|
| 1035 | prod10,prod100,& |
|---|
| 1036 | convflux,& |
|---|
| 1037 | cflux_prod10,cflux_prod100, leaf_frac,& |
|---|
| 1038 | npp_longterm, lm_lastyearmax, litter, litter_avail, litter_not_avail, & |
|---|
| 1039 | carbon,& |
|---|
| 1040 | deepC_a, deepC_s, deepC_p,& |
|---|
| 1041 | fuel_1hr,fuel_10hr,fuel_100hr,fuel_1000hr, & |
|---|
| 1042 | veget_max_adjusted,lalo,carbon_save,deepC_a_save,deepC_s_save,deepC_p_save,delta_fsave,biomass_remove) |
|---|
| 1043 | |
|---|
| 1044 | IMPLICIT NONE |
|---|
| 1045 | |
|---|
| 1046 | !! 0. Variable and parameter declaration |
|---|
| 1047 | |
|---|
| 1048 | !! 0.1 Input variables |
|---|
| 1049 | |
|---|
| 1050 | INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless) |
|---|
| 1051 | REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate |
|---|
| 1052 | !! (days) |
|---|
| 1053 | REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl !! biomass of sapling |
|---|
| 1054 | !! @tex ($gC individual^{-1}$) @endtex |
|---|
| 1055 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max !! "maximal" coverage fraction of a PFT (LAI -> |
|---|
| 1056 | !! infinity) on ground (unitless) |
|---|
| 1057 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old !! previous "maximal" coverage fraction of a PFT (LAI |
|---|
| 1058 | !! -> infinity) on ground |
|---|
| 1059 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo |
|---|
| 1060 | !! 0.2 Output variables |
|---|
| 1061 | |
|---|
| 1062 | REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover |
|---|
| 1063 | !! change |
|---|
| 1064 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover |
|---|
| 1065 | !! pool @tex ($gC m^{-2}$) @endtex |
|---|
| 1066 | REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year- |
|---|
| 1067 | !! turnover pool @tex ($gC m^{-2}$) @endtex |
|---|
| 1068 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates |
|---|
| 1069 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 1070 | REAL(r_std), DIMENSION(npts,nvm),INTENT(out) :: veget_max_adjusted !! fraction of vegetation after adjustment |
|---|
| 1071 | |
|---|
| 1072 | |
|---|
| 1073 | !! 0.3 Modified variables |
|---|
| 1074 | |
|---|
| 1075 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 1076 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex |
|---|
| 1077 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years) |
|---|
| 1078 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set |
|---|
| 1079 | !! to .FALSE. if PFT is introduced or killed |
|---|
| 1080 | LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless) |
|---|
| 1081 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very |
|---|
| 1082 | !! localized (unitless) |
|---|
| 1083 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the |
|---|
| 1084 | !! growing season (days) |
|---|
| 1085 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken |
|---|
| 1086 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 1087 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter |
|---|
| 1088 | !! @tex ($gC m^{-2} day^{-1}$) @endtex |
|---|
| 1089 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals |
|---|
| 1090 | !! @tex ($m^{2}$) @endtex |
|---|
| 1091 | REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover |
|---|
| 1092 | !! pool after the annual release for each |
|---|
| 1093 | !! compartment (10 + 1 : input from year of land |
|---|
| 1094 | !! cover change) |
|---|
| 1095 | REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover |
|---|
| 1096 | !! pool after the annual release for each |
|---|
| 1097 | !! compartment (100 + 1 : input from year of land |
|---|
| 1098 | !! cover change) |
|---|
| 1099 | REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover |
|---|
| 1100 | !! pool compartments |
|---|
| 1101 | REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover |
|---|
| 1102 | !! pool compartments |
|---|
| 1103 | REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class |
|---|
| 1104 | !! (unitless) |
|---|
| 1105 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT |
|---|
| 1106 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 1107 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity |
|---|
| 1108 | !! @tex ($gC m^{-2} year^{-1}$) @endtex |
|---|
| 1109 | REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and |
|---|
| 1110 | !! below ground @tex ($gC m^{-2}$) @endtex |
|---|
| 1111 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail |
|---|
| 1112 | REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail |
|---|
| 1113 | REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon !! carbon pool: active, slow, or passive |
|---|
| 1114 | !! @tex ($gC m^{-2}$) @endtex |
|---|
| 1115 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_a !! Permafrost soil carbon (g/m**3) active |
|---|
| 1116 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_s !! Permafrost soil carbon (g/m**3) slow |
|---|
| 1117 | REAL(r_std), DIMENSION(npts,ndeep,nvm), INTENT(inout) :: deepC_p !! Permafrost soil carbon (g/m**3) passive |
|---|
| 1118 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1hr |
|---|
| 1119 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_10hr |
|---|
| 1120 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_100hr |
|---|
| 1121 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements),INTENT(inout) :: fuel_1000hr |
|---|
| 1122 | REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon_save |
|---|
| 1123 | REAL(r_std), DIMENSION(npts,ndeep), INTENT(inout) :: deepC_a_save |
|---|
| 1124 | REAL(r_std), DIMENSION(npts,ndeep), INTENT(inout) :: deepC_s_save |
|---|
| 1125 | REAL(r_std), DIMENSION(npts,ndeep), INTENT(inout) :: deepC_p_save |
|---|
| 1126 | REAL(r_std), DIMENSION(npts), INTENT(inout) :: delta_fsave |
|---|
| 1127 | REAL(r_std),DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: biomass_remove |
|---|
| 1128 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements) :: fuel_all_type |
|---|
| 1129 | REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements,4) :: fuel_type_frac |
|---|
| 1130 | |
|---|
| 1131 | !! 0.4 Local variables |
|---|
| 1132 | |
|---|
| 1133 | INTEGER(i_std) :: i, j, k, l, m,n !! indices (unitless) |
|---|
| 1134 | REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex |
|---|
| 1135 | REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex |
|---|
| 1136 | REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss_peat |
|---|
| 1137 | REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex |
|---|
| 1138 | REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex |
|---|
| 1139 | REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit_peat |
|---|
| 1140 | REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex |
|---|
| 1141 | REAL(r_std),DIMENSION(npts,ndeep,ncarb) :: dilu_soil_carbon_vertres !!vertically-resolved Soil Carbondilution (gC/m²) |
|---|
| 1142 | REAL(r_std),DIMENSION(npts) :: delta_nat_peat |
|---|
| 1143 | REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT |
|---|
| 1144 | REAL(r_std) :: delta_veg_sum !! sum of delta_veg, vegetations |
|---|
| 1145 | REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals |
|---|
| 1146 | REAL(r_std), DIMENSION(npts) :: soilc_before |
|---|
| 1147 | REAL(r_std), DIMENSION(npts) :: soilc_after |
|---|
| 1148 | REAL(r_std), DIMENSION(npts,ndeep) :: delta_a !! Permafrost soil carbon (g/m**3) active |
|---|
| 1149 | REAL(r_std), DIMENSION(npts,ndeep) :: delta_s !! Permafrost soil carbon (g/m**3) slow |
|---|
| 1150 | REAL(r_std), DIMENSION(npts,ndeep) :: delta_p !! |
|---|
| 1151 | REAL(r_std),DIMENSION(npts,ncarb) :: delta_carbon |
|---|
| 1152 | !_ ================================================================================================================================ |
|---|
| 1153 | |
|---|
| 1154 | IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main_agripeat' |
|---|
| 1155 | !WRITE(numout,*) 'chunjing Entering lcchange_main_agripeat' |
|---|
| 1156 | ! DO i=1,npts |
|---|
| 1157 | ! WRITE (numout,*) 'qcj check before call agripeat_adjust_fractions, veget_max_new',veget_max(i,:) |
|---|
| 1158 | ! ENDDO |
|---|
| 1159 | |
|---|
| 1160 | soilc_before(:)=zero |
|---|
| 1161 | soilc_after(:)=zero |
|---|
| 1162 | |
|---|
| 1163 | DO i=1, npts |
|---|
| 1164 | DO j=1,nvm |
|---|
| 1165 | DO l=1,ncarb |
|---|
| 1166 | soilc_before(i)=soilc_before(i)+carbon(i,l,j)*veget_max_old(i,j) |
|---|
| 1167 | ENDDO |
|---|
| 1168 | ENDDO |
|---|
| 1169 | ENDDO |
|---|
| 1170 | |
|---|
| 1171 | CALL agripeat_adjust_fractions (npts, lalo,veget_max, veget_max_old, veget_max_adjusted) |
|---|
| 1172 | !! 1. initialization |
|---|
| 1173 | |
|---|
| 1174 | prod10(:,0) = zero |
|---|
| 1175 | prod100(:,0) = zero |
|---|
| 1176 | above = zero |
|---|
| 1177 | convflux(:) = zero |
|---|
| 1178 | cflux_prod10(:) = zero |
|---|
| 1179 | cflux_prod100(:) = zero |
|---|
| 1180 | delta_ind(:,:) = zero |
|---|
| 1181 | delta_veg(:) = zero |
|---|
| 1182 | dilu_soil_carbon_vertres(:,:,:) = zero |
|---|
| 1183 | delta_nat_peat(:) = zero |
|---|
| 1184 | delta_a(:,:) =zero |
|---|
| 1185 | delta_s(:,:) =zero |
|---|
| 1186 | delta_p(:,:) =zero |
|---|
| 1187 | delta_carbon(:,:) =zero |
|---|
| 1188 | !! 2. calculation of changes in carbon stocks and biomass by land cover change\n |
|---|
| 1189 | |
|---|
| 1190 | DO i = 1, npts ! Loop over # pixels - domain size |
|---|
| 1191 | |
|---|
| 1192 | !! 2.1 initialization of carbon stocks\n |
|---|
| 1193 | delta_veg(:) = veget_max_adjusted(i,:)-veget_max_old(i,:) |
|---|
| 1194 | delta_nat_peat(i)=delta_veg(14) |
|---|
| 1195 | delta_veg_sum = zero |
|---|
| 1196 | |
|---|
| 1197 | dilu_lit(i,:,:,:) = zero |
|---|
| 1198 | dilu_lit_peat(i,:,:,:) = zero |
|---|
| 1199 | dilu_soil_carbon(i,:) = zero |
|---|
| 1200 | biomass_loss(i,:,:) = zero |
|---|
| 1201 | biomass_loss_peat(i,:,:)=zero |
|---|
| 1202 | biomass_remove(i,:,:,:)=zero |
|---|
| 1203 | !!! This part of code is hard-coded, need to be modified if number of PFTs change |
|---|
| 1204 | !!expanding vegetations (peat, and non-peat vegetations), biomass |
|---|
| 1205 | DO j=2,nvm |
|---|
| 1206 | IF ( delta_veg(j) > min_stomate) THEN |
|---|
| 1207 | IF (veget_max_old(i,j) .LT. min_stomate) THEN |
|---|
| 1208 | IF (is_tree(j)) THEN |
|---|
| 1209 | cn_ind(i,j) = cn_sapl(j) |
|---|
| 1210 | ELSE |
|---|
| 1211 | cn_ind(i,j) = un |
|---|
| 1212 | ENDIF |
|---|
| 1213 | ind(i,j)= delta_veg(j) / cn_ind(i,j) |
|---|
| 1214 | PFTpresent(i,j) = .TRUE. |
|---|
| 1215 | everywhere(i,j) = 1. |
|---|
| 1216 | senescence(i,j) = .FALSE. |
|---|
| 1217 | age(i,j) = zero |
|---|
| 1218 | when_growthinit(i,j) = large_value |
|---|
| 1219 | leaf_frac(i,j,1) = 1.0 |
|---|
| 1220 | npp_longterm(i,j) = npp_longterm_init |
|---|
| 1221 | lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j) |
|---|
| 1222 | ENDIF |
|---|
| 1223 | IF ( cn_ind(i,j) > min_stomate ) THEN |
|---|
| 1224 | delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) |
|---|
| 1225 | ENDIF |
|---|
| 1226 | DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 |
|---|
| 1227 | DO l = 1,nelements ! loop over # elements |
|---|
| 1228 | bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l) |
|---|
| 1229 | IF (veget_max_old(i,j) .GT. min_stomate) THEN |
|---|
| 1230 | IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN |
|---|
| 1231 | bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j) |
|---|
| 1232 | ENDIF |
|---|
| 1233 | ENDIF |
|---|
| 1234 | biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max_old(i,j) + bm_new(i,l) ) / veget_max_adjusted(i,j) |
|---|
| 1235 | co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)*dt_days) / (one_year * veget_max_adjusted(i,j)) |
|---|
| 1236 | END DO ! loop over # elements |
|---|
| 1237 | ENDDO ! loop over # carbon stock components |
|---|
| 1238 | ELSE |
|---|
| 1239 | IF (veget_max_adjusted(i,j) .LT. min_stomate ) THEN |
|---|
| 1240 | ind(i,j) = zero |
|---|
| 1241 | biomass(i,j,:,:) = zero |
|---|
| 1242 | PFTpresent(i,j) = .FALSE. |
|---|
| 1243 | senescence(i,j) = .FALSE. |
|---|
| 1244 | age(i,j) = zero |
|---|
| 1245 | when_growthinit(i,j) = undef |
|---|
| 1246 | everywhere(i,j) = zero |
|---|
| 1247 | carbon(i,:,j) = zero |
|---|
| 1248 | litter(i,:,j,:,:) = zero |
|---|
| 1249 | bm_to_litter(i,j,:,:) = zero |
|---|
| 1250 | turnover_daily(i,j,:,:) = zero |
|---|
| 1251 | IF (ok_pc) THEN |
|---|
| 1252 | deepC_a(i,:,j)=zero |
|---|
| 1253 | deepC_s(i,:,j)=zero |
|---|
| 1254 | deepC_p(i,:,j)=zero |
|---|
| 1255 | ENDIF |
|---|
| 1256 | ENDIF |
|---|
| 1257 | ENDIF |
|---|
| 1258 | ENDDO |
|---|
| 1259 | |
|---|
| 1260 | !! 2.2 Crops on peatland increase, natural peatland decrease. |
|---|
| 1261 | IF (delta_nat_peat(i) < -min_stomate) THEN |
|---|
| 1262 | !! crops on peatland obtain soilC from shrinking natural peat |
|---|
| 1263 | DO j=1,nvm |
|---|
| 1264 | IF (is_peat(j)) THEN |
|---|
| 1265 | !dead biomass due to agricultural use is removed from the field |
|---|
| 1266 | biomass_remove(i,j,:,:) = biomass(i,j,:,:)*delta_veg(j) |
|---|
| 1267 | biomass_loss_peat(i,:,:) = biomass_loss_peat(i,:,:) - biomass(i,j,:,:)*delta_veg(j) |
|---|
| 1268 | dilu_lit_peat(i,:,:,:) = dilu_lit_peat(i,:,:,:) - delta_veg(j)*litter(i,:,j,:,:) |
|---|
| 1269 | delta_a(i,:)=delta_a(i,:)-deepC_a(i,:,j)*delta_veg(j) |
|---|
| 1270 | delta_s(i,:)=delta_s(i,:)-deepC_s(i,:,j)*delta_veg(j) |
|---|
| 1271 | delta_p(i,:)=delta_p(i,:)-deepC_p(i,:,j)*delta_veg(j) |
|---|
| 1272 | delta_carbon(i,:)= delta_carbon(i,:)-carbon(i,:,j) * delta_veg(j) |
|---|
| 1273 | above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon) |
|---|
| 1274 | convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above *delta_veg(j) ) |
|---|
| 1275 | prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above *delta_veg(j) ) |
|---|
| 1276 | prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above *delta_veg(j) ) |
|---|
| 1277 | ENDIF |
|---|
| 1278 | ENDDO |
|---|
| 1279 | IF ((delta_veg(15)>min_stomate) .AND. (delta_veg(16)>min_stomate)) THEN |
|---|
| 1280 | !! both PFT15 and PFT16 increase, give C from natural peat to them proportionally |
|---|
| 1281 | DO n=15,16 |
|---|
| 1282 | litter(i,:,n,:,:)=(litter(i,:,n,:,:) * veget_max_old(i,n) - & |
|---|
| 1283 | & dilu_lit_peat(i,:,:,:) * (delta_veg(n)/delta_nat_peat(i))) / veget_max_adjusted(i,n) |
|---|
| 1284 | DO l = 1,nelements |
|---|
| 1285 | bm_to_litter(i,n,isapbelow,l) = (bm_to_litter(i,n,isapbelow,l)*veget_max_old(i,n) - & |
|---|
| 1286 | & biomass_loss_peat(i,isapbelow,l)*delta_veg(n)/delta_nat_peat(i)) / veget_max_adjusted(i,n) |
|---|
| 1287 | bm_to_litter(i,n,iheartbelow,l) =(bm_to_litter(i,n,iheartbelow,l)*veget_max_old(i,n)-& |
|---|
| 1288 | & biomass_loss_peat(i,iheartbelow,l) *delta_veg(n)/delta_nat_peat(i))/ veget_max_adjusted(i,n) |
|---|
| 1289 | bm_to_litter(i,n,iroot,l) =(bm_to_litter(i,n,iroot,l)*veget_max_old(i,n) - & |
|---|
| 1290 | & biomass_loss_peat(i,iroot,l)*delta_veg(n)/delta_nat_peat(i))/ veget_max_adjusted(i,n) |
|---|
| 1291 | bm_to_litter(i,n,ifruit,l) = (bm_to_litter(i,n,ifruit,l)*veget_max_old(i,n) - & |
|---|
| 1292 | & biomass_loss_peat(i,ifruit,l)*delta_veg(n)/delta_nat_peat(i))/ veget_max_adjusted(i,n) |
|---|
| 1293 | bm_to_litter(i,n,icarbres,l) = (bm_to_litter(i,n,icarbres,l)*veget_max_old(i,n) - & |
|---|
| 1294 | & biomass_loss_peat(i,icarbres,l) *delta_veg(n)/delta_nat_peat(i)) / veget_max_adjusted(i,n) |
|---|
| 1295 | bm_to_litter(i,n,ileaf,l) =(bm_to_litter(i,n,ileaf,l)*veget_max_old(i,n) - & |
|---|
| 1296 | & biomass_loss_peat(i,ileaf,l)* delta_veg(n)/delta_nat_peat(i)) / veget_max_adjusted(i,n) |
|---|
| 1297 | ENDDO |
|---|
| 1298 | IF (ok_pc) THEN |
|---|
| 1299 | deepC_a(i,:,n)=(deepC_a(i,:,n) * veget_max_old(i,n) - & |
|---|
| 1300 | delta_a(i,:)*delta_veg(n)/delta_nat_peat(i)) / veget_max_adjusted(i,n) |
|---|
| 1301 | deepC_s(i,:,n)=(deepC_s(i,:,n) * veget_max_old(i,n) - & |
|---|
| 1302 | delta_s(i,:)*delta_veg(n)/delta_nat_peat(i)) / veget_max_adjusted(i,n) |
|---|
| 1303 | deepC_p(i,:,n)=(deepC_p(i,:,n) * veget_max_old(i,n) - & |
|---|
| 1304 | delta_p(i,:)*delta_veg(n)/delta_nat_peat(i)) /veget_max_adjusted(i,n) |
|---|
| 1305 | ENDIF |
|---|
| 1306 | carbon(i,:,n)=(carbon(i,:,n) * veget_max_old(i,n) - delta_carbon(i,:) * delta_veg(n)/delta_nat_peat(i))/veget_max_adjusted(i,n) |
|---|
| 1307 | ENDDO |
|---|
| 1308 | ELSE |
|---|
| 1309 | !! one of PFT15 and PFT16 increase, the other one decrease |
|---|
| 1310 | !! the increasing one obtain C from the decreasing one and from shrinking nature peat |
|---|
| 1311 | DO n=15,16 |
|---|
| 1312 | IF (delta_veg(n) .LE. 0.) THEN |
|---|
| 1313 | biomass_remove(i,n,:,:)= biomass(i,n,:,:)*delta_veg(n) |
|---|
| 1314 | biomass_loss_peat(i,:,:) = biomass_loss_peat(i,:,:) - biomass(i,n,:,:)*delta_veg(n) |
|---|
| 1315 | dilu_lit_peat(i,:,:,:) = dilu_lit_peat(i,:,:,:) - delta_veg(n)*litter(i,:,n,:,:) |
|---|
| 1316 | delta_a(i,:)=delta_a(i,:)-deepC_a(i,:,n)*delta_veg(n) |
|---|
| 1317 | delta_s(i,:)=delta_s(i,:)-deepC_s(i,:,n)*delta_veg(n) |
|---|
| 1318 | delta_p(i,:)=delta_p(i,:)-deepC_p(i,:,n)*delta_veg(n) |
|---|
| 1319 | delta_carbon(i,:)= delta_carbon(i,:)-carbon(i,:,n) * delta_veg(n) |
|---|
| 1320 | above = biomass(i,n,isapabove,icarbon) + biomass(i,n,iheartabove,icarbon) |
|---|
| 1321 | convflux(i) = convflux(i) - ( coeff_lcchange_1(n) * above *delta_veg(n) ) |
|---|
| 1322 | prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(n) * above *delta_veg(n) ) |
|---|
| 1323 | prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(n) * above*delta_veg(n) ) |
|---|
| 1324 | ENDIF |
|---|
| 1325 | ENDDO |
|---|
| 1326 | |
|---|
| 1327 | DO n=15,16 |
|---|
| 1328 | IF (delta_veg(n) .GT. 0.) THEN |
|---|
| 1329 | litter(i,:,n,:,:)=(litter(i,:,n,:,:) * veget_max_old(i,n) + & |
|---|
| 1330 | dilu_lit_peat(i,:,:,:)) / veget_max_adjusted(i,n) |
|---|
| 1331 | DO l = 1,nelements |
|---|
| 1332 | bm_to_litter(i,n,isapbelow,l) = (bm_to_litter(i,n,isapbelow,l)*veget_max_old(i,n) + & |
|---|
| 1333 | & biomass_loss_peat(i,isapbelow,l))/ veget_max_adjusted(i,n) |
|---|
| 1334 | bm_to_litter(i,n,iheartbelow,l) = (bm_to_litter(i,n,iheartbelow,l)*veget_max_old(i,n) +& |
|---|
| 1335 | & biomass_loss_peat(i,iheartbelow,l))/ veget_max_adjusted(i,n) |
|---|
| 1336 | bm_to_litter(i,n,iroot,l) = (bm_to_litter(i,n,iroot,l)*veget_max_old(i,n) + & |
|---|
| 1337 | & biomass_loss_peat(i,iroot,l))/ veget_max_adjusted(i,n) |
|---|
| 1338 | bm_to_litter(i,n,ifruit,l) = (bm_to_litter(i,n,ifruit,l)*veget_max_old(i,n) + & |
|---|
| 1339 | & biomass_loss_peat(i,ifruit,l))/ veget_max_adjusted(i,n) |
|---|
| 1340 | bm_to_litter(i,n,icarbres,l) = (bm_to_litter(i,n,icarbres,l)*veget_max_old(i,n) + & |
|---|
| 1341 | & biomass_loss_peat(i,icarbres,l))/ veget_max_adjusted(i,n) |
|---|
| 1342 | bm_to_litter(i,n,ileaf,l) = (bm_to_litter(i,n,ileaf,l)*veget_max_old(i,n) + & |
|---|
| 1343 | & biomass_loss_peat(i,ileaf,l))/ veget_max_adjusted(i,n) |
|---|
| 1344 | END DO |
|---|
| 1345 | IF (ok_pc) THEN |
|---|
| 1346 | deepC_a(i,:,n)=(deepC_a(i,:,n) * veget_max_old(i,n) + delta_a(i,:)) / veget_max_adjusted(i,n) |
|---|
| 1347 | deepC_s(i,:,n)=(deepC_s(i,:,n) * veget_max_old(i,n) + delta_s(i,:)) / veget_max_adjusted(i,n) |
|---|
| 1348 | deepC_p(i,:,n)=(deepC_p(i,:,n) * veget_max_old(i,n) + delta_p(i,:)) /veget_max_adjusted(i,n) |
|---|
| 1349 | ENDIF |
|---|
| 1350 | carbon(i,:,n)=(carbon(i,:,n) * veget_max_old(i,n) + delta_carbon(i,:)) / veget_max_adjusted(i,n) |
|---|
| 1351 | ENDIF |
|---|
| 1352 | ENDDO |
|---|
| 1353 | ENDIF |
|---|
| 1354 | !!non-peat vegetations |
|---|
| 1355 | DO j=1,13 |
|---|
| 1356 | IF ( delta_veg(j) .LT. zero ) THEN |
|---|
| 1357 | delta_veg_sum = delta_veg_sum+delta_veg(j) |
|---|
| 1358 | ENDIF |
|---|
| 1359 | ENDDO |
|---|
| 1360 | DO j=1, 13 |
|---|
| 1361 | IF ( delta_veg(j) < -min_stomate ) THEN |
|---|
| 1362 | dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum |
|---|
| 1363 | biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum |
|---|
| 1364 | IF ( ok_pc ) THEN |
|---|
| 1365 | dilu_soil_carbon_vertres(i,:,iactive)=dilu_soil_carbon_vertres(i,:,iactive) + & |
|---|
| 1366 | delta_veg(j) * deepC_a(i,:,j) / delta_veg_sum |
|---|
| 1367 | dilu_soil_carbon_vertres(i,:,islow)=dilu_soil_carbon_vertres(i,:,islow) + & |
|---|
| 1368 | delta_veg(j) * deepC_s(i,:,j) / delta_veg_sum |
|---|
| 1369 | dilu_soil_carbon_vertres(i,:,ipassive)=dilu_soil_carbon_vertres(i,:,ipassive) + & |
|---|
| 1370 | delta_veg(j) * deepC_p(i,:,j) / delta_veg_sum |
|---|
| 1371 | ENDIF |
|---|
| 1372 | dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum |
|---|
| 1373 | ENDIF |
|---|
| 1374 | ENDDO |
|---|
| 1375 | DO j=1, 13 |
|---|
| 1376 | IF ( delta_veg(j) > min_stomate) THEN |
|---|
| 1377 | litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + & |
|---|
| 1378 | dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1379 | IF (is_grassland_manag(j) .AND. is_grassland_grazed(j)) THEN |
|---|
| 1380 | litter_avail(i,:,j) = litter_avail(i,:,j) * veget_max_old(i,j) / veget_max_adjusted(i,j) |
|---|
| 1381 | litter_not_avail(i,:,j) = litter(i,:,j,iabove,icarbon) - litter_avail(i,:,j) |
|---|
| 1382 | ENDIF |
|---|
| 1383 | IF ( ok_pc ) THEN |
|---|
| 1384 | deepC_a(i,:,j)=(deepC_a(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1385 | dilu_soil_carbon_vertres(i,:,iactive) * delta_veg(j)) /veget_max_adjusted(i,j) |
|---|
| 1386 | deepC_s(i,:,j)=(deepC_s(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1387 | dilu_soil_carbon_vertres(i,:,islow) * delta_veg(j)) /veget_max_adjusted(i,j) |
|---|
| 1388 | deepC_p(i,:,j)=(deepC_p(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1389 | dilu_soil_carbon_vertres(i,:,ipassive) * delta_veg(j)) /veget_max_adjusted(i,j) |
|---|
| 1390 | ENDIF |
|---|
| 1391 | carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) +dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1392 | |
|---|
| 1393 | DO l = 1,nelements |
|---|
| 1394 | bm_to_litter(i,j,isapbelow,l) = (bm_to_litter(i,j,isapbelow,l)*veget_max_old(i,j) + & |
|---|
| 1395 | & biomass_loss(i,isapbelow,l)*delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1396 | bm_to_litter(i,j,iheartbelow,l) = (bm_to_litter(i,j,iheartbelow,l)*veget_max_old(i,j) + & |
|---|
| 1397 | & biomass_loss(i,iheartbelow,l) *delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1398 | bm_to_litter(i,j,iroot,l) = (bm_to_litter(i,j,iroot,l)*veget_max_old(i,j) + & |
|---|
| 1399 | & biomass_loss(i,iroot,l)*delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1400 | bm_to_litter(i,j,ifruit,l) = (bm_to_litter(i,j,ifruit,l)*veget_max_old(i,j) + & |
|---|
| 1401 | & biomass_loss(i,ifruit,l)*delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1402 | bm_to_litter(i,j,icarbres,l) = (bm_to_litter(i,j,icarbres,l)*veget_max_old(i,j) + & |
|---|
| 1403 | & biomass_loss(i,icarbres,l) *delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1404 | bm_to_litter(i,j,ileaf,l) = (bm_to_litter(i,j,ileaf,l)*veget_max_old(i,j) + & |
|---|
| 1405 | & biomass_loss(i,ileaf,l)*delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1406 | ENDDO |
|---|
| 1407 | |
|---|
| 1408 | age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max_adjusted(i,j) |
|---|
| 1409 | ELSE |
|---|
| 1410 | above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon) |
|---|
| 1411 | convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) ) |
|---|
| 1412 | prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above *delta_veg(j) ) |
|---|
| 1413 | prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above *delta_veg(j) ) |
|---|
| 1414 | ENDIF ! End if PFT's coverage reduction |
|---|
| 1415 | ENDDO |
|---|
| 1416 | ELSE |
|---|
| 1417 | !!2.3 Crops on peatland decrease,abandoned agricultural peat become |
|---|
| 1418 | !natural vegetations, natural peatland will not change |
|---|
| 1419 | delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT. 0.) |
|---|
| 1420 | !! if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n |
|---|
| 1421 | DO j=1, nvm |
|---|
| 1422 | IF ( delta_veg(j) < -min_stomate ) THEN |
|---|
| 1423 | dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum |
|---|
| 1424 | biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum |
|---|
| 1425 | IF ( ok_pc ) THEN |
|---|
| 1426 | dilu_soil_carbon_vertres(i,:,iactive)=dilu_soil_carbon_vertres(i,:,iactive) + & |
|---|
| 1427 | delta_veg(j) * deepC_a(i,:,j) / delta_veg_sum |
|---|
| 1428 | dilu_soil_carbon_vertres(i,:,islow)=dilu_soil_carbon_vertres(i,:,islow) + & |
|---|
| 1429 | delta_veg(j) * deepC_s(i,:,j) / delta_veg_sum |
|---|
| 1430 | dilu_soil_carbon_vertres(i,:,ipassive)=dilu_soil_carbon_vertres(i,:,ipassive) + & |
|---|
| 1431 | delta_veg(j) * deepC_p(i,:,j) / delta_veg_sum |
|---|
| 1432 | ENDIF |
|---|
| 1433 | dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum |
|---|
| 1434 | ENDIF |
|---|
| 1435 | ENDDO |
|---|
| 1436 | DO j=1, nvm ! Loop over # PFTs |
|---|
| 1437 | !! The case that vegetation coverage of PFTj increases |
|---|
| 1438 | IF ( delta_veg(j) > min_stomate) THEN |
|---|
| 1439 | litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + & |
|---|
| 1440 | dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1441 | IF (is_grassland_manag(j) .AND. is_grassland_grazed(j)) THEN |
|---|
| 1442 | litter_avail(i,:,j) = litter_avail(i,:,j) * veget_max_old(i,j) / veget_max_adjusted(i,j) |
|---|
| 1443 | litter_not_avail(i,:,j) = litter(i,:,j,iabove,icarbon) - litter_avail(i,:,j) |
|---|
| 1444 | ENDIF |
|---|
| 1445 | IF ( ok_pc ) THEN |
|---|
| 1446 | deepC_a(i,:,j)=(deepC_a(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1447 | dilu_soil_carbon_vertres(i,:,iactive) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1448 | deepC_s(i,:,j)=(deepC_s(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1449 | dilu_soil_carbon_vertres(i,:,islow) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1450 | deepC_p(i,:,j)=(deepC_p(i,:,j) * veget_max_old(i,j) + & |
|---|
| 1451 | dilu_soil_carbon_vertres(i,:,ipassive) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1452 | ENDIF |
|---|
| 1453 | carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1454 | |
|---|
| 1455 | DO l = 1,nelements |
|---|
| 1456 | bm_to_litter(i,j,isapbelow,l) = (bm_to_litter(i,j,isapbelow,l)* veget_max_old(i,j) + & |
|---|
| 1457 | & biomass_loss(i,isapbelow,l)*delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1458 | bm_to_litter(i,j,iheartbelow,l) = (bm_to_litter(i,j,iheartbelow,l)* veget_max_old(i,j) +& |
|---|
| 1459 | & biomass_loss(i,iheartbelow,l) *delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1460 | bm_to_litter(i,j,iroot,l) = (bm_to_litter(i,j,iroot,l)* veget_max_old(i,j) + & |
|---|
| 1461 | & biomass_loss(i,iroot,l)*delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1462 | bm_to_litter(i,j,ifruit,l) =(bm_to_litter(i,j,ifruit,l)* veget_max_old(i,j) + & |
|---|
| 1463 | & biomass_loss(i,ifruit,l)*delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1464 | bm_to_litter(i,j,icarbres,l) = (bm_to_litter(i,j,icarbres,l)* veget_max_old(i,j) + & |
|---|
| 1465 | & biomass_loss(i,icarbres,l) *delta_veg(j)) / veget_max_adjusted(i,j) |
|---|
| 1466 | bm_to_litter(i,j,ileaf,l) = (bm_to_litter(i,j,ileaf,l)* veget_max_old(i,j) + & |
|---|
| 1467 | & biomass_loss(i,ileaf,l)*delta_veg(j))/ veget_max_adjusted(i,j) |
|---|
| 1468 | END DO |
|---|
| 1469 | age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max_adjusted(i,j) |
|---|
| 1470 | ELSE |
|---|
| 1471 | above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon) |
|---|
| 1472 | convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) ) |
|---|
| 1473 | prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) ) |
|---|
| 1474 | prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) ) |
|---|
| 1475 | ENDIF ! End if PFT's coverage reduction |
|---|
| 1476 | ENDDO ! Loop over # PFTs |
|---|
| 1477 | ENDIF |
|---|
| 1478 | |
|---|
| 1479 | DO l = 0, 8 |
|---|
| 1480 | m = 10 - l |
|---|
| 1481 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,m) |
|---|
| 1482 | prod10(i,m) = prod10(i,m-1) - flux10(i,m-1) |
|---|
| 1483 | flux10(i,m) = flux10(i,m-1) |
|---|
| 1484 | |
|---|
| 1485 | IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero |
|---|
| 1486 | ENDDO |
|---|
| 1487 | cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) |
|---|
| 1488 | flux10(i,1) = 0.1 * prod10(i,0) |
|---|
| 1489 | prod10(i,1) = prod10(i,0) |
|---|
| 1490 | |
|---|
| 1491 | !! update 100 year-turnover pool content following flux emission\n |
|---|
| 1492 | DO l = 0, 98 |
|---|
| 1493 | m = 100 - l |
|---|
| 1494 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,m) |
|---|
| 1495 | prod100(i,m) = prod100(i,m-1) - flux100(i,m-1) |
|---|
| 1496 | flux100(i,m) = flux100(i,m-1) |
|---|
| 1497 | |
|---|
| 1498 | IF (prod100(i,m).LT.1.0) prod100(i,m) = zero |
|---|
| 1499 | ENDDO |
|---|
| 1500 | |
|---|
| 1501 | cflux_prod100(i) = cflux_prod100(i) + flux100(i,1) |
|---|
| 1502 | flux100(i,1) = 0.01 * prod100(i,0) |
|---|
| 1503 | prod100(i,1) = prod100(i,0) |
|---|
| 1504 | prod10(i,0) = zero |
|---|
| 1505 | prod100(i,0) = zero |
|---|
| 1506 | |
|---|
| 1507 | ENDDO |
|---|
| 1508 | |
|---|
| 1509 | !! We redistribute the updated litter into four fuel classes, so that |
|---|
| 1510 | !! the balance between aboveground litter and fuel is mainted. The subtraction |
|---|
| 1511 | !! of fuel burned by land cover change fires from the fuel pool is made here. |
|---|
| 1512 | fuel_all_type(:,:,:,:) = fuel_1hr(:,:,:,:) + fuel_10hr(:,:,:,:) + & |
|---|
| 1513 | fuel_100hr(:,:,:,:) + fuel_1000hr(:,:,:,:) |
|---|
| 1514 | fuel_type_frac(:,:,:,:,:) = 0.25 |
|---|
| 1515 | WHERE(fuel_all_type(:,:,:,:) > min_stomate) |
|---|
| 1516 | fuel_type_frac(:,:,:,:,1) = fuel_1hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 1517 | fuel_type_frac(:,:,:,:,2) = fuel_10hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 1518 | fuel_type_frac(:,:,:,:,3) = fuel_100hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 1519 | fuel_type_frac(:,:,:,:,4) = fuel_1000hr(:,:,:,:)/fuel_all_type(:,:,:,:) |
|---|
| 1520 | ENDWHERE |
|---|
| 1521 | DO j=1,nvm |
|---|
| 1522 | fuel_1hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,1) |
|---|
| 1523 | fuel_10hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,2) |
|---|
| 1524 | fuel_100hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,3) |
|---|
| 1525 | fuel_1000hr(:,j,:,:) = litter(:,:,j,iabove,:) * fuel_type_frac(:,j,:,:,4) |
|---|
| 1526 | END DO |
|---|
| 1527 | |
|---|
| 1528 | !! 3. history |
|---|
| 1529 | convflux = convflux/one_year*dt_days |
|---|
| 1530 | cflux_prod10 = cflux_prod10/one_year*dt_days |
|---|
| 1531 | cflux_prod100 = cflux_prod100/one_year*dt_days |
|---|
| 1532 | |
|---|
| 1533 | DO i=1, npts |
|---|
| 1534 | DO j=1,nvm |
|---|
| 1535 | DO l=1,ncarb |
|---|
| 1536 | soilc_after(i)=soilc_after(i)+carbon(i,l,j)*veget_max_adjusted(i,j) |
|---|
| 1537 | ENDDO |
|---|
| 1538 | ENDDO |
|---|
| 1539 | IF ( ABS(soilc_after(i)-soilc_before(i)) .GT. 1000.*min_stomate) THEN |
|---|
| 1540 | WRITE(numout,*) ' qcj check lcchange_main_agripeat,C',lalo(i,:) |
|---|
| 1541 | WRITE (numout,*) 'qcj check lcchange_main_agripeat,before-after', soilc_before(i),soilc_after(i) |
|---|
| 1542 | ENDIF |
|---|
| 1543 | ENDDO |
|---|
| 1544 | |
|---|
| 1545 | |
|---|
| 1546 | IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main_agripeat' |
|---|
| 1547 | |
|---|
| 1548 | |
|---|
| 1549 | |
|---|
| 1550 | END SUBROUTINE lcchange_main_agripeat |
|---|
| 1551 | |
|---|
| 1552 | !! |
|---|
| 1553 | !================================================================================================================================ |
|---|
| 1554 | !! SUBROUTINE : agripeat_adjust_fractions |
|---|
| 1555 | !! DESCRIPTION: Adjust fractions of vegetations according to peatland area |
|---|
| 1556 | !_ |
|---|
| 1557 | !================================================================================================================================ |
|---|
| 1558 | SUBROUTINE agripeat_adjust_fractions (npts, lalo,veget_max_new, veget_max_old, veget_max_adjusted) |
|---|
| 1559 | |
|---|
| 1560 | IMPLICIT NONE |
|---|
| 1561 | !! 0. Variable and parameter declaration |
|---|
| 1562 | |
|---|
| 1563 | !! Input variables |
|---|
| 1564 | INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless) |
|---|
| 1565 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old |
|---|
| 1566 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_new |
|---|
| 1567 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo |
|---|
| 1568 | |
|---|
| 1569 | !! Output variables |
|---|
| 1570 | REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: veget_max_adjusted |
|---|
| 1571 | |
|---|
| 1572 | !! Local variables |
|---|
| 1573 | REAL(r_std), DIMENSION(npts,nvm) :: veget_max_tmp |
|---|
| 1574 | REAL(r_std), DIMENSION(npts,nvm) :: veget_max_tmp2 |
|---|
| 1575 | !!!natural vegetations (not including natural peatland) |
|---|
| 1576 | REAL(r_std), DIMENSION(npts) :: sum_veget_natold |
|---|
| 1577 | REAL(r_std), DIMENSION(npts) :: sum_veget_natnew |
|---|
| 1578 | REAL(r_std), DIMENSION(npts) :: sum_veget_nattmp |
|---|
| 1579 | REAL(r_std), DIMENSION(npts) :: sum_veget_nattmp_adjust |
|---|
| 1580 | !!! crops (peat+non-peat) |
|---|
| 1581 | REAL(r_std), DIMENSION(npts) :: sum_crops_old |
|---|
| 1582 | REAL(r_std), DIMENSION(npts) :: sum_crops_new |
|---|
| 1583 | !!!crops on peatland |
|---|
| 1584 | REAL(r_std), DIMENSION(npts) :: sum_peat_crops_old |
|---|
| 1585 | REAL(r_std), DIMENSION(npts) :: sum_peat_crops_new |
|---|
| 1586 | !!!natural peatland+ crops peatland |
|---|
| 1587 | REAL(r_std), DIMENSION(npts) :: sumpeat_old |
|---|
| 1588 | INTEGER(i_std) :: i, j |
|---|
| 1589 | !_ |
|---|
| 1590 | !================================================================================================================================ |
|---|
| 1591 | |
|---|
| 1592 | veget_max_adjusted(:,:) = veget_max_new(:,:) |
|---|
| 1593 | |
|---|
| 1594 | sum_veget_natold(:) = zero |
|---|
| 1595 | sum_veget_natnew(:) = zero |
|---|
| 1596 | sum_veget_nattmp(:) = zero |
|---|
| 1597 | |
|---|
| 1598 | sum_veget_nattmp_adjust(:) = zero |
|---|
| 1599 | |
|---|
| 1600 | sum_peat_crops_old(:)=zero |
|---|
| 1601 | sum_peat_crops_new(:)=zero |
|---|
| 1602 | |
|---|
| 1603 | sum_crops_old(:)=zero |
|---|
| 1604 | sum_crops_new(:)=zero |
|---|
| 1605 | |
|---|
| 1606 | sumpeat_old(:)=zero |
|---|
| 1607 | DO i = 1, npts |
|---|
| 1608 | DO j=1,nvm |
|---|
| 1609 | IF ( natural(j) .AND. .NOT. pasture(j) .OR. is_peat(j) ) THEN |
|---|
| 1610 | sum_veget_natold(i) = sum_veget_natold(i) + veget_max_old(i,j) |
|---|
| 1611 | ENDIF |
|---|
| 1612 | |
|---|
| 1613 | IF ( pft_to_mtc(j)==16 .OR. pft_to_mtc(j)==17 ) THEN |
|---|
| 1614 | sum_peat_crops_old(i)=sum_peat_crops_old(i) + veget_max_old(i,j) |
|---|
| 1615 | ENDIF |
|---|
| 1616 | ENDDO |
|---|
| 1617 | DO j=1,nvm |
|---|
| 1618 | IF (is_peat(j)) THEN |
|---|
| 1619 | sumpeat_old(i)=veget_max_old(i,j)+sum_peat_crops_old(i) |
|---|
| 1620 | ENDIF |
|---|
| 1621 | ENDDO |
|---|
| 1622 | ENDDO |
|---|
| 1623 | |
|---|
| 1624 | !!!!!!!!!!!!!!!!!!!! Hard-coded, may need to be improved. qcj++ |
|---|
| 1625 | |
|---|
| 1626 | IF (agri_peat_prop) THEN |
|---|
| 1627 | !!!Overlay vegetation maps with peatland, assume that peatland occupy each non-peat PFT in proportion to grid cell area of the PFT |
|---|
| 1628 | DO i= 1, npts |
|---|
| 1629 | DO j=1,13 !! PFT1-11, non-peatland, natural vegetations |
|---|
| 1630 | veget_max_tmp(i,j) = veget_max_new(i,j) * (un - sumpeat_old(i)) |
|---|
| 1631 | ENDDO |
|---|
| 1632 | !! peatland overlay with crops creating two new PFTs |
|---|
| 1633 | veget_max_tmp(i,15) = sumpeat_old(i)* veget_max_new(i,12) |
|---|
| 1634 | veget_max_tmp(i,16) = sumpeat_old(i)* veget_max_new(i,13) |
|---|
| 1635 | !! substract PFT15 and PFT16 from PFT12 and PFT13, respectively |
|---|
| 1636 | !! subtract PFT15 and PFT16 from natural peat (PFT14) |
|---|
| 1637 | veget_max_tmp(i,14) = sumpeat_old(i)-veget_max_tmp(i,15)-veget_max_tmp(i,16) |
|---|
| 1638 | ENDDO |
|---|
| 1639 | |
|---|
| 1640 | DO i = 1, npts |
|---|
| 1641 | !! IF first occur of agriculture on peatland |
|---|
| 1642 | IF ( (sumpeat_old(i) .GT. zero) .AND. (sum_peat_crops_old(i) .EQ. zero)) THEN |
|---|
| 1643 | veget_max_adjusted(i,:) = veget_max_tmp(i,:) |
|---|
| 1644 | ENDIF |
|---|
| 1645 | |
|---|
| 1646 | !! Change vegetation map |
|---|
| 1647 | IF (sum_peat_crops_old(i) .GT. zero) THEN |
|---|
| 1648 | !! compare veget_max_tmp with veget_max_old |
|---|
| 1649 | DO j=1,nvm |
|---|
| 1650 | IF ( natural(j) .AND. .NOT. pasture(j)) THEN |
|---|
| 1651 | sum_veget_natnew(i) = sum_veget_natnew(i) + veget_max_new(i,j) |
|---|
| 1652 | ENDIF |
|---|
| 1653 | ENDDO |
|---|
| 1654 | IF ((sum_veget_natnew(i) .LE. sum_veget_natold(i))) THEN |
|---|
| 1655 | ! sum of natural vegetations decrease, sum of PFT12 and PFT13 in the vegetation map increases |
|---|
| 1656 | ! natural peatland decrease. crops on peatland increase |
|---|
| 1657 | veget_max_adjusted(i,:) = veget_max_tmp(i,:) |
|---|
| 1658 | ELSE |
|---|
| 1659 | ! natural vegetations increase |
|---|
| 1660 | ! natural peatland should not increase |
|---|
| 1661 | veget_max_adjusted(i,14) = veget_max_old(i,14) |
|---|
| 1662 | !! adjust non-peatland natural vegetations accordingly |
|---|
| 1663 | sum_veget_nattmp(i) = sum_veget_natnew(i)- veget_max_old(i,14) |
|---|
| 1664 | DO j=1,nvm |
|---|
| 1665 | IF ( natural(j) .AND. .NOT. pasture(j)) THEN |
|---|
| 1666 | veget_max_adjusted(i,j)=veget_max_new(i,j)*sum_veget_nattmp(i)/sum_veget_natnew(i) |
|---|
| 1667 | ENDIF |
|---|
| 1668 | ENDDO |
|---|
| 1669 | !! crops decrease |
|---|
| 1670 | veget_max_adjusted(i,15) = veget_max_tmp(i,15) |
|---|
| 1671 | veget_max_adjusted(i,16) = veget_max_tmp(i,16) |
|---|
| 1672 | veget_max_adjusted(i,12) = veget_max_tmp(i,12) |
|---|
| 1673 | veget_max_adjusted(i,13) = veget_max_tmp(i,13) |
|---|
| 1674 | ENDIF |
|---|
| 1675 | ENDIF |
|---|
| 1676 | ENDDO !(npts) |
|---|
| 1677 | ENDIF |
|---|
| 1678 | |
|---|
| 1679 | IF (agri_peat_MINcrop) THEN |
|---|
| 1680 | !!! crops will not be planted on peatland, as long as there is enough non-peat mineral soil exists in the grid cell |
|---|
| 1681 | DO i = 1, npts |
|---|
| 1682 | DO j=1,nvm |
|---|
| 1683 | IF ( natural(j) .AND. .NOT. pasture(j) ) THEN |
|---|
| 1684 | sum_veget_natnew(i) = sum_veget_natnew(i) + veget_max_new(i,j) |
|---|
| 1685 | ENDIF |
|---|
| 1686 | ENDDO |
|---|
| 1687 | sum_crops_new(i)=veget_max_new(i,12)+veget_max_new(i,13) |
|---|
| 1688 | |
|---|
| 1689 | IF (sum_veget_natnew(i) .GE. veget_max_old(i,14)) THEN |
|---|
| 1690 | ! there is enough natural areas for peatland |
|---|
| 1691 | veget_max_adjusted(i,14) = veget_max_old(i,14) |
|---|
| 1692 | ! substarct PFT14 from natural non-peat vegetations |
|---|
| 1693 | sum_veget_nattmp(i) = sum_veget_natnew(i)- veget_max_adjusted(i,14) |
|---|
| 1694 | DO j=1,nvm |
|---|
| 1695 | IF ( natural(j) .AND. .NOT. pasture(j) .AND. (sum_veget_natnew(i) .GT. min_stomate)) THEN |
|---|
| 1696 | veget_max_adjusted(i,j)= veget_max_new(i,j)*sum_veget_nattmp(i)/sum_veget_natnew(i) |
|---|
| 1697 | ENDIF |
|---|
| 1698 | ENDDO |
|---|
| 1699 | |
|---|
| 1700 | sum_peat_crops_new(i) = MIN(sum_crops_new(i),sumpeat_old(i)-veget_max_adjusted(i,14)) |
|---|
| 1701 | IF (sum_crops_new(i) .GT. min_stomate) THEN |
|---|
| 1702 | veget_max_adjusted(i,15) = MAX (zero,sum_peat_crops_new(i)*veget_max_new(i,12)/sum_crops_new(i)) |
|---|
| 1703 | veget_max_adjusted(i,16) = MAX (zero,sum_peat_crops_new(i)*veget_max_new(i,13)/sum_crops_new(i)) |
|---|
| 1704 | ENDIF |
|---|
| 1705 | veget_max_adjusted(i,12) = veget_max_new(i,12)-veget_max_adjusted(i,15) |
|---|
| 1706 | veget_max_adjusted(i,13) = veget_max_new(i,13)-veget_max_adjusted(i,16) |
|---|
| 1707 | ELSE |
|---|
| 1708 | ! sum of all natural vegetaions < PFT14,thus all natural vegetations are PFT14 and part of peatland are occupied by crops |
|---|
| 1709 | veget_max_adjusted(i,14) = sum_veget_natnew(i) |
|---|
| 1710 | ! substarct PFT14 from natural non-peat vegetations |
|---|
| 1711 | DO j=1,nvm |
|---|
| 1712 | IF ( natural(j) .AND. .NOT. pasture(j)) THEN |
|---|
| 1713 | veget_max_adjusted(i,j)= zero |
|---|
| 1714 | ENDIF |
|---|
| 1715 | ENDDO |
|---|
| 1716 | |
|---|
| 1717 | sum_peat_crops_new(i) = sumpeat_old(i)-veget_max_adjusted(i,14) |
|---|
| 1718 | IF (sum_crops_new(i) .GT. min_stomate) THEN |
|---|
| 1719 | veget_max_adjusted(i,15) = sum_peat_crops_new(i)*veget_max_new(i,12)/sum_crops_new(i) |
|---|
| 1720 | veget_max_adjusted(i,16) = sum_peat_crops_new(i)*veget_max_new(i,13)/sum_crops_new(i) |
|---|
| 1721 | ENDIF |
|---|
| 1722 | veget_max_adjusted(i,12) = veget_max_new(i,12)-veget_max_adjusted(i,15) |
|---|
| 1723 | veget_max_adjusted(i,13) = veget_max_new(i,13)-veget_max_adjusted(i,16) |
|---|
| 1724 | ENDIF |
|---|
| 1725 | ENDDO |
|---|
| 1726 | ENDIF |
|---|
| 1727 | |
|---|
| 1728 | IF (agri_peat_MAXcrop) THEN |
|---|
| 1729 | !!! For a grid cell that has crops, crops will be planted on peatland first, then to be planted on mineral soils |
|---|
| 1730 | DO i = 1, npts |
|---|
| 1731 | DO j=1,nvm |
|---|
| 1732 | IF ( natural(j) .AND. .NOT. pasture(j) ) THEN |
|---|
| 1733 | sum_veget_natnew(i) = sum_veget_natnew(i) + veget_max_new(i,j) |
|---|
| 1734 | ENDIF |
|---|
| 1735 | ENDDO |
|---|
| 1736 | sum_crops_new(i)=veget_max_new(i,12)+veget_max_new(i,13) |
|---|
| 1737 | |
|---|
| 1738 | IF (sum_crops_new(i) .GE. sumpeat_old(i)) THEN |
|---|
| 1739 | ! all peatland are disturbed |
|---|
| 1740 | IF (sum_crops_new(i) .GT. min_stomate) THEN |
|---|
| 1741 | veget_max_adjusted(i,15)=sumpeat_old(i)*veget_max_new(i,12)/sum_crops_new(i) |
|---|
| 1742 | veget_max_adjusted(i,16)=sumpeat_old(i)*veget_max_new(i,13)/sum_crops_new(i) |
|---|
| 1743 | ENDIF |
|---|
| 1744 | veget_max_adjusted(i,14)=zero |
|---|
| 1745 | veget_max_adjusted(i,12)=veget_max_new(i,12)-veget_max_adjusted(i,15) |
|---|
| 1746 | veget_max_adjusted(i,13)=veget_max_new(i,13)-veget_max_adjusted(i,16) |
|---|
| 1747 | ! non-peat PFTs, unchanged from the map |
|---|
| 1748 | DO j=1,nvm |
|---|
| 1749 | IF ( natural(j) .AND. .NOT. pasture(j)) THEN |
|---|
| 1750 | veget_max_adjusted(i,j)= veget_max_new(i,j) |
|---|
| 1751 | ENDIF |
|---|
| 1752 | ENDDO |
|---|
| 1753 | ELSE |
|---|
| 1754 | ! all crops are planted on peatland, and there is still some natural peatland |
|---|
| 1755 | veget_max_adjusted(i,15)= veget_max_new(i,12) |
|---|
| 1756 | veget_max_adjusted(i,16)= veget_max_new(i,13) |
|---|
| 1757 | veget_max_adjusted(i,12)= zero |
|---|
| 1758 | veget_max_adjusted(i,13)= zero |
|---|
| 1759 | ! natural peatland should not increase |
|---|
| 1760 | veget_max_adjusted(i,14)= MIN(sumpeat_old(i)-veget_max_adjusted(i,15)-veget_max_adjusted(i,16), & |
|---|
| 1761 | veget_max_old(i,14)) |
|---|
| 1762 | ! adjust natural non-peat PFTs according to PFT14 |
|---|
| 1763 | sum_veget_nattmp(i) = sum_veget_natnew(i)- veget_max_adjusted(i,14) |
|---|
| 1764 | DO j=1,nvm |
|---|
| 1765 | IF ( natural(j) .AND. .NOT. pasture(j)) THEN |
|---|
| 1766 | veget_max_adjusted(i,j)= veget_max_new(i,j)*sum_veget_nattmp(i)/sum_veget_natnew(i) |
|---|
| 1767 | ENDIF |
|---|
| 1768 | ENDDO |
|---|
| 1769 | ENDIF |
|---|
| 1770 | ENDDO |
|---|
| 1771 | ENDIF |
|---|
| 1772 | |
|---|
| 1773 | DO i = 1, npts |
|---|
| 1774 | IF (ABS(SUM(veget_max_adjusted(i,:))-SUM(veget_max_new(i,:))) .GT. min_stomate) THEN |
|---|
| 1775 | WRITE (numout,*) 'qcj check agripeat_adjust_fractions,veget', lalo(i,:) |
|---|
| 1776 | WRITE (numout,*) 'qcj check agripeat_adjust_fractions,after-before',SUM(veget_max_adjusted(i,:)),SUM(veget_max_new(i,:)) |
|---|
| 1777 | ENDIF |
|---|
| 1778 | ENDDO |
|---|
| 1779 | |
|---|
| 1780 | |
|---|
| 1781 | END SUBROUTINE agripeat_adjust_fractions |
|---|
| 1782 | !_ |
|---|
| 1783 | !================================================================================================================================ |
|---|
| 1784 | |
|---|
| 1785 | END MODULE stomate_lcchange |
|---|
