!> 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