!   E04DJF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.
    Module e04djfe_mod

!     E04DJF 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                           :: objfn1
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, ninopt = 7, nout = 6
    Contains
      Subroutine objfn2(mode,n,x,objf,objgrd,nstate,iuser,ruser)
!       Routine to evaluate F(x) and its exact 1st derivatives

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: objf
        Integer, Intent (Inout)        :: mode
        Integer, Intent (In)           :: n, nstate
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: objgrd(n)
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(n)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: x1, x2
!       .. Intrinsic Procedures ..
        Intrinsic                      :: exp
!       .. Executable Statements ..
        x1 = x(1)
        x2 = x(2)

        objf = exp(x1)*(4.0_nag_wp*x1**2+2.0_nag_wp*x2**2+4.0_nag_wp*x1*x2+    &
          2.0_nag_wp*x2+1.0_nag_wp)

        If (mode==2) Then
          objgrd(1:n) = (/4.0_nag_wp*exp(x1)*(2.0_nag_wp*x1+x2)+objf,          &
            2.0_nag_wp*exp(x1)*(2.0_nag_wp*x2+2.0_nag_wp*x1+1.0_nag_wp)/)
        End If

        Return

      End Subroutine objfn2
      Subroutine objfn1(mode,n,x,objf,objgrd,nstate,iuser,ruser)
!       Routine to evaluate F(x) and approximate its 1st derivatives

!       .. Use Statements ..
        Use nag_library, Only: e04xaf
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: objf
        Integer, Intent (Inout)        :: mode
        Integer, Intent (In)           :: n, nstate
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: objgrd(n)
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(n)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: epsrf
        Integer                        :: ifail, imode, iwarn, ldh, msglvl
!       .. Local Arrays ..
        Real (Kind=nag_wp), Allocatable :: h(:,:), hcntrl(:), hforw(:),        &
                                          work(:), xcopy(:)
        Integer, Allocatable           :: info(:)
!       .. Executable Statements ..
        Select Case (mode)
        Case (0)

!         Evaluate F(x) only

          Call objfn2(mode,n,x,objf,objgrd,nstate,iuser,ruser)

        Case (2)

!         Evaluate F(x) and approximate its 1st derivatives

          imode = 0
          ldh = n
          Allocate (info(n),hforw(n),hcntrl(n),h(ldh,1),work(n),xcopy(n))
          xcopy(1:n) = x(1:n)
          hforw(1:n) = 0.0_nag_wp
          msglvl = 0
          epsrf = 0.0_nag_wp

          ifail = 1
          Call e04xaf(msglvl,n,epsrf,xcopy,imode,objfn2,ldh,hforw,objf,objgrd, &
            hcntrl,h,iwarn,work,iuser,ruser,info,ifail)

        End Select

        Return

      End Subroutine objfn1
    End Module e04djfe_mod
    Program e04djfe

!     E04DJF Example Main Program

!     .. Use Statements ..
      Use e04djfe_mod, Only: nin, ninopt, nout, objfn1
      Use nag_library, Only: e04dgf, e04djf, e04dkf, nag_wp, x04abf, x04acf,   &
                             x04baf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Character (*), Parameter         :: fname = 'e04djfe.opt'
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: objf
      Integer                          :: ifail, inform, iter, mode, n, outchn
      Character (80)                   :: rec
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: objgrd(:), work(:), x(:)
      Real (Kind=nag_wp)               :: ruser(1)
      Integer                          :: iuser(1)
      Integer, Allocatable             :: iwork(:)
!     .. Executable Statements ..
      Write (rec,99998) 'E04DJF Example Program Results'
      Call x04baf(nout,rec)

!     Skip heading in data file
      Read (nin,*)

      Read (nin,*) n
      Allocate (iwork(n+1),objgrd(n),x(n),work(13*n))

!     Set the unit number for advisory messages to OUTCHN

      outchn = nout
      Call x04abf(1,outchn)

      Read (nin,*) x(1:n)

!     Set two options using E04DKF

      Call e04dkf(' Verify Level = -1 ')

      Call e04dkf(' Maximum Step Length = 100.0 ')

!     Open the options file for reading

      mode = 0

      ifail = 0
      Call x04acf(ninopt,fname,mode,ifail)

!     Read the options file for the remaining options

      Call e04djf(ninopt,inform)

      If (inform/=0) Then
        Write (rec,99999) 'E04DJF terminated with INFORM = ', inform

        Call x04baf(nout,rec)

        Go To 100
      End If

!     Solve the problem

      ifail = -1
      Call e04dgf(n,objfn1,iter,objf,objgrd,x,iwork,work,iuser,ruser,ifail)

100   Continue

99999 Format (1X,A,I5)
99998 Format (1X,A)
    End Program e04djfe