!   E04AB_A1W_F Example Program Text
!   Mark 29.3 Release. NAG Copyright 2023.
    Module e04ab_a1w_fe_mod

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

!     .. Use Statements ..
      Use iso_c_binding, Only: c_ptr
      Use nagad_library, Only: nagad_a1w_w_rtype, sin, Assignment (=),         &
                               Operator (/), Operator (*)
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: funct_a1w
!     .. Parameters ..
      Integer, Parameter, Public       :: nout = 6
!     .. Local Scalars ..
      Type (nagad_a1w_w_rtype), Public, Save :: t
    Contains
      Subroutine funct_a1w(ad_handle,xc,fc,iuser,ruser)
!       Routine to evaluate F(x) at any point in (A, B)

!       .. Scalar Arguments ..
        Type (c_ptr), Intent (Inout)   :: ad_handle
        Type (nagad_a1w_w_rtype), Intent (Out) :: fc
        Type (nagad_a1w_w_rtype), Intent (In) :: xc
!       .. Array Arguments ..
        Type (nagad_a1w_w_rtype), Intent (Inout) :: ruser(*)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Executable Statements ..
        fc = sin(t*xc)/(xc)

        Return

      End Subroutine funct_a1w
    End Module e04ab_a1w_fe_mod
    Program e04abf_a1w_e

!     E04AB_A1W_F Example Main Program

!     .. Use Statements ..
      Use e04ab_a1w_fe_mod, Only: funct_a1w, nout, t
      Use iso_c_binding, Only: c_ptr
      Use nagad_library, Only: e04ab_a1w_f, nagad_a1w_get_derivative,          &
                               nagad_a1w_inc_derivative,                       &
                               nagad_a1w_ir_create => x10za_a1w_f,             &
                               nagad_a1w_ir_interpret_adjoint_sparse,          &
                               nagad_a1w_ir_register_variable,                 &
                               nagad_a1w_ir_remove, nagad_a1w_w_rtype,         &
                               x10aa_a1w_f, x10ab_a1w_f, Assignment (=),       &
                               Operator (*)
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Type (nagad_a1w_w_rtype)         :: a, b, e1, e2, f, x
      Type (c_ptr)                     :: ad_handle
      Real (Kind=nag_wp)               :: tmp
      Integer                          :: adifail, ifail, maxcal
!     .. Local Arrays ..
      Type (nagad_a1w_w_rtype)         :: ruser(1)
      Integer                          :: iuser(1)
!     .. Executable Statements ..
      Write (nout,*) 'E04AB_A1W_F Example Program Results'
      ifail = 0
      Call x10aa_a1w_f(ad_handle,ifail)

      Call nagad_a1w_ir_create

!     E1 and E2 are set to zero so that E04AB_A1W_F will reset them to
!     their default values

      e1 = 0.0_nag_wp
      e2 = 0.0_nag_wp

!     The minimum is known to lie in the range (3.5, 5.0)

      a = 3.5_nag_wp
      b = 5.0_nag_wp

      t = 1.0_nag_wp
!     Allow 30 calls of FUNCT

      maxcal = 30

      Call nagad_a1w_ir_register_variable(t)
      ifail = -1
      Call e04ab_a1w_f(ad_handle,funct_a1w,e1,e2,a,b,maxcal,x,f,iuser,ruser,   &
        ifail)

      Select Case (ifail)
      Case (0,2)
        Write (nout,*)
        Write (nout,99999) 'The minimum lies in the interval', a%value, ' to', &
          b%value
        Write (nout,99999) 'Its estimated position is', x%value, ','
        Write (nout,99998) 'where the function value is ', f%value
        Write (nout,99997) maxcal, 'function evaluations were required'
      Case (:-1)
        Write (nout,99995) 'Routine e04ab_a1w_f failed with ifail = ', ifail
        Go To 100
      End Select

      x = x*1.0_nag_wp
      Call nagad_a1w_inc_derivative(x,1.0_nag_wp)
      Call nagad_a1w_ir_interpret_adjoint_sparse(adifail)

      tmp = nagad_a1w_get_derivative(t)
      Write (nout,99996) 'dx/dt = ', tmp

100   Continue
!     Remove computational data object and tape
      Call x10ab_a1w_f(ad_handle,ifail)
      Call nagad_a1w_ir_remove

99999 Format (1X,A,F11.8,A,F11.8)
99998 Format (1X,A,F7.4)
99997 Format (1X,I2,1X,A)
99996 Format (1X,A,E26.16)
99995 Format (/,1X,A,I0)
    End Program e04abf_a1w_e