!   C06LAF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    MODULE c06lafe_mod

!      C06LAF Example Program Module:
!             Parameters and User-defined Routines

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
       SUBROUTINE fun(pr,pi,fr,fi)
!         Function to be inverted

!         .. Use Statements ..
          USE nag_library, ONLY : a02acf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: fi, fr
          REAL (KIND=nag_wp), INTENT (IN)     :: pi, pr
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: xi, xr, yi, yr
!         .. Executable Statements ..
          xr = 1.0_nag_wp
          xi = 0.0_nag_wp
          yr = pr + 0.5_nag_wp
          yi = pi

          CALL a02acf(xr,xi,yr,yi,fr,fi)

          RETURN
       END SUBROUTINE fun
    END MODULE c06lafe_mod

    PROGRAM c06lafe

!      C06LAF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : c06laf, nag_wp
       USE c06lafe_mod, ONLY : fun, nin, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: ahigh, alow, alphab, relerr, tfac
       INTEGER                             :: i, ifail, itest, mxterm, n, n1,  &
                                              na, nfeval, nterms
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: errest(:), t(:), trurel(:),      &
                                              trures(:), valinv(:), work(:)
!      .. Intrinsic Functions ..
       INTRINSIC                              abs, exp, real
!      .. Executable Statements ..
       WRITE (nout,*) 'C06LAF Example Program Results'
       WRITE (nout,*)
       WRITE (nout,*) '(results may be machine-dependent)'
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n, mxterm
       ALLOCATE (errest(n),t(n),trurel(n),trures(n),valinv(n), &
          work(4*mxterm+2))

       t(1) = 1.0_nag_wp
       alphab = -0.5_nag_wp


TESTS: DO itest = 1, 3

          SELECT CASE (itest)
          CASE (1)
!            Test for values of a close to alphab
             relerr = 0.01E0_nag_wp
             tfac = 7.5E0_nag_wp
             n1 = 1
             WRITE (nout,99997) t(1)
          CASE (2)
!            Test for larger values of a
             relerr = 1.0E-3_nag_wp
             tfac = 0.8E0_nag_wp
             n1 = 1
             WRITE (nout,99997) t(1)
          CASE (3)
             WRITE (nout,'(/1x,A/)') 'Compute inverse'
             n1 = 5
             DO i = 1, n1
                t(i) = real(i,kind=nag_wp)
             END DO
          END SELECT
          WRITE (nout,99999) mxterm, tfac, alphab, relerr

          ifail = -1
          CALL c06laf(fun,n1,t,valinv,errest,relerr,alphab,tfac,mxterm,nterms, &
             na,alow,ahigh,nfeval,work,ifail)

          IF (ifail==0 .OR. ifail>=5) THEN
             WRITE (nout,*)
             WRITE (nout,*) '   T        Result        exp(-T/2)   ', &
                'Relative error  Error estimate'
             trures(1:n1) = exp(-0.5_nag_wp*t(1:n1))
             trurel(1:n1) = abs((valinv(1:n1)-trures(1:n1))/trures(1:n1))
             WRITE (nout,99998) (t(i),valinv(i),trures(i),trurel(i),errest(i), &
                i=1,n1)
          ELSE
             EXIT TESTS
          END IF
       END DO TESTS
       IF (ifail>=0) THEN
          WRITE (nout,99996) nterms, nfeval, alow, ahigh, ifail
       END IF

99999  FORMAT (1X,'  MXTERM =',I4,'  TFAC =',F6.2,'  ALPHAB =',F6.2, &
          '  RELERR =',1P,E8.1)
99998  FORMAT (1X,F4.1,7X,F6.3,9X,F6.3,8X,E8.1,8X,E8.1)
99997  FORMAT (/1X,'Test with T(1) =',F4.1/)
99996  FORMAT (/1X,' NTERMS =',I4,'  NFEVAL =',I4,'  ALOW =',F7.2,'  AHIGH =', &
          F7.2,'  IFAIL =',I2)
    END PROGRAM c06lafe