Seedprod.f90

Go to the documentation of this file.

!==============================================================================
!
!  Name   :  Seedprod
!
!  Purpose:  Calculates the seeds, which are produced by all trees of one
!            species in one height class and in a certain light class and
!            sums them over all light classes. For each height class the
!            seeds are recorded.
!
!  Remarks:  contains the SUBROUTINEs
!
!            Seedprod (<LocalDynOneTimeStep<DistrLocalDynThisTime<
!                        TimeLoop<TreeMig)
!            SumSpecsSeedprodsOverHeights (<LocalDynOneTimeStep<LocalDynOneTimeStep<
!                                            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 seedprod(ispec, htcl, ntinh, year, thiscell)
 
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    use all_par, only: speccl, spec, hcwidth, &          ! Use species parameters
                       mastseeding, currstateincell
 
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) :: ispec, year, &      ! species
                           htcl              ! height class
    REAL, INTENT(in) :: ntinh         ! number of trees in this height-light class
 
    ! <Local variables>---------------------------------------------------------------------------------
    REAL :: maxSeedsPerTree, &          ! actual number of seeds per tree
            newSeeds, &          ! actual number of seeds per tree species in this height class
            fractionInLowHC             ! fraction of seeds in lowest seed producing height class
 
    TYPE(currstateincell), INTENT(inout):: thiscell
    ! <Here the SUBROUTINE starts>**********************************************************************
    !----- Determine how much seeds are produced by a tree of this species  at maximum
    maxseedspertree = spec(ispec)%maxseed     !----- Repro: here also a light or density dependence of seed production could be included
    !----- IF mast seeding desired, apply a sine-wave
    if (mastseeding) maxseedspertree = 0.5*maxseedspertree* &
                                       (1.0 + sin(6.2831853*real(year)/spec(ispec)%period))
    !----- Calculate seeds produced by all trees of this species in this height class
    newseeds = ntinh*speccl(ispec)%seedprod(htcl)*maxseedspertree
    !----- If actual height class above lowest seed production height, no problem, just add the produced seeds
    if (htcl .ge. ceiling(spec(ispec)%mathcp)) &
        thiscell%sp(ispec)%seeds(htcl) = thiscell%sp(ispec)%seeds(htcl) + newseeds
    !----- If actual height class just below lowest seed production height,   add only proportion of the produced seeds
    fractioninlowhc = (real(ceiling(spec(ispec)%mathcp)) - spec(ispec)%mathcp)/hcwidth
    if (htcl == floor(spec(ispec)%mathcp)) &
        thiscell%sp(ispec)%seeds(htcl) = thiscell%sp(ispec)%seeds(htcl) + newseeds*fractioninlowhc
end SUBROUTINE seedprod
!****<Here the SUBROUTINE ends>********************************************************************  !==============================================================================
!===================================================================== 
!===================================================================== 
SUBROUTINE sumspecsseedprodsoverheights(nspc, thiscell)
    use all_par, only: spec, currstateincell
    IMPLICIT NONE
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) ::  nspc     ! species
    TYPE(currstateincell), INTENT(inout):: thiscell
    ! <Local variables>---------------------------------------------------------------------------------
    INTEGER::   htcl, isp
    ! <Here the SUBROUTINE starts>**********************************************************************
    do isp = 1, nspc
        thiscell%sp(isp)%producedSeeds = 0.0
        do htcl = floor(spec(isp)%mathcp), spec(isp)%maxhtc
            thiscell%sp(isp)%producedSeeds = thiscell%sp(isp)%producedSeeds + thiscell%sp(isp)%seeds(htcl)
        end do
    end do
end SUBROUTINE sumspecsseedprodsoverheights
!done