!   E04DJA Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: iset = 1, lcwsav = 1,            &
                                              liwsav = 610, llwsav = 120,      &
                                              lrwsav = 475, nin = 5,           &
                                              ninopt = 7, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: objfn2
       SUBROUTINE objfn2(mode,n,x,objf,objgrd,nstate,iuser,ruser)
!         Routine to evaluate F(x)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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

!dec$ attributes offload : mic :: objfn2
       END SUBROUTINE objfn2
!dec$ attributes offload : mic :: objfn1
       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
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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

!dec$ attributes offload : mic :: objfn1
       END SUBROUTINE objfn1
    END MODULE e04djae_mod
    PROGRAM e04djae

!      E04DJA Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : e04dga, e04dja, e04dka, e04wbf, x04abf, x04acf, &
                               x04baf
       USE e04djae_mod, ONLY : iset, lcwsav, liwsav, llwsav, lrwsav, nag_wp,   &
                               nin, ninopt, nout, objfn1
!      .. 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 20
       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 20
       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

20     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
