EvaluateResultFunctions.f90

Go to the documentation of this file.

!===================================================================== 
!===============================================================
 
 REAL function biodivindex(nspc, specbio, sumbio)
 
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in) :: nspc          ! Passed number of species
    REAL, INTENT(in)    :: specbio(nspc), &  ! species biomass
                        sumbio
 
    ! <Local variables>---------------------------------------------------------------------------------
    INTEGER :: i                         ! loop-counter
    REAL    :: diversity, rnspc, value
 
    ! <Here the SUBROUTINE starts>**********************************************************************
    !----- Calculation of diversity per species
    rnspc     = nspc
    diversity = 0.0
 
    if (abs(sumbio) < 1.e-20) then
        diversity = 0.0
    else
        byspc2: do i = 1, nspc
            value = specbio(i) / sumbio
            if (value .gt. 1.e-5 ) then
                value     = -value * log(value)
                diversity = diversity + value / log(rnspc)
            end if
        end do byspc2
    end if
 
  biodivindex = diversity
 
end function biodivindex
!****<Here the SUBROUTINE ends>********************************************************************