-
Petra Lasch-Born authored
version 2.3
Petra Lasch-Born authoredversion 2.3
dist_manag.f 13.01 KiB
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines for: *!
!* disturbance management *!
!* contains: *!
!* SR dist_ini *!
!* SR dist_manag *!
!* SR beetle_nat *!
!* SR beetle_man *!
!* SR disturbance_defoliator *!
!* SR disturbance_xylem *!
!* SR disturbance_phloem *!
!* SR disturbance_root *!
!* SR disturbance_stem *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
SUBROUTINE dist_ini
use data_manag
use data_simul
use data_species
use data_stand
use data_soil
implicit none
integer :: dis_unit,i,ios
character(len=150) :: filename
logical :: ex
character(3) ::text
dis_control=0
xylem_dis=1.0
phlo_feed=1.0
stem_rot=0.0
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%x_fol_loss=0.
zeig%coh%x_frt_loss=0.
zeig%coh%biocost_all=0.
zeig=>zeig%next
end do
dis_unit=getunit()
filename = manfile(ip)
call testfile(filename,ex)
open(dis_unit,file=trim(filename))
do
read(dis_unit,*) text
if(text .eq. 'end')then
exit
endif
enddo
! read the total number of disturbance events (first line after 'end') and after this the annual events
read (dis_unit,*) dis_row_nr ! number of disturbance lines
allocate(dis_year(dis_row_nr));allocate(dis_type(dis_row_nr)); allocate(dis_spec(dis_row_nr));allocate(dis_start(dis_row_nr))
allocate(dis_rel(dis_row_nr))
do i=1,dis_row_nr
read(dis_unit,*,iostat=ios) dis_year(i),dis_type(i), dis_spec(i), dis_start(i), dis_rel(i)
if(ios<0) exit
end do
close(dis_unit)
END SUBROUTINE dist_ini
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE dis_manag
use data_manag
use data_simul
use data_stand
use data_site
use data_species
use data_soil
implicit none
integer :: i
do i= 1, dis_row_nr
if(time .eq. dis_year(i)) then
if(dis_type(i) .eq. 'D') then
dis_control(1,1) = 1
dis_control(1,2) = i
endif
if(dis_type(i) .eq. 'X') then
dis_control(2,1) = 1
dis_control(2,2) = i
endif
if(dis_type(i) .eq. 'P') then
dis_control(3,1) = 1
dis_control(3,2) = i
endif
if(dis_type(i) .eq. 'R') then
dis_control(4,1) = 1
dis_control(4,2) = i
endif
if(dis_type(i) .eq. 'S') then
dis_control(5,1) = 1
dis_control(5,2) = i
endif
if(dis_type(i) .eq. 'M') then
dis_control(6,1) = 1
dis_control(6,2) = i
endif
endif
enddo
END SUBROUTINE dis_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! bark beetle infestation in unmanaged stands
SUBROUTINE beetle_nat(dis_rel_ip, rel_cra)
use data_manag
use data_simul
use data_species
use data_stand
use data_par
implicit none
real :: dis_cra, tot_cra, rel_cra, dis_rel_ip, tar_cra, tar_ba, dis_ba, tot_ba
real :: help, helpN, help1, help1N, hconvd
integer :: i, j, taxnr
dis_cra = 0
tot_cra = 0
dis_ba = 0
tot_ba = 0
help = 0
zeig=>pt%first
do
if(.not.associated(zeig)) exit
tot_cra = tot_cra + zeig%coh%crown_area*zeig%coh%ntreea
tot_ba = tot_ba + zeig%coh%ntreea*pi*zeig%coh%diam*zeig%coh%diam/4
if(zeig%coh%species.eq.2.and. zeig%coh%x_age.gt.50.and.zeig%coh%ntreea.ne.0) then
dis_cra = dis_cra + zeig%coh%crown_area*zeig%coh%ntreea
dis_ba = dis_ba + zeig%coh%ntreea*pi*zeig%coh%diam*zeig%coh%diam/4
end if
zeig=>zeig%next
end do
rel_cra = (tot_cra/dis_cra)* dis_rel_ip/100.
tar_cra = dis_cra * dis_rel_ip/100
tar_ba = dis_ba * dis_rel_ip/100
do while (help.lt.(tar_ba-0.01).and.help.lt.(dis_ba-0.01))
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.2.and. zeig%coh%x_age.gt.50.and. zeig%coh%ntreea.ne.0) then
zeig%coh%ntreea = zeig%coh%ntreea -1
zeig%coh%nta = zeig%coh%ntreea
zeig%coh%ntreem = zeig%coh%ntreem +1
help = help + pi*zeig%coh%diam*zeig%coh%diam/4
end if
if(help.ge.(dis_ba-0.01)) exit
if(help.ge.(tar_ba-0.01)) exit
zeig=>zeig%next
end do
end do
zeig=>pt%first
do
if(.not.associated(zeig)) exit
taxnr = zeig%coh%species
IF (taxnr.eq.2.and. zeig%coh%x_age.gt.50.and.zeig%coh%ntreem.ne.0) then
zeig%coh%litC_fol = zeig%coh%litC_fol + zeig%coh%ntreem*(1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart
zeig%coh%litN_fol = zeig%coh%litN_fol + zeig%coh%ntreem*((1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart)/spar(taxnr)%cnr_fol
zeig%coh%litC_frt = zeig%coh%litC_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart
zeig%coh%litN_frt = zeig%coh%litN_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart/spar(taxnr)%cnr_frt
zeig%coh%litC_crt = zeig%coh%litC_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart
zeig%coh%litN_crt = zeig%coh%litN_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart/spar(taxnr)%cnr_crt
hconvd = 1000. / kpatchsize
do i = 1,nspec_tree
! delayed litter fall from dead stems and twigs/branches
help = zeig%coh%ntreem*zeig%coh%x_tb*cpart*hconvd
helpN = zeig%coh%ntreem*zeig%coh%x_tb*cpart/spar(taxnr)%cnr_tbc*hconvd
help1 = zeig%coh%ntreem*(zeig%coh%x_sap+zeig%coh%x_hrt)*cpart*hconvd
help1N = zeig%coh%litC_stem/spar(taxnr)%cnr_stem*hconvd
do j = 1, lit_year
dead_wood(taxnr)%C_tb(j) = dead_wood(taxnr)%C_tb(j) + help/lit_year
dead_wood(taxnr)%N_tb(j) = dead_wood(taxnr)%N_tb(j) + helpN/lit_year
dead_wood(taxnr)%C_stem(j) = dead_wood(taxnr)%C_stem(j) + help1/lit_year
dead_wood(taxnr)%N_stem(j) = dead_wood(taxnr)%N_stem(j) + help1N/lit_year
enddo ! j (lit_year)
enddo ! i (nspec_tree)
end if
zeig=>zeig%next
end do
END SUBROUTINE beetle_nat
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! management of stands with bark beetle infestation
SUBROUTINE beetle_man(dis_rel_ip, rel_cra)
use data_manag
use data_simul
use data_species
use data_stand
use data_par
implicit none
real :: dis_cra, tot_cra, rel_cra, dis_rel_ip, tot_ba, dis_ba, tar_ba
real :: help
integer :: taxnr
dis_cra = 0
tot_cra = 0
help = 0
dis_ba = 0
tot_ba = 0
zeig=>pt%first
do
if(.not.associated(zeig)) exit
tot_cra = tot_cra + zeig%coh%crown_area*zeig%coh%ntreea
tot_ba = tot_ba + zeig%coh%ntreea*pi*zeig%coh%diam*zeig%coh%diam/4
if(zeig%coh%species.eq.2.and. zeig%coh%x_age.gt.50) then
dis_cra = dis_cra + zeig%coh%crown_area*zeig%coh%ntreea
dis_ba = dis_ba + zeig%coh%ntreea*pi*zeig%coh%diam*zeig%coh%diam/4
end if
zeig=>zeig%next
end do
rel_cra = (tot_cra/dis_cra)* dis_rel_ip/100.
tar_ba = dis_ba * dis_rel_ip/100.
do while (help.lt.tar_ba.and.help.ne.dis_ba)
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.2.and. zeig%coh%x_age.gt.50.and.zeig%coh%ntreea.ne.0) then
zeig%coh%ntreea = zeig%coh%ntreea -1
zeig%coh%nta = zeig%coh%ntreea
zeig%coh%ntreem = zeig%coh%ntreem +1
help = help + zeig%coh%crown_area
help = help + pi*zeig%coh%diam*zeig%coh%diam/4
if(help.eq.dis_ba) exit
if(help.gt. tar_ba) exit
end if
zeig=>zeig%next
end do
end do
zeig=>pt%first
do
if(.not.associated(zeig)) exit
taxnr = zeig%coh%species
IF (taxnr.eq.2.and. zeig%coh%x_age.gt.50.and.zeig%coh%ntreem.ne.0) then
! stems, twigs and branches are completely removed
zeig%coh%litC_fol = zeig%coh%litC_fol + zeig%coh%ntreem*(1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart
zeig%coh%litN_fol = zeig%coh%litN_fol + zeig%coh%ntreem*((1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart)/spar(taxnr)%cnr_fol
zeig%coh%litC_frt = zeig%coh%litC_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart
zeig%coh%litN_frt = zeig%coh%litN_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart/spar(taxnr)%cnr_frt
zeig%coh%litC_crt = zeig%coh%litC_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart
zeig%coh%litN_crt = zeig%coh%litN_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart/spar(taxnr)%cnr_crt
end if
zeig=>zeig%next
end do
END SUBROUTINE beetle_man
!##########################!
!! DEFOLIATOR DISTURBANCES !!
!##########################!
SUBROUTINE disturbance_defoliator
use data_manag
use data_soil_cn
use data_simul
use data_stand
use data_site
use data_species
use data_par
implicit none
real :: loss, remain, humusnew, humusneuin
character(50) :: helpout
helpout='disturbance_defoliator'
if (flag_standup .eq. 0) flag_standup = 1 ! call stand_balance later
humusnew=0.
remain=1.0
loss=dis_rel(dis_control(1,2))
if (loss .lt. 0.0) loss=0.0
if (loss .gt. 1.0) loss=1.0
remain=1.0-loss
if (remain .lt. 0.0) remain=0.0
if (remain .gt. 1.0) remain=1.0
if (loss .gt. 0.01) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if (zeig%coh%species .le. nspec_tree) then
zeig%coh%x_fol_loss=zeig%coh%x_fol*loss
zeig%coh%x_fol=zeig%coh%x_fol*remain
endif
zeig=>zeig%next
end do
write(*,*)helpout
endif ! loss>0.01
END SUBROUTINE disturbance_defoliator
!#####################!
!! XYLEM DITURBANCES !!
!#####################!
SUBROUTINE disturbance_xylem
use data_manag
use data_simul
use data_stand
use data_site
use data_species
use data_par
use data_soil
implicit none
real :: loss, remain
character(50) :: helpout
if (flag_standup .eq. 0) flag_standup = 1 ! call stand_balance later
helpout='disturbance_xylem'
xylem_dis=1.0-dis_rel(dis_control(2,2))
if (xylem_dis .lt. 0.0) xylem_dis=0.0if (xylem_dis .gt. 1.0) xylem_dis=1.0
write(*,*)helpout
END SUBROUTINE disturbance_xylem
!######################!
!! PHLOEM DITURBANCES !!
!######################!
SUBROUTINE disturbance_phloem
use data_manag
use data_simul
use data_stand
use data_site
use data_species
use data_par
implicit none
character(50) :: helpout
if (flag_standup .eq. 0) flag_standup = 1 ! call stand_balance later
helpout='disturbance_phloem'
phlo_feed=1.0-dis_rel(dis_control(3,2))
if (phlo_feed .lt. 0.0) phlo_feed=0.0
if (phlo_feed .gt. 1.0) phlo_feed=1.0
write(*,*)helpout
END SUBROUTINE disturbance_phloem
!####################!
!! ROOT DITURBANCES !!
!####################!
SUBROUTINE disturbance_root
use data_manag
use data_simul
use data_stand
use data_site
use data_species
use data_par
implicit none
real :: loss, remain
character(50) :: helpout
if (flag_standup .eq. 0) flag_standup = 1 ! call stand_balance later
remain=1.0
loss=dis_rel(dis_control(4,2))
if (loss .lt. 0.0) loss=0.0
if (loss .gt. 1.0) loss=1.0
remain=1.0-loss
if (remain .lt. 0.0) remain=0.0
if (remain .gt. 1.0) remain=1.0
helpout='disturbance_root'
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if (zeig%coh%species .le. nspec_tree) then
zeig%coh%x_frt_loss=zeig%coh%x_frt*loss
zeig%coh%x_frt=zeig%coh%x_frt*remain
endif
zeig=>zeig%next
end do
write(*,*)helpout
END SUBROUTINE disturbance_root
!####################!
!! STEM DITURBANCES !!
!####################!
SUBROUTINE disturbance_stem
use data_manag
use data_simul
use data_stand
use data_site
use data_species
use data_par
implicit none
character(50) :: helpout
if (flag_standup .eq. 0) flag_standup = 1 ! call stand_balance later
helpout='disturbance_stem'
stem_rot=dis_rel(dis_control(5,2))
if (stem_rot .lt. 0.0) stem_rot=0.0
if (stem_rot .gt. 1.0) stem_rot=1.0
write(*,*)helpout
END SUBROUTINE disturbance_stem
!####################!
!! MISTLETOE INFECTION !!
!####################!
! mistletoe cohort is produced in prepstand.f