!*****************************************************************!
!* *!
!* Post Processing for 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines: *!
!* *!
!* - calculate_product_lines: calculate product lines from the *!
!* mansort input *!
!* *!
!* - calculate_wood_processing: calculates wood processing *!
!* product lines after processing *!
!* *!
!* - calculate_use_categories: prepare use_categories module *!
!* for use in the simulation *!
!* *!
!* 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 *!
!* *!
!*****************************************************************!
!***************************************************************
! calculate producl lines from the mansort input
! input: data_mansort
! output: wood_processing
!***************************************************************
subroutine calculate_product_lines
use data_wpm
implicit none
integer i, j, index
real volume, volume_wob, pi, summe
character(4) act_typus
integer act_spec, act_year, set_year
pi = 3.1415926536 ! PI
j = 0 ! nr_management_years
i = nr_years
wpm_manag_years = 0
! set the first year, set an ima
act_year = first_mansort%mansort%year
set_year = first_mansort%mansort%year + 1
! set the run pointer to the begin of the list
act_mansort => first_mansort
act_manrec => first_manrec
! check if last management year was some years ealier
do while (act_year < act_mansort%mansort%year)
act_mansort => act_mansort%next
end do
do while (associated(act_mansort))
! check the management year
if ( act_year <= act_manrec%manrec%year .and. &
act_manrec%manrec%year /= set_year ) then
! check the management in actual year
if (trim(act_manrec%manrec%management) .ne. 'tending' .and. &
trim(act_manrec%manrec%management) .ne. 'brushing' ) then
! set next value for actual manrec year
j = j+1
wpm_manag_years = wpm_manag_years + 1
management_years(j) = act_manrec%manrec%year
set_year = act_manrec%manrec%year
endif
if( associated(act_manrec%next) ) then
act_manrec => act_manrec%next
end if
endif
act_spec = act_mansort%mansort%spec
act_typus = act_mansort%mansort%typus
! calculate carbon for the actual line in mansort
volume = act_mansort%mansort%dw * act_mansort%mansort%number
if (wob) then
! without bark
volume_wob = volume * &
(act_mansort%mansort%diam_wob * act_mansort%mansort%diam_wob) / &
(act_mansort%mansort%diam * act_mansort%mansort%diam)
else
! with bark
volume_wob = volume
end if
! logs (L)
if ( trim(act_typus) == 'ste1' .or. trim(act_typus) == 'ste2') then
! logs (L) softwood
if( act_spec == 2 .or. act_spec == 3) then
index = 1
! logs (L) hardwood
elseif ( act_spec == 1 .or. act_spec == 4 .or. act_spec == 5) then
index = 2
end if
! partial logs (LAS)
elseif( trim(act_typus) == 'sg1' .or. trim(act_typus) == 'sg2') then
! partial logs (LAS) softwood
if( act_spec == 2 .or. act_spec == 3) then
index = 3
! partial logs (LAS) hardwood
elseif ( act_spec == 1 .or. act_spec == 4 .or. act_spec == 5) then
index = 4
end if
! industrial wood
elseif ( trim(act_typus) == 'in1' .or. trim(act_typus) == 'in2') then
index = 5
! fuelwood
elseif ( trim(act_typus) == 'fue' ) then
index = 7
end if
if (j == 0) then
product_lines(index)%value(1) = product_lines(index)%value(1) + volume_wob
product_lines(7)%value(1) = product_lines(7)%value(1) + (volume - volume_wob)
else
product_lines(index)%value(j) = product_lines(index)%value(j) + volume_wob
product_lines(7)%value(j) = product_lines(7)%value(j) + (volume - volume_wob)
end if
! after using the mansort list item, go to the next
act_mansort => act_mansort%next
if (associated(act_mansort)) then
act_year = act_mansort%mansort%year
end if
end do
! sum up input
do i=1, wpm_manag_years
summe = 0.
do j = 1, nr_pr_ln
summe = summe + product_lines(j)%value(i)
end do
sum_input(management_years(i)) = summe
! calculate emission from harvesting process
emission_har (management_years(i)) = summe * sub_par(1)
! write (9999,*) emission_har(management_years(i)), management_years(i)
end do
end subroutine calculate_product_lines
!***************************************************************
! calculate wood processing
! input: wood_processing
! output: wood_processing
!***************************************************************
subroutine calculate_wood_processing
use data_wpm
implicit none
integer i,j,k
integer, dimension(2) :: s
real, dimension(nr_pr_ln) :: ext
ext = 0
! for each parameter set
s = shape(product_lines(1)%proc_par)
do k=1, s(1)
! for each year of manrec
do i=1,size(management_years)
! all lines read
if (management_years(i) == 0) then
exit
end if
! percentual distribution of wood types after processing
do j=1,nr_pr_ln
ext = ext + product_lines(j)%proc_par(k,:)*product_lines(j)%value(i)
end do
! save the result in product_lines
do j=1,nr_pr_ln
product_lines(j)%value(i) = ext(j)
! save the initial values for the intermediate output
pl(k,j,management_years(i)) = ext(j)
end do
ext(:) = 0.
end do
end do
end subroutine calculate_wood_processing
!**********************************************************************
! prepare use_categories module for use in the simulation
subroutine calculate_use_categories
use data_wpm
implicit none
integer i, j, l, k
real val
j = 1
i = size(years)
do while(i > 0 .and. j .le. size(management_years))
if ( years(i) == management_years(j)) then
val = 0
! for every use category, for every product line
do k=1,nr_use_cat
do l=1,nr_pr_ln
val = val + product_lines(l)%value(j)*product_lines(l)%use_par(k)
end do
use_categories(k)%value(i) = val
use_cat(k,i) = val
val = 0
end do
! set rest pools
burning(i) = product_lines(7)%value(j)
landfill(i) = 0.
j = j + 1
end if
i = i - 1
end do
end subroutine calculate_use_categories