!> Prints the required number of elements in a 'generalized' %Fibonacci series.
!!
!! The program reads the order of the generalized %Fibonacci series and the
!! number of elements to calculate from stdin. It computes the elements and
!! prints them to stdout. It stops the calculation of the series if there is
!! a danger of an integer overflow. (Appropriate error message is printed to
!! stdout.) The program can be left by entering 0 or a negative number for the
!! series order.
!!
!! \note The generalized Fibonacci series is created by summing
!! an arbitrary number (order of the series) of previous series elements to get
!! the next one. The inital elements (up to the order of the series) are 1.
!!
!! \author Bálint Aradi
program GeneralizedFibonacci
implicit none
integer, allocatable :: fibo(:)
integer :: tmp ! Maximal value before stopping to prevent overflow
integer :: nterm, order
integer :: ncalc ! Number of calculated element
logical :: overflow ! .true. if stopped to prevent overflow
integer :: allocerror ! error flag for allocation
integer :: ii
! Main loop for reading in the limits and calculate the series.
lpmain: do
write (*,*)
write (*,*) "> Order of the generalized Fibonacci series: (0 or negative &
&number to stop):"
read (*,*) order
if (order <= 0) then
exit
end if
write (*,*) "> How many elements to calculate? (>=1)"
read (*,*) nterm
if (nterm < 1) then
write (*,*) "Error: Nr. of elements must be greater or equal 1."
cycle lpmain
end if
!! Calculating elements of the Fibonacci series
allocate(fibo(nterm), stat=allocerror)
if (allocerror /= 0) then
write (*,*) "Allocation failed. Probaly not enough memory."
write (*,*) "Please try to choose less terms."
cycle lpmain
end if
ncalc = nterm
overflow = .false.
! Make sure, not writing over array bounds, if nterm < order
fibo(1:min(order, nterm)) = 1
!! Fibonacci-loop
lpfibo: do ii = order + 1, nterm
tmp = sum(fibo(ii-order:ii-2))
if (huge(tmp) - tmp < fibo(ii-1)) then
overflow = .true.
ncalc = ii - 1
exit lpfibo
end if
fibo(ii) = fibo(ii-1) + tmp
end do lpfibo
write (*,*)
write (*,*) "Generalized Fibonacci series of order ", order
write (*,*) "The first ", nterm, " elements:"
do ii = 1, ncalc
write (*,*) ii, fibo(ii)
end do
if (overflow) then
write (*,*)
write (*,*) "Warning: Calculation stopped to prevent overflow"
end if
deallocate(fibo)
end do lpmain
end program GeneralizedFibonacci