Program x05bafe

!     X05BAF Example Program Text

!     Mark 26.1 Release. NAG Copyright 2017.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, x05baf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: timeout_s = 100._nag_wp
      Integer, Parameter               :: nout = 6
      Integer, Parameter               :: nterms = 10**7
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: h, start
      Integer                          :: n
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'X05BAF Example Program Results'

      start = x05baf()

!     Do a non-trivial amount of intermediate work.

      h = 0._nag_wp
      n = 1

loop: Do
        h = h + 1.0_nag_wp/real(nterms-n+1,kind=nag_wp)

        If (x05baf()-start>timeout_s) Then
          Write (nout,*) 'Computation timed out.'
          Exit loop
        End If

        If (n==nterms) Then
          Exit loop
        End If

        n = n + 1
      End Do loop

      Write (nout,99999) 'Computed ', n,                                       &
        ' terms of the harmonic series within the allotted time limit.'
99999 Format (1X,A,I8,A)
      Write (nout,99998) 'Value of partial sum is', h, '.'
99998 Format (1X,A,E13.5,A)
    End Program x05bafe