!! Implement forest management practices
!|author: Giovanni Ravazzani
! license: GPL
!
!### History
!
! current version 1.0 - 24th January 2020
!
! | version | date | comment |
! |----------|-------------|----------|
! | 1.0 | 24/Jan/2020 | Original code |
!
!### License
! license: GNU GPL
!
!### Module Description
! Routines to manage forest (silvocoltural practices)
!
MODULE PlantsManagement
!
! Modules used:
USE DataTypeSizes, ONLY : &
! Imported Type Definitions:
short, long, float
USE LogLib, ONLY: &
!Imported routines:
Catch
USE IniLib, ONLY : &
!Imported derived types:
IniList, &
!Imported routines:
IniOpen, IniClose , &
SectionIsPresent, KeyIsPresent, &
IniReadInt , IniReadReal , &
GetNofSubSections, IniReadString
USE GridLib, ONLY: &
!imported definitions:
grid_integer !, &
!imported routines:
!NewGrid
USE GridOperations, ONLY : &
!imported routines:
GridByIni
USE GridStatistics, ONLY: &
!imported routines:
UniqueValues
USE StringManipulation, ONLY: &
!imported routines:
ToString
USE Chronos , ONLY: &
!imported definitions:
DateTime, &
!imported variables:
timeString, &
!Imported operands:
OPERATOR ( - ), &
OPERATOR ( + ), &
ASSIGNMENT( = )
USE Units, ONLY: &
!imported parameters:
year
IMPLICIT NONE
!global variables
LOGICAL :: plants_management
TYPE (grid_integer) :: management_map
!global routines:
PUBLIC :: SetPlantsManagement
PUBLIC :: ApplyPlantsManagement
PUBLIC :: SetPractice
TYPE :: thinning
TYPE (DateTime) :: time !when plants are cut
REAL (KIND = float) :: intensity !percentage of plants to be cut
!used for reforestation
LOGICAL :: reforestation !true if reforestation is required
INTEGER (KIND = short) :: species !species for reforestation
REAL (KIND = float) :: density ! number of plants per hectar
REAL (KIND = float) :: age !(years)
REAL (KIND = float) :: dbh ! stem diameter at breast height (cm)
REAL (KIND = float) :: height !tree height (m)
REAL (KIND = float) :: stem_biomass !(t/ha)
REAL (KIND = float) :: root_biomass !(t/ha)
REAL (KIND = float) :: leaf_biomass !(t/ha)
REAL (KIND = float) :: lai ! leaf area index (m2/m2)
END TYPE thinning
TYPE :: Practice
INTEGER (KIND = short) :: id
TYPE (Thinning), ALLOCATABLE :: cuts (:)
INTEGER (KIND = short) :: current
TYPE (DateTime) :: next
END TYPE Practice
!local declarations:
TYPE (Practice), PRIVATE, ALLOCATABLE :: practices (:)
PRIVATE :: GetPos
!=======
CONTAINS
!=======
!==============================================================================
!| Description:
! Set variables and options to manage plants. Basically two options are
! available:
!
! 1. Regular thinning time interval and intensity. The percentage of plants
! is removed every time interval.
! 2. Specific dates when applying a given thinning intensity
!
! A different option can be specified for each stand (cell).
!
SUBROUTINE SetPlantsManagement &
!
(file, begin, end )
IMPLICIT NONE
!arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file !! file to configure plants management
TYPE (DateTime), INTENT (IN) :: begin !!simulation starting date
TYPE (DateTime), INTENT(IN) :: end !!simulation ending date
!local declarations:
TYPE(IniList) :: iniDB !!store configuration info
INTEGER (KIND = short) :: i, j
INTEGER (KIND = short), ALLOCATABLE :: uniques (:)
INTEGER (KIND = short), ALLOCATABLE :: active_practices (:)
INTEGER (KIND = short) :: count_practices
INTEGER (KIND = short) :: cuts !!number of cuts
INTEGER (KIND = short) :: interval !!thinning interval (years)
!---------------------------------------end of declarations--------------------
!load options
CALL IniOpen (file, iniDB)
!set management map
IF ( SectionIsPresent ( 'practice-map', iniDB) ) THEN
CALL GridByIni (iniDB, management_map, section = 'practice-map')
ELSE
CALL Catch ('error', 'PlantsManagement', 'practice-map missing in configuration file')
END IF
!find unique values in management_map
CALL UniqueValues (management_map, uniques)
!search active management practices
count_practices = 0
DO i = 1, SIZE (uniques)
IF ( SectionIsPresent ( ToString (uniques(i)), iniDB ) ) THEN
count_practices = count_practices + 1
ELSE
CALL Catch ('warning', 'PlantsManagement', 'section ' // TRIM (ToString (uniques(i)) ) // ' has no management associated' )
END IF
END DO
ALLOCATE ( active_practices ( count_practices) )
j = 0
DO i = 1, SIZE (uniques)
IF ( SectionIsPresent ( ToString (uniques(i)), iniDB ) ) THEN
j = j + 1
active_practices (j) = uniques (i)
END IF
END DO
ALLOCATE ( practices ( (count_practices) ) )
DO i = 1, count_practices
!set id
practices (i) % id = active_practices (i)
!check if regular interval thinning is required
IF ( KeyIsPresent (key = 'thinning-interval', iniDB = iniDB, &
section = ToString (active_practices(i)) ) ) THEN
interval = IniReadInt ( 'thinning-interval', iniDB, section = ToString (active_practices(i)) )
!compute how many cuts to do
cuts = (end - begin) / year / interval
ALLOCATE ( practices (i) % cuts (cuts) )
DO j = 1, cuts
!set date and time of thinning
practices (i) % cuts (j) % time = begin + INT( j * interval * year)
!set percentage of thinning
practices (i) % cuts (j) % intensity = IniReadReal &
( 'thinning-intensity', iniDB, section = ToString (active_practices(i)) )
!detect clear-cutting and reforestation
IF ( practices (i) % cuts (j) % intensity == 100. ) THEN
practices (i) % cuts (j) % reforestation = .TRUE.
!read parameters for reforestation
practices (i) % cuts (j) % species = &
IniReadInt ( 'species', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % density = &
IniReadReal ( 'density', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % age = &
IniReadReal ( 'age', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % dbh = &
IniReadReal ( 'dbh', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % height = &
IniReadReal ( 'height', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % stem_biomass = &
IniReadReal ( 'stem-biomass', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % root_biomass = &
IniReadReal ( 'root-biomass', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % leaf_biomass = &
IniReadReal ( 'leaf-biomass', iniDB, section = ToString (active_practices(i)) )
practices (i) % cuts (j) % lai = &
IniReadReal ( 'lai', iniDB, section = ToString (active_practices(i)) )
ELSE
practices (i) % cuts (j) % reforestation = .FALSE.
END IF
END DO
!set time for next cut
practices (i) % next = practices (i) % cuts (1) % time
practices (i) % current = 0
ELSE ! thinning at given dates
cuts = GetNofSubSections ( ini = iniDB, sectionname = ToString (active_practices(i)) )
ALLOCATE ( practices (i) % cuts (cuts) )
DO j = 1, cuts
!set date and time of thinning
timeString = IniReadString &
( 'date', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
timeString (11:) = 'T00:00:00+00:00'
practices (i) % cuts (j) % time = timeString
!set percentage of thinning
practices (i) % cuts (j) % intensity = IniReadReal &
( 'thinning-intensity', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
!detect clear-cutting and reforestation
IF ( practices (i) % cuts (j) % intensity == 100. ) THEN
practices (i) % cuts (j) % reforestation = .TRUE.
!read parameters for reforestation
practices (i) % cuts (j) % species = &
IniReadInt ( 'species', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % density = &
IniReadReal ( 'density', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % age = &
IniReadReal ( 'age', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % dbh = &
IniReadReal ( 'dbh', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % height = &
IniReadReal ( 'height', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % stem_biomass = &
IniReadReal ( 'stem-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % root_biomass = &
IniReadReal ( 'root-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % leaf_biomass = &
IniReadReal ( 'leaf-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
practices (i) % cuts (j) % lai = &
IniReadReal ( 'lai', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
ELSE
practices (i) % cuts (j) % reforestation = .FALSE.
END IF
END DO
!set time for next cut
practices (i) % next = practices (i) % cuts (1) % time
practices (i) % current = 0
END IF
END DO
!freememory
DEALLOCATE ( uniques )
DEALLOCATE ( active_practices )
!close option file
CALL IniClose (iniDB)
RETURN
END SUBROUTINE SetPlantsManagement
!==============================================================================
!| Description:
! Set variables and options to manage plants. Basically two options are
! available:
!
! 1. Regular thinning time interval and intensity. The percentage of plants
! is removed every time interval.
!
! 2. specific dates when applying a given thinning intensity
!
! A different option can be specified for each stand (cell).
!
SUBROUTINE ApplyPlantsManagement &
!
(time, pract, density, root, stem, leaf, total, lai, cover, age, height, dbh, stem_yield)
IMPLICIT NONE
!arguments with intent(in):
TYPE (DateTime), INTENT(IN) :: time
!arguments with intent(inout) ::
TYPE (Practice) , INTENT (INOUT) :: pract
REAL (KIND = float), INTENT (INOUT) :: density
REAL (KIND = float), INTENT (INOUT) :: root
REAL (KIND = float), INTENT (INOUT) :: stem
REAL (KIND = float), INTENT (INOUT) :: leaf
REAL (KIND = float), INTENT (INOUT) :: total
REAL (KIND = float), INTENT (INOUT) :: lai
REAL (KIND = float), INTENT (INOUT) :: cover
REAL (KIND = float), INTENT (INOUT) :: age
REAL (KIND = float), INTENT (INOUT) :: height
REAL (KIND = float), INTENT (INOUT) :: dbh
!arguments with intent(out) ::
REAL (KIND = float), INTENT (OUT) :: stem_yield
!local declarations:
INTEGER (KIND = short) :: pos
INTEGER (KIND = short) :: ncut
REAL (KIND = float) :: stem_before
!------------------------end of declarations-----------------------------------
ncut = pract % current
stem_before = stem
IF ( pract % cuts (ncut) % reforestation) THEN
stem_yield = stem_before
density = pract % cuts (ncut) % density
root = pract % cuts (ncut) % root_biomass
stem = pract % cuts (ncut) % stem_biomass
leaf = pract % cuts (ncut) % leaf_biomass
total = root + stem + leaf
lai = pract % cuts (ncut) % lai
age = pract % cuts (ncut) % age
height = pract % cuts (ncut) % height
dbh = pract % cuts (ncut) % dbh
! density = 700 # number of plants per hectar
!age = 5 #(years)
!dbh = 8. # # stem diameter at breast height (cm)
!height = 3. # #tree height (m)
!stem-biomass = 200. #(t/ha)
!root-biomass = 64. #(t/ha)
!leaf-biomass = 15. #(t/ha)
!lai = 2. #leaf area index (m2/m2)
ELSE !no clear cutting, update biomass
density = density * ( 1. - pract % cuts (ncut) % intensity / 100. )
root = root * ( 1. - pract % cuts (ncut) % intensity / 100. )
stem = stem * ( 1. - pract % cuts (ncut) % intensity / 100. )
leaf = leaf * ( 1. - pract % cuts (ncut) % intensity / 100. )
total = total * ( 1. - pract % cuts (ncut) % intensity / 100. )
lai = lai * ( 1. - pract % cuts (ncut) % intensity / 100. )
cover = cover * ( 1. - pract % cuts (ncut) % intensity / 100. )
stem_yield = stem_before - stem
END IF
RETURN
END SUBROUTINE ApplyPlantsManagement
!==============================================================================
!| Description:
! return the position in practices array given practice id
FUNCTION GetPos &
!
(id) &
!
RESULT (pos)
IMPLICIT NONE
!arguments with intent(in):
INTEGER (KIND = long), INTENT(IN) :: id
!local declarations:
INTEGER (KIND = long) :: pos
INTEGER (KIND = short) :: i
!---------------------------------end of declarations--------------------------
pos = 0
DO i = 1, SIZE (practices)
IF ( practices (i) % id == id) THEN
pos = i
EXIT
END IF
END DO
RETURN
END FUNCTION GetPos
!==============================================================================
!| Description:
! Set management practices to single plant stand
!
SUBROUTINE SetPractice &
!
(id, pract)
IMPLICIT NONE
!arguments with intent (in):
INTEGER (KIND = long), INTENT(IN) :: id
!arguments with intent (inout):
TYPE (Practice), INTENT(INOUT) :: pract
!local declarations:
INTEGER (KIND = long) :: pos
!------------------------------------------end of declarations-----------------
pos = GetPos (id)
IF (pos == 0) THEN
RETURN !no prcatice to apply
ELSE
pract = practices (pos)
END IF
RETURN
END SUBROUTINE SetPractice
END MODULE PlantsManagement