!   E04DJF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: 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 e04djfe_mod
    PROGRAM e04djfe

!      E04DJF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : e04dgf, e04djf, e04dkf, x04abf, x04acf, x04baf
       USE e04djfe_mod, ONLY : nag_wp, nin, ninopt, nout, objfn1
!      .. 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 20
       END IF

!      Solve the problem

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

20     CONTINUE

99999  FORMAT (1X,A,I5)
99998  FORMAT (1X,A)
    END PROGRAM e04djfe
