LocalForestDynamics.f90

Go to the documentation of this file.

!==============================================================================
!
!  Name   :  LocalForestDynamics
!
!  Purpose:   calculates the forest dynamics in one cell
!
!  Remarks:  contains the SUBROUTINE
!
!            LocalForestDynamics (<SpatialDynOneTimeStep<DistrLocalDynThisTime<TimeLoop<TreeMig)
!
!==============================================================================
! design          : H. Lischke, N. Zimmermann
! author(s)       : H. Lischke, N. Zimmermann
! implementation  : H. Lischke, N. Zimmermann
! cleaner         : T.J. Loeffler
! copyright       : (c) 1999, 03 by H. Lischke
!==============================================================================
!===================================================================== 
!===============================================================
SUBROUTINE localforestdynamics(nspc, year, doDispersal, thiscell)
 
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    use all_par, only: maxspc, maxhc, maxlc,  &
                       ltfrq, &
                       htcl, ltcl, & ! do these really need to be in the All_pars? quite local
                       spec, stockability, &
                       disturbances, disturbprob, disturbintensity, &
                       currstateincell        ! Use control parameters
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) ::  nspc, year     ! Passed number of species                   [=spec]
 
    Logical, INTENT(in) :: doDispersal
 
    ! <Local variables>---------------------------------------------------------------------------------
    REAL :: lasum, & ! Sum of LA per height?                                    [=laisum]
            lasqsum, & ! Sum of squared LA per height?                         [=laisqrsum]
            srvinhl, & ! remaining ind. per spec/height/light condition in loop [=survNInH]
            disturbancemort, & ! mortality by disturbance, species independent
            ntinh, ntinhl, & ! # tree in height class               [=nInH  <- rNoTreesUnderCond]
            randomvalue, & ! random value for disturbance calculation
            randomvalue2, & ! random value for disturbance calculation
            numin0(0:maxhc, 1:maxspc), &      ! temporary variable originating from numNInH
            stock
    INTEGER :: minhc, &                  ! minimum height class
               i                         ! looping variable
    TYPE(currstateincell), INTENT(inout):: thiscell
 
    ! <Here the SUBROUTINE starts>**********************************************************************
    stock = stockability(thiscell%lat, thiscell%lon)
    if (stock <= 1.e-20) return            ! if cell cant be inhabited, no dynamics
 
    !----- First: Initialize the light distribution arrays, i.e. max light on top
    ltfrq = 0.0
    ltfrq(maxlc) = 1.0
    !----- Initialize leaf areas for summing on leaf area
    lasum = 0.0
    lasqsum = 0.0
    !----- Depending on kind of seed production (constant seed pool or by parent trees) the 0th height class is included
    if (dodispersal) then
        minhc = 0
        do i = 1, nspc
            thiscell%sp(i)%ingrowth = 0.0
        end do
    else
        minhc = 1
        do i = 1, nspc
            thiscell%sp(i)%numin(0) = 0.0
        end do
    end if
    !----- Determine whether disturbance occurs in this year and cell (if disturbances are wished)
    disturbancemort = 0.0
    if (disturbances .AND. dodispersal) then
        call random_number(randomvalue)
        if (randomvalue  <  disturbprob) then
            call random_number(randomvalue2)
            disturbancemort = disturbintensity*randomvalue2
        end if
    end if
    !------- Additional read in disturbances increase mortality
    disturbancemort = min(1., disturbancemort + thiscell%disturb)
 
    do htcl = maxhc, minhc, -1
        do i = 1, nspc
            ! To take into account also the height class above the highest one, which can be reached,
            ! because the growth rate is calculated at the lower bound of the height classes, here I test,
            ! here I test, to "activate" this next height class, to include it into the shading
            ! and to apply mortality to it
            ! if (htcl <= spec(i)%maxhtc) then
            if (htcl <= spec(i)%maxhtc + 1) then
                numin0(htcl, i) = thiscell%sp(i)%numin(htcl)
            else
                numin0(htcl, i) = 0.0
            end if
        end do
    end do
 
    !----- Next, we loop through height classes, top-down
    byhcls: do htcl = maxhc, minhc, -1
        !----- Here the light distribution is calculated based on  leaves  of current and higher height classes
        call lfcalc(nspc, htcl, lasum, lasqsum, numin0)   ! Light frequency & Leave area
        !----- By species, the number of trees is calculated and evaluated per height class
        byspecies: do i = 1, nspc
            thiscell%sp(i)%seeds(htcl) = 0.0
            ntinh = numin0(htcl, i)
            !----- If the species reaches this height class and there are trees in this height class ...
            ifhcls: if (ntinh > 0.0) then
                !----- ... determine seed production. Here, as long as it is not yet light dependent
                call seedprod(i, htcl, ntinh, year, thiscell)    ! Seed production
                !----- ...loop through all light classes
                bylcls: do ltcl = 1, maxlc
                    !----- ... if  this light  class occurs...
                    if (ltfrq(ltcl) > 0.0) then
                        !----- ... count how many trees are in this height and light class
                        ntinhl = ntinh*ltfrq(ltcl)
                        !----- ... and let the trees live part of their live: produce seeds, die and grow
                        ! call Seedprod(i,htcl,ntinhl,year, thiscell)                 ! Seed production (if light dependent)
                        call mort(i, htcl, ltcl, srvinhl, ntinhl, disturbancemort, thiscell)  ! Mortality
                        call grow(i, htcl, ltcl, srvinhl, minhc, thiscell)                   ! Growth
                    end if !----- ltfrq(ltcl) > 0.0
                end do bylcls
            end if ifhcls
 
        end do byspecies
    end do byhcls
 
    !----- Last, regeneration is calculated
    !----- Here part three of regeneration takes place (after seed production and dispersal)
    !----- the germination of seeds and the survival of seedlings
 
    call sumspecsseedprodsoverheights(nspc, thiscell)                    !  In SeedProd.f90
    call selfregulation(nspc, dodispersal, thiscell)
    call specimmigration(nspc, year, dodispersal, thiscell)
    call regen(nspc, stock, dodispersal, thiscell)                          ! Regeneration of saplings
end SUBROUTINE localforestdynamics
!done