Forked from
4C / FORESEE
206 commits behind the upstream repository.
-
Petra Lasch-Born authoredPetra Lasch-Born authored
management.f 31.35 KiB
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines for: *!
!* management *!
!* contains: *!
!* SR manag_ini *!
!* SR manag_menu *!
!* SR simple_ini *!
!* SR adap_ini *!
!* SR management *!
!* SR simple_manag *!
!* SR adap_manag *!
!* SR target_manag *!
!* SR target_ini *!
!* *!
!* 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 manag_ini
use data_manag
use data_simul
use data_stand
implicit none
!call manag_menu
select case(flag_mg)
case(1)
call simple_ini
case(2)
if(anz_spec.ne.0) call adap_ini
case(3, 33)
call target_ini
case(44)
call man_liocourt_ini
case(8)
call aspman_ini
case(9)
call aust_ini
end select
contains
SUBROUTINE simple_ini
! read definition of simple thinning from file
integer :: manag_unit,i
character(len=150) :: filename
logical :: ex
manag_unit=getunit()
filename = manfile(ip)
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
read(manag_unit,*) thin_nr ! number of thinning years
allocate(thin_year(thin_nr));allocate(thin_tree(thin_nr))
do i=1,thin_nr
read(manag_unit,*) thin_year(i),thin_tree(i)
end do
close(manag_unit)
end SUBROUTINE simple_ini
end SUBROUTINE manag_ini!-------------------------------------------------
! control of management regime and call
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE management
use data_simul
use data_stand
use data_species
use data_manag
use data_out
implicit none
integer diffanz
if (flag_standup .eq. 0) flag_standup = 1
select case(flag_mg)
case(1)
call simple_manag
case(2)
call adap_manag
case(3, 33)
call target_manag
case(44)
call liocourt_manag
case(8)
call asp_manag
case(9)
call aust_manag
case(10)
call dis_manag
case default
end select
contains
SUBROUTINE simple_manag
integer taxnr, cohnr
real minheight
! simple thinning with fitting to default stem number
if(anz_tree>thin_tree(act_thin_year)) then
diffanz = anz_tree - thin_tree(act_thin_year)
minheight = 100000.
do
!repeat while diffanz>0)
if(diffanz<0.1) exit
zeig=>pt%first
!search for cohort with minimal height
do
if(.not.associated(zeig)) exit
if(zeig%coh%ntreea>0.1 .and. zeig%coh%height<minheight)then
minheight=zeig%coh%height; cohnr=zeig%coh%ident
endif
zeig=>zeig%next
enddo
! delete smallest trees
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%ident==cohnr)then
if(diffanz <= zeig%coh%ntreea) then
zeig%coh%ntreea = zeig%coh%ntreea - diffanz
zeig%coh%ntreem = diffanz
diffanz=0.
else
diffanz = diffanz - zeig%coh%ntreea
zeig%coh%ntreem = zeig%coh%ntreea
zeig%coh%ntreea = 0.
endif
minheight=100000.
exit endif
zeig=>zeig%next
enddo
enddo
else
call error_mess(time,"no management possible, tree number undersized : ", REAL(anz_tree))
endif
! number of trees and litter pools of managed trees
zeig=>pt%first
anz_tree=0.
do
if(.not.associated(zeig)) exit
taxnr=zeig%coh%species
anz_tree=anz_tree+zeig%coh%ntreea
if(zeig%coh%ntreem>0 .and.zeig%coh%ntreed==0.)then
zeig%coh%litC_fol = zeig%coh%litC_fol + (1.-spar(taxnr)%psf)*zeig%coh%x_fol/2.
zeig%coh%litN_fol = zeig%coh%litN_fol + ((1.-spar(taxnr)%psf)*zeig%coh%x_fol/2.)*0.02
zeig%coh%litC_frt = zeig%coh%litC_frt + zeig%coh%x_frt/2.
zeig%coh%litN_frt = zeig%coh%litN_frt + (zeig%coh%x_frt/2.)*0.023
endif
zeig=>zeig%next
enddo
end SUBROUTINE simple_manag
end SUBROUTINE management
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! input of control parameters for adaptation management
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE adap_ini
use data_manag
use data_simul
use data_species
use data_stand
use data_out
implicit none
! read definition of adapted thinning from file
integer :: manag_unit,i,j
character(len=150) :: filename
logical :: ex
character ::text
manag_unit=getunit()
filename = manfile(ip)
allocate(zbnr(nspec_tree))
allocate(tend(nspec_tree))
allocate(rot(nspec_tree))
allocate(thin_flag1(nspec_tree))
allocate(thin_flag2(nspec_tree))
allocate(thin_flag3(nspec_tree))
allocate(thin_flag4(nspec_tree))
allocate(regage(nspec_tree))
allocate(np_mod(nspec_tree))
allocate(thinyear(nspec_tree))
allocate(specnr(nspec_tree))
allocate(age_spec(nspec_tree))
allocate(anz_tree_spec(nspec_tree))
thinyear =0
thin_flag1=0
thin_flag2=0
thin_flag3=0
thin_flag4=0
flag_manreal = 0
flag_shelter = 0
shelteryear = 0
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
! read head of data-file do
read(manag_unit,*) text
if(text .ne. '!')then
backspace(manag_unit);exit
endif
enddo
! dominant species
read(manag_unit,*) domspec
! domimant height levels
read(manag_unit,*) ho1,ho2,ho3,ho4
! thinning regimes
read (manag_unit,*) thin_flag1(1),thr1, thr2,thr3,thr4,thr5,thr6, thr7, mgreg, domspec_reg
do j=2,nspec_tree
thin_flag1(j)= thin_flag1(1)
end do
if(thin_flag1(1) <0) then
close(manag_unit)
return
end if
! limit for hight query
read (manag_unit,*) limit
!test
limit = limit + 30.
! number of years between thinning
read (manag_unit,*) thinstep
! relative thinning for young trees
read (manag_unit,*) direcfel
! control variables for thinning depending on basal area
read (manag_unit,*) thin_ob, optb
! number of 'Zielb�ume' (target trees)
read (manag_unit,*) (zbnr(i), i =1, nspec_tree)
! relative thinning value for tending of plantations
read (manag_unit,*) (tend(i), i =1, nspec_tree)
! rotation
read (manag_unit,*) (rot(i), i =1, nspec_tree)
! age of natural/planted regeneration
read (manag_unit,*) (regage(i), i =1, nspec_tree)
do j= 1,20
read (manag_unit,*) (usp(j,i), i=1,13)
end do
read (manag_unit,*) (np_mod(i), i = 1,nspec_tree)
close(manag_unit)
if (flag_reg .ne. 0) then
WRITE(unit_ctr,*) ' '
WRITE(unit_ctr,*) '***Managment parameter case flag_mg = 2 (user specified) ***'
WRITE(unit_ctr,'(A35,4F15.5)') 'height for management control(cm)', ho1,ho2,ho3,ho4
WRITE(unit_ctr,'(A35,6I15)') 'man. flags thin_flag1, thr1-thr5' , thin_flag1(1),thr1,thr2, thr3,thr4,thr5
WRITE(unit_ctr,'(A35,F15.5)') 'height for directional felling', thr6
WRITE(unit_ctr,'(A35,I15)') 'measure at rotation', thr7
WRITE(unit_ctr,'(A35,I15)') 'regeneration measure', mgreg
WRITE(unit_ctr,'(A35,F15.5)') 'lower/upper limit of height(cm)', limit
WRITE(unit_ctr,'(A35,I15)') 'number of years between thinning',thinstep
WRITE(unit_ctr,'(A35,F15.5)') 'rel. value for directional felling', direcfel
WRITE(unit_ctr,'(A35,2F15.5)') 'thinning depending on basal area function thin_ob (0,1), optb ', thin_ob, optb
WRITE(unit_ctr,'(A35,5F15.5)')'number of Zielb�ume (spec.)', (zbnr(i),i=1,nspec_tree)
WRITE(unit_ctr,'(A35,5F15.5)')'rel. value for tending of pl.',(tend(i), i =1,nspec_tree)
WRITE(unit_ctr,'(A35,5I15)')'rotation ',(rot(i), i =1,nspec_tree)
WRITE(unit_ctr,'(A35,5I15)')'age of nat./pl. regeneration',(regage(i), i =1,nspec_tree)
close(unit_ctr)
end if
end SUBROUTINE adap_ini
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! routines for adaptation management
! based on concepts from P. Mohr, P.Lasch. D. Gerold....
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE adap_manag
use data_stand
use data_manag use data_simul
use data_par
use data_species
implicit none
real :: c1, &
helphd,helpmax, helpi, & ! hdom species specific
domage
real :: sumdh, sumd ! for calculation of HG
real :: bg ! stocking degree
real :: stage
real :: dfbg ! optimal basal area
real :: hg ! height of DG
integer :: c2, &
taxnr, &
actspec, & ! number of species for thinning
th_help, i,j ,k, &
testflag, &
nrfel, &
flag_prep, &
flag_fell, &
inum, &
domage_sh, &
domspec_sh, &
flag_reg_act
real,dimension(nspecies) :: bas_area_spec
real,dimension(nspecies) :: help
flag_reg_act = 100
domage = 0.
domspec_sh = 0
help = 0.
helpmax = 0.
helpi =0
bas_area_spec = 0.
domage_sh = 0
flag_fell = 0
stand_age=0
flag_prep = 0
anz_tree_spec = 0
anz_tree_dbh = 0
flag_adapm = 0.
specnr = 0.
age_spec = 0.
basarea_tot = 0.
sumd = 0.
sumdh = 0.
! determine number of species in cohort list
if(anz_spec.eq.0) return
if(thin_flag1(1) <0) return
IF(anz_spec.eq.1) then
! stand age as maximum age of cohorts
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.le.nspec_tree) then
taxnr = zeig%coh%species
if(zeig%coh%x_age.gt. stand_age) stand_age = zeig%coh%x_age
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0.) then
sumd = sumd + zeig%coh%diam*zeig%coh%diam
sumdh = sumdh + zeig%coh%diam*zeig%coh%diam*zeig%coh%height
basarea_tot = basarea_tot + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
bas_area_spec(taxnr) = bas_area_spec(taxnr) + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
end if
end if
zeig=>zeig%next
END DO
ELSE if(anz_spec.gt.1) then
! age of species i as maximum age of cohorts of this species
testflag = 0
i=1
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
taxnr = zeig%coh%species
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0.) then
basarea_tot = basarea_tot + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
bas_area_spec(taxnr) = bas_area_spec(taxnr) + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
end if
if(i.eq.1) then
specnr(i) = zeig%coh%species
if(zeig%coh%x_age.gt. age_spec(i)) age_spec(i) = zeig%coh%x_age
i = i+1
else
do j= 1,i-1
if(specnr(j).eq. zeig%coh%species) testflag = 1
end do
if (testflag.eq.0) then
specnr(i) = zeig%coh%species
if(zeig%coh%x_age.gt. age_spec(i)) age_spec(i) = zeig%coh%x_age
i = i+1
end if
testflag=0
end if
zeig=>zeig%next
END DO
DO i =1,anz_spec
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.eq.specnr(i).and.zeig%coh%x_age.gt. age_spec(i)) age_spec(i)= zeig%coh%x_age
zeig=>zeig%next
END DO
END DO
! if domspec is -99 then domspec is calculated by basal area
if( domspec.lt. 0 ) then
DO i = 1,nspecies
if (basarea_tot.ne.0) then
help(i) = bas_area_spec(i)/basarea_tot
if(help(i).gt. helpmax) then
helpmax = help(i)
helpi = i
end if
end if
end do
domspec = helpi
end if
! re-sorting of the filed specnr (at the first place of this field is the number of the dominanat species);
! this is necessary for managemnt of mixed stands becuase this management is according to the management
! of the dominanat species
! age of domspec
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.eq.domspec) then
if(zeig%coh%x_age.gt.domage) domage = zeig%coh%x_age
end if
zeig=>zeig%next END DO
if(specnr(1).ne.domspec) then
do k=2,anz_spec
if(specnr(k).eq.domspec) then
specnr(k)=specnr(1)
age_spec(k)=age_spec(1)
specnr(1) = domspec
age_spec(1)=domage
exit
end if
end do
end if ! re-sorting
! species for shelterwood which is oldest
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%shelter.eq.1.and.zeig%coh%x_age.gt.domage.and.zeig%coh%x_age.gt.domage_sh) domage_sh = zeig%coh%x_age
zeig=>zeig%next
END DO
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%x_age.eq.domage_sh) domspec_sh = zeig%coh%species
zeig=>zeig%next
END DO
END IF
if (anz_spec.eq.1) then
specnr(1) = taxnr
age_spec(1) = stand_age
if(domspec.lt.0) domspec = taxnr
end if
DO i=1,anz_spec
anz_tree_spec(i) = 0
! caclulation of species specific number of trees
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%ntreem = 0.
if(zeig%coh%diam.gt.0) anz_tree_dbh = anz_tree_dbh + zeig%coh%ntreea
if(zeig%coh%species.eq.specnr(i)) anz_tree_spec(i) = anz_tree_spec(i) + zeig%coh%ntreea
zeig=> zeig%next
end do
END DO ! species loop
if(domspec.lt.0) then
if(domage_sh.gt.domage) then
domage = domage_sh
domspec = domspec_sh
end if
end if
DO i=1,anz_spec
actspec = specnr(i)
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.le.nspec_tree) then
taxnr = zeig%coh%species
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0..and.zeig%coh%species.eq.taxnr) then
stage = zeig%coh%x_age
sumd = sumd + zeig%coh%diam*zeig%coh%diam
sumdh = sumdh + zeig%coh%diam*zeig%coh%diam*zeig%coh%height
end if
end if
zeig=>zeig%next
END DO
! calculation HG (height for DG)
if(sumdh.ne.0) then
hg = (sumdh/sumd)/100.
else
hg = 0.
end if
IF (specnr(i).ne.0..and. domspec.ne.0) THEN
select case(thr7)
case(1) ! thr7
! shelterwood management
if(domspec.eq.actspec) then
if (age_spec(i).ge.regage(specnr(i)).and. age_spec(i).lt.(rot(specnr(i))-15.).and. time.ne.1) then
if(shelteryear.eq.0.and.flag_shelter.eq.0) flag_reg = mgreg
inum = i
if (flag_sh_first.ne.2) then
call shelterwood_man(specnr(inum),inum,domage)
end if
if(shelteryear.eq.0) flag_sh_first = 1
flag_shelter = 1
if(flag_sh_first.ne.2) then
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
end if
flag_prep = 1
else if (age_spec(i).ge.rot(specnr(i)).and. time.ne.1) then
! clear felling
nrfel = specnr(i)
call felling(nrfel,i)
flag_manreal = 1
flag_shelter = 0
maninf = 'felling after shelterwood s.'
meas = 0
! set back because shelterwood m. is finished, management of regenerated stand starts
shelteryear = 0.
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_prep = 1
if(flag_plant_shw.eq.1) then
! if no first and second sherterwood management was possibele than after clear cut planting is called
select case(mgreg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) then
flag_reg = mgreg
call planting
end if
flag_reg = 0
flag_reg_act = 0
flag_plant_shw =0
end select
end if
! if initial age is grater than age for first shleterwood treatment
else if(time.eq.1.and. age_spec(i).gt.regage(specnr(i)).and. age_spec(i).gt.(rot(specnr(i))-20) ) then
! flags for planting if felling is realised
flag_plant_shw = 1
flag_reg_act = 1
! in this case: to avoid sheletrwood management until rotation time
flag_sh_first = 2
shelteryear = 99
! labelling of cohorts as sheletrwood cohorts
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%shelter=1
zeig=> zeig%next
end do
exit
else if(time.eq.1.and. age_spec(i).gt.regage(specnr(i)).and. age_spec(i).le.(rot(specnr(i))-20.)) then
! if initial age is greater than regeneration age(first shelterwood treatm.) and not too near to rotation age
! a new rotation age is defined with delaying
rot(specnr(i)) = rot(specnr(i)) + (age_spec(i) - regage(specnr(i)))
if(shelteryear.eq.0.and.flag_shelter.eq.0) flag_reg = mgreg
inum = i
call shelterwood_man(specnr(inum),inum,domage)
if(shelteryear.eq.0) flag_sh_first = 1
flag_shelter = 1
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
end if
else if(domspec.ne.actspec) then
if (domage.ge.regage(domspec).and.domage.lt.(rot(domspec)-15.)) then
if(shelteryear.eq.0) flag_reg = mgreg
inum=i
call shelterwood_man(specnr(inum),inum, domage)
flag_shelter = 1
if(shelteryear.eq.0) flag_sh_first = 1
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
flag_prep = 1
else if(thr7.eq.1 .and. domage.eq.rot(domspec)) then
else if(actspec.eq.rot(actspec)) then
! clear felling
nrfel = specnr(i)
call felling(nrfel,i)
flag_manreal = 1
flag_shelter = 0
maninf = 'felling after shelterwood s.'
meas = 0
! set back because shelterwood m. is finished, management of regenerated stand starts
shelteryear = 0.
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_prep = 1
end if
end if
case(2) ! thr7
! clear felling
if(age_spec(i).ge.(rot(specnr(i))-15).and.age_spec(i).lt.rot(specnr(i)) ) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.specnr(i).and. zeig%coh%x_age.eq. age_spec(i)) zeig%coh%shelter = 1
zeig=>zeig%next
end do
flag_prep = 1
else if (age_spec(i).eq.rot(specnr(i))) then
nrfel = specnr(i)
call felling (nrfel,i)
flag_manreal = 1
flag_fell = 1
thinyear(actspec) = time
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
maninf = 'felling'
meas =0
call input_manrec
else if(age_spec(i).gt. rot(specnr(i)).and. time.eq.1) then
nrfel = specnr(i)
call felling (nrfel,i)
flag_manreal = 1
flag_fell = 1
thinyear(actspec) = time
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
maninf = 'felling'
meas =0
call input_manrec
end if
case default
end select
! tending of plantations (Jungwuchspflege)
! test if rotation age is not during the next 15 years
IF (flag_prep .eq. 0. .and. flag_shelter .eq.0) then
helphd= svar(specnr(i))%dom_height
if ( thinonce.eq.1) then
c1 = ho3
c2 = thr4
CALL thinning (c1,c2,actspec,i)
flag_manreal=1
maninf = 'thinning'
meas = thr1
thinyear(actspec)=time
call input_manrec
end if
if( thinonce.eq.0) then
IF ( (helphd.ge.(ho1-60.).and. helphd.le.(ho1+60.)).and. thin_flag1(actspec).eq.0) THEN
CALL tending(actspec,i)
flag_manreal = 1
maninf = 'tending'
meas = 0
call input_manrec
thin_flag1(actspec)=1
flag_adapm = 1
! management at different dominant heights
ELSE IF( helphd.ge.(ho1-60).and.helphd.le.(ho4+limit)) then
IF((helphd.ge.(ho2-limit).and. helphd.le.(ho2+limit)).and. (thin_flag2(actspec).eq.0).or.( thin_flag2(actspec).eq.0.and. thin_flag2(domspec).eq.1))THEN
if(actspec.eq.domspec .or. thin_flag2(domspec).eq.1) then
c1= ho2
c2= thr1
thin_flag2(actspec)=1
maninf = 'brushing'
! if beech, spruce, oak then tending else thinning based on basal area
if(actspec.ne.3)then
! Mod. for Cornelia
CALL tending(actspec,i)
else
CALL thinning (c1,c2,actspec,i)
end if
flag_manreal=1
meas = thr1
thinyear(actspec)=time
call input_manrec
end if
ELSE IF((helphd.ge.(ho3-limit).and. helphd.le.(ho3+limit)).and. (thin_flag3(actspec).eq.0).or.( thin_flag3(actspec).eq.0.and. thin_flag3(domspec).eq.1)) THEN
if(actspec.eq.domspec .or. thin_flag3(domspec).eq.1) then
c1= ho3
c2= thr2
thin_flag3(actspec)= 1
CALL thinning (c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr2
thinyear(actspec)=time
call input_manrec
end if
ELSE IF( (helphd.ge.(ho4-limit).and. helphd.le.(ho4+limit)).and. (thin_flag4(actspec).eq.0).or.( thin_flag4(actspec).eq.0.and. thin_flag4(domspec).eq.1)) THEN if(actspec.eq.domspec .or. thin_flag3(domspec).eq.1) then
c1= ho4
c2= thr3
thin_flag4(actspec)= 1
CALL thinning (c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr3
call input_manrec
thinyear(actspec) = time
end if
ENDIF
! directinal felling if not done yet
flag_adapm = 1
ELSE IF(helphd.gt. (ho4+limit)) THEN
! calculation of stocking degree
call calc_gfbg(dfbg, actspec, stage, hg)
dfbg = dfbg*kpatchsize
bg = bas_area_spec(actspec)*bas_area_spec(actspec)/(basarea_tot*dfbg)
th_help = time-thinyear(actspec)
IF(th_help.ge.thinstep.or.(bg.gt.(optb).and.time.lt.thinstep.and.thinyear(actspec).eq.0)) THEN
c1 = 0.
c2 = thr4
if( age_spec(i).lt.(rot(specnr(i))-15)) then
CALL thinning(c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr4
thinyear(actspec) = time
!wpm
call input_manrec
flag_adapm = 1
end if
ENDIF
END IF
END IF
end if ! thinonce
END IF ! flag_prep
END DO ! species loop
if(maninf.eq.'felling after shelterwood s.') domspec = -99
if(thr7.eq.1 .and.(maninf.eq.'felling after shelterwood s.'.or. &
maninf.eq.'shelterwood system1'.or.maninf.eq.'shelterwood system2') ) then
call input_manrec
maninf =trim(maninf)//'out'
end if
if(flag_sh_first.eq.1) then
shelteryear=time
flag_sh_first = 0
end if
if(maninf.eq.'felling after shelterwood s.') then
domspec = domspec_reg
end if
! regeneration/planting if felling was realised
if(flag_fell.eq.1.and. mgreg.ne.0) then
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
! shelterwood management is switched off
thr7 = 0
case(4,5,6,7,8,9,10,11,12,13,14)! artificial regeneration (planting)
flag_reg = mgreg
call planting
thinyear(actspec) = time
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_reg = 0
domspec = domspec_reg
end select
end if
! calculation of total dry mass of all harvested trees
sumvsab = 0.
sumvsab_m3 = 0.
svar%sumvsab = 0.
if(maninf.ne.'tending'.or. flag_brush.eq.0) then
zeig=>pt%first
do while (associated(zeig))
ns = zeig%coh%species
sumvsab = sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
sumvsab_m3 = sumvsab_m3 + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)/(spar(ns)%prhos*1000000)
svar(ns)%sumvsab = svar(ns)%sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
zeig=>zeig%next
end do
sumvsab = sumvsab * 10000./kpatchsize ! kg/ha
sumvsab_m3 = sumvsab_m3 * 10000./kpatchsize ! kg/ha
do k = 1, nspec_tree
svar(k)%sumvsab = svar(k)%sumvsab * 10000./kpatchsize ! kg/ha
end do
! cumulative harvested stem mass
cumsumvsab = cumsumvsab + sumvsab
end if
call class_man
END SUBROUTINE adap_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! management routine with fitting stem biomass on target values of stem biomass
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE target_manag
USE data_manag
USE data_stand
USE data_species
USE data_simul
implicit none
integer taxnr,k,i
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.le.nspec_tree) then
stand_age = zeig%coh%x_age
taxnr = zeig%coh%species
exit
end if
zeig => zeig%next
end do
! stand manamgent at rotaiotn age
if(taxnr.le.nspec_tree) then
if(stand_age.ne.0) then
select case(thr7)
case(1) ! shelterwood manamgent
case(2) ! clear felling
if(stand_age.eq.(rot(taxnr)-15)) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.taxnr) zeig%coh%shelter = 1
zeig=>zeig%next
end do
return
else if (stand_age.ge.rot(taxnr)) then
call felling(taxnr,i)
flag_manreal = 1
maninf = 'felling'
meas =0
call input_manrec
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
! shelterwood management is switched off
thr7 = 0
case(10,11,12,13)
! modification for muilti-run option BRB
if(taxnr.eq.1) then
flag_reg = 11
else if(taxnr.eq.2) then
flag_reg = 13
else if(taxnr.eq.3) then
flag_reg = 10
else if (taxnr.eq.4) then
flag_reg = 12
else
flag_reg = 14
end if
! artificial regeneration (planting)
call planting
flag_reg = 0
end select ! mgreg
end if
end select ! thr7
end if
do i= 1, thin_nr
if(time .eq.thin_year(i)) then
if(thin_stor(i).eq.1.) then
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
case(10,11,12,13, 14, 17)
! artificial regeneration (planting)
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%underst = 0
zeig=>zeig%next
end do
flag_reg = mgreg
call planting
flag_reg = 0
end select ! mgreg
end if ! regeneration & planting
if (flag_mg.eq.3) then call target_thinning_OC (i)
else if(flag_mg.eq. 33) then
call target_thinning(i)
end if
flag_manreal = 1
maninf='thinning'
call input_manrec
end if
end do
! calculation of total dry mass of all harvested trees
sumvsab = 0.
sumvsab_m3 = 0.
svar%sumvsab = 0.
zeig=>pt%first
do while (associated(zeig))
ns = zeig%coh%species
sumvsab = sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
sumvsab_m3 = sumvsab_m3 + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)/(spar(ns)%prhos*1000000)
svar(ns)%sumvsab = svar(ns)%sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
zeig=>zeig%next
end do
sumvsab = sumvsab * 10000./kpatchsize ! kg/ha
sumvsab_m3 = sumvsab_m3 * 10000./kpatchsize ! kg/ha
do k = 1, nspec_tree
svar(k)%sumvsab = svar(k)%sumvsab * 10000./kpatchsize ! kg/ha
end do! cumulated harvested stem mass
cumsumvsab = cumsumvsab + sumvsab
end if
END SUBROUTINE target_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! input for target thinning
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE target_ini
! read definition of simple thinning from file
USE data_manag
USE data_simul
USE data_plant
USE data_species
integer :: manag_unit,i
character(len=150) :: filename
character ::text
logical :: ex
allocate(rot(nspec_tree))
allocate(thin_flag1(nspec_tree))
thin_flag1=-1
manag_unit=getunit()
filename = manfile(ip)
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
! read head of data-file
do
read(manag_unit,*) text
if(text .ne. '!')then
backspace(manag_unit);exit
endif
enddo
read(manag_unit,*) thr7 ! management for rotation year
read(manag_unit,*) mgreg ! regeneration in rotation year! rotation period
read (manag_unit,*) (rot(i), i =1, nspec_tree)
read (manag_unit,*) (numplant(i), i =1,nspec_tree)
read (manag_unit,*) thin_nr ! number of thinning years
allocate(thin_year(thin_nr));allocate(target_mass(thin_nr));
allocate(thin_spec(thin_nr));allocate(thin_tysp(thin_nr))
allocate(thin_stor(thin_nr))
do i=1,thin_nr
read(manag_unit,*) thin_year(i),target_mass(i), thin_spec(i), thin_tysp(i), thin_stor(i)
end do
close(manag_unit)
end SUBROUTINE target_ini