ApplyPlantsManagement Subroutine

public subroutine ApplyPlantsManagement(time, pract, density, root, stem, leaf, total, lai, cover, age, height, dbh, stem_yield)

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).

Arguments

Type IntentOptional Attributes Name
type(DateTime), intent(in) :: time
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
real(kind=float), intent(out) :: stem_yield

Variables

Type Visibility Attributes Name Initial
integer(kind=short), public :: ncut
integer(kind=short), public :: pos
real(kind=float), public :: stem_before

Source Code

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