Program x05bafe

!     X05BAF Example Program Text

!     Mark 25 Release. NAG Copyright 2014.

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

      s1 = x05baf()

!     Do a non-trivial amount of intermediate work.

      h = 0.0_nag_wp

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

      s2 = x05baf()

      cptime = s2 - s1
      Write (nout,99999) 'It took', cptime, ' seconds to compute', nterms, &
        ' terms of the harmonic series.', 'Value of partial sum =', h, '.'

99999 Format (1X,A,1P,E10.2,A/1X,I8,A/1X,A,E13.5,A)
    End Program x05bafe