Regen.f90

Go to the documentation of this file.

!==============================================================================
!
!  Name   :  Regen
!
!  Purpose:  "Regen" determines the germination of seeds
!            "ContinuousLightDepGerm" determines a continuous light
!            dependence of germination
!
!  Remarks:  contains the SUBROUTINEs
!
!            Regen (<LocalDynOneTimeStep<LocalDynOneTimeStep<DistrLocalDynThisTime<
!                     TimeLoop<TreeMig)
!            ContinuousLightDepGerm (not used at the moment)
!
!==============================================================================
! 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 regen(nspc, stock, doDispersal, thiscell)
 
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    use all_par, only: maxlc, pltsiz, &
                       spec, &
                       ltcum, calcseedbank, ltfrq, ltval, &
                       seedlcrowndiamincm, &
                       contlightdepgerm, &
                       currstateincell
    use loggermodule, only: logwarning
    ! Use control, species and stand  parameters
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) :: nspc          ! number of species                                     [=spec]
    REAL, INTENT(in)    :: stock         ! number of species                                     [=spec]
    Logical, INTENT(in) :: doDispersal
 
    ! <Local variables>---------------------------------------------------------------------------------
    INTEGER :: ilstart, &    ! Integer val. of inlt                        [=ilstart]
               i, ltcl, &    !  looping variable for species and light
               threshold
    REAL    :: newborn, &  ! # newborn trees in htcl=1       [=birthTo0]
               inlt, &  ! Index of light        [=RealIndOfLight(..)]
               lidep, ld, &  ! light dependent growth             [=lidep]
               lih, allgerms, alldeps, ndeps, &
               relNewB(1:70), &
               maxseedlnr, estabFrac, seedlcrownarea
    TYPE(currstateincell):: thiscell
 
    ! <Here the SUBROUTINE starts>**********************************************************************
    allgerms = 0.0
    alldeps = 0.0
    ndeps = 0.0
 
    !----- seedlcrowndiamInCm = 10
    estabfrac = stock
    seedlcrownarea = 3.141592654*((seedlcrowndiamincm/2.0)*0.01)**2   ! convert to area (m2)
 
    byspecies: do i = 1, nspc
        !    if (thiscell%sp(i)%there ) then
        !----- Determine in which light class the critical threshold for establishment of this species falls
        inlt = (sqrt(spec(i)%lthres*real(maxlc*(maxlc + 1)) + 0.25) - 0.5)
        ilstart = int(inlt)
 
        !----- Determine the proportion of the stand in which light at the bottom is equal or brighter than this threshold
        lidep = ltcum(ilstart + 1)
 
        !----- If the seeds stem from dispersal, the newborn seedlings germinate from the seedBank, depending
        !----- on light and other environment
        if (dodispersal) then
            !----- Here a test for a continuous light dependence function of germination
            if (contlightdepgerm) then
                lidep = 0.0
                do ltcl = 1, maxlc
                    lih = ltval(ltcl)
                    threshold = spec(i)%klighs
                    call contlightdep(lih, threshold, ld) ! kind of an interpolation between different light classes
                    lidep = lidep + ld*ltfrq(ltcl)
                end do
            end if !------ contLightDepGerm
 
            !----- If light dependence works on 0th height class, light dep. of germination is 1
            thiscell%sp(i)%sb = thiscell%sp(i)%seedBank
            !----- the newborns are calculated from the seedBank depending on environment, light , and germination rate
            newborn = thiscell%sp(i)%seedBank*lidep*spec(i)%enveta*spec(i)%seedGerm
 
            !-----  seedbank dynamics: if wished seeds stay in the calcSeedBank depending on mortality and germination rates
            if (calcseedbank) then  !-----  seedbank dynamics
                thiscell%sp(i)%seedBank = (thiscell%sp(i)%seedBank - newborn)*spec(i)%seedSurv*(1.0 - spec(i)%seedLoss)
            else
                thiscell%sp(i)%seedBank = 0.0
            end if
            !----- newborns enter  0th height class (0-1.37 m)
            !-----  nur fuer freq test raus
            !----->     thiscell%sp(i)numin(0,lat,lon)=thiscell%sp(i)numin(0,lat,lon)+newborn
            relnewb(i) = newborn
            allgerms = allgerms + newborn
            alldeps = alldeps + lidep*spec(i)%enveta
            ndeps = ndeps + 1.0
        else !----- not idisp, i.e. constant seed inflow
            !----- Otherwise, the newborn saplings germinate from a constant sapling pool (birth),
            !----- depending on light and other environment...
                newborn = spec(i)%birth*pltsiz*lidep*spec(i)%enveta/833.0
 
!             if (thiscell%sp(i)%there) then ! only in overall allowed region for constant seed supply
!                 newborn = spec(i)%birth*pltsiz*lidep*spec(i)%enveta/833.0
!             else
!                 newborn = 0.
!             end if
 
            !----- ... and enter first height class (> 1.37 m)
            thiscell%sp(i)%numin(1) = thiscell%sp(i)%numin(1) + newborn
            thiscell%sp(i)%ingrowth = newborn
        end if !----- doDispersal
 
    end do byspecies
 
    !----- frequency dependence, the available area - converted to total possible number of seedlings - is given to the species proportionally to their newborn numbers
    if (dodispersal) then
        if (allgerms > 0.0) then
            maxseedlnr = pltsiz*estabfrac/seedlcrownarea
            do i = 1, nspc
                if (thiscell%sp(i)%numin(0) < 0) then
                    call logwarning("Negative seedlings in SUBROUTINE Regen!")
                end if
                !----->     thiscell%sp(i)%sb = allgerms * maxseedlnr / (allgerms + maxseedlnr) * (relNewB(i) / allgerms)  ! only for output
                thiscell%sp(i)%numin(0) = thiscell%sp(i)%numin(0) + &
                                          allgerms*maxseedlnr/(allgerms + maxseedlnr)*(relnewb(i)/allgerms)
                !----->    thiscell%sp(i)%sb  = thiscell%sp(i)%numin(0 )                                                     ! only for output
                !----->    thiscell%sp(i)%sb = relNewB(i)                                                                  ! only for output
            end do !----- i=1,nspc
        end if !----- (allgerms > 0.0)
    end if !----- (doDispersal)
 
end SUBROUTINE regen
!****<Here the SUBROUTINE ends>********************************************************************
 
!****<Here the SUBROUTINE ContinuousLightDepGerm starts>*******************************************
!SUBROUTINE ContinuousLightDepGerm(threshold, lidep)
 
! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
!use All_par, only: ltval, ltfrq, maxlc
 
!IMPLICIT NONE
 
! <Passed variables>--------------------------------------------------------------------------------
!REAL, INTENT(in)  :: threshold          ! species specific threshold of light dependence
!REAL, INTENT(out) :: lidep              ! light dependence value (summed over all light classes)
 
! <Local variables>---------------------------------------------------------------------------------
!INTEGER :: ltcl
!REAL    ::  ld,lih      ! light dependent growth                               [=lidep]
!
! <Here the SUBROUTINE starts>**********************************************************************
!  lidep = 0.0
!  do ltcl=1,maxlc
!    lih = ltval(ltcl)
!    call ContLightDep (lih, threshold, ld)
!    lidep = lidep + ld * ltfrq(ltcl)
!  end do
!
! end SUBROUTINE ContinuousLightDepGerm
!****<Here the SUBROUTINE ends>********************************************************************
!done