Grow.f90

Go to the documentation of this file.

!===================================================================== 
!===============================================================
SUBROUTINE grow(ispec, heightcl, lightcl, srvinhl, minhc, thiscell)
 
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    use all_par, only: speccl, hcwidth, birht, maxhc, currstateincell  ! Use control and species parameters
 
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) :: ispec, &     !  species index                                       [=spec]
                           heightcl, &     ! height class                                          [=height]
                           lightcl, &     ! lightclass                                            [=ilight]
                           minhc         ! lowest height class (0 for dispersal, 1 for local simus)  [=..]
    REAL, INTENT(in)    :: srvinhl       ! remaining ind. per spec/height/light class          [=survNInH]
 
    ! <Local variables>---------------------------------------------------------------------------------
    INTEGER :: newlwhc, &      ! new lower class number of growing trees [=newBotHeight]
               newuphc             ! new upper class number of growing trees [=newTopHeight]
    REAL    :: propbot, &      ! proportion of individuals remaining in lower class          [=proportionBot]
               gr, &      ! growth rate
               inHC1, delta
 
    TYPE(currstateincell):: thiscell
    ! <Here the SUBROUTINE starts>**********************************************************************
    !----- <Gets the rel. growth  in height classes
    gr = speccl(ispec)%hlgro(heightcl, lightcl)
 
    !----- this is the complicated case, because 0th height class is smaller than others
    if (heightcl == 0) then
        if (gr <= birht) then
            newlwhc = 0
            newuphc = 1
            propbot = (birht - gr)/birht
        else
            newlwhc = max(min(1 + floor((gr - birht)/hcwidth), maxhc), minhc)
            newuphc = max(min(1 + floor(gr/hcwidth), maxhc), minhc)
            if (newlwhc == newuphc) then
                propbot = 1.0
            else
                propbot = (speccl(ispec)%htmin(newuphc) - gr)/birht
            end if
        end if
    else
        newlwhc = max(min(heightcl + floor(gr/hcwidth), maxhc), minhc)
        newuphc = max(min(1 + newlwhc, maxhc), minhc)
        propbot = (hcwidth - gr)/hcwidth
    end if
 
    !----- <Subtract from height class what leaves given the current looping condition
    inhc1 = thiscell%sp(ispec)%numin(1)
    thiscell%sp(ispec)%numin(heightcl) = thiscell%sp(ispec)%numin(heightcl) - srvinhl
    thiscell%sp(ispec)%numin(newlwhc) = thiscell%sp(ispec)%numin(newlwhc) + (propbot*srvinhl)
    thiscell%sp(ispec)%numin(newuphc) = thiscell%sp(ispec)%numin(newuphc) + ((1.0 - propbot)*srvinhl)
 
    if (heightcl == 0) then
        delta = thiscell%sp(ispec)%numin(1) - inhc1
        thiscell%sp(ispec)%ingrowth = thiscell%sp(ispec)%ingrowth + delta
    end if
 
    if (thiscell%sp(ispec)%numin(heightcl) < 0) then
        thiscell%sp(ispec)%numin(heightcl) = 0.0
    end if
 
end SUBROUTINE grow
!done