!   C06LAF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: f
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Subroutine f(pr,pi,fr,fi)
!       Function to be inverted

!       .. Use Statements ..
        Use nag_library, Only: a02acf
!       .. 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 f
    End Module c06lafe_mod

    Program c06lafe

!     C06LAF Example Main Program

!     .. Use Statements ..
      Use c06lafe_mod, Only: f, nin, nout
      Use nag_library, Only: c06laf, nag_wp
!     .. 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 Procedures ..
      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(f,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