!   E04DJA Example Program Text
!   Mark 26.1 Release. NAG Copyright 2016.
    Module e04djae_mod

!     E04DJA 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       :: iset = 1, lcwsav = 1, liwsav = 610,  &
                                          llwsav = 120, lrwsav = 475, nin = 5, &
                                          ninopt = 7, nout = 6
    Contains
      Subroutine objfn2(mode,n,x,objf,objgrd,nstate,iuser,ruser)
!       Routine to evaluate F(x)

!       .. 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)

        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 e04djae_mod
    Program e04djae

!     E04DJA Example Main Program

!     .. Use Statements ..
      Use e04djae_mod, Only: iset, lcwsav, liwsav, llwsav, lrwsav, nin,        &
                             ninopt, nout, objfn1
      Use nag_library, Only: e04dga, e04dja, e04dka, e04wbf, nag_wp, x04abf,   &
                             x04acf, x04baf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Character (*), Parameter         :: fname = 'e04djae.opt'
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: objf
      Integer                          :: i, 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), rwsav(lrwsav)
      Integer                          :: iuser(1), iwsav(liwsav)
      Integer, Allocatable             :: iwork(:)
      Logical                          :: lwsav(llwsav)
      Character (80)                   :: cwsav(lcwsav)
!     .. Executable Statements ..
      Write (rec,99995) 'E04DJA 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(iset,outchn)

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

!     Initialise using E04WBF

      ifail = 0
      Call e04wbf('E04DGA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav,       &
        lrwsav,ifail)

!     Set two options using E04DKA

      Call e04dka(' Verify Level = -1 ',lwsav,iwsav,rwsav,inform)

      If (inform==0) Then

        Call e04dka(' Maximum Step Length = 100.0 ',lwsav,iwsav,rwsav,inform)

      End If

      If (inform/=0) Then
        Write (rec,99996) 'E04DKA terminated with INFORM = ', inform

        Call x04baf(nout,rec)

        Go To 100
      End If

!     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 e04dja(ninopt,lwsav,iwsav,rwsav,inform)

      If (inform/=0) Then
        Write (rec,99996) 'E04DJA terminated with INFORM = ', inform

        Call x04baf(nout,rec)

        Go To 100
      End If

!     Solve the problem

      ifail = -1
      Call e04dga(n,objfn1,iter,objf,objgrd,x,iwork,work,iuser,ruser,lwsav,    &
        iwsav,rwsav,ifail)

      Select Case (ifail)
      Case (0:8)
        Write (rec,'()')
        Call x04baf(nout,rec)
        Write (rec,99999)
        Call x04baf(nout,rec)
        Write (rec,'()')
        Call x04baf(nout,rec)

        Do i = 1, n
          Write (rec,99998) i, x(i), objgrd(i)
          Call x04baf(nout,rec)
        End Do

        Write (rec,'()')
        Call x04baf(nout,rec)
        Write (rec,'()')
        Call x04baf(nout,rec)
        Write (rec,99997) objf
        Call x04baf(nout,rec)
      End Select

100   Continue

99999 Format (1X,'Variable',10X,'Value',8X,'Gradient value')
99998 Format (1X,'Varbl',1X,I3,4X,1P,G15.7,4X,1P,G9.1)
99997 Format (1X,'Final objective value = ',G15.7)
99996 Format (1X,A,I5)
99995 Format (1X,A)
    End Program e04djae