!   E04DGA Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    MODULE e04dgae_mod

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

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: lcwsav = 1, liwsav = 610,        &
                                              llwsav = 120, lrwsav = 475,      &
                                              nin = 5, nout = 6
    CONTAINS
       SUBROUTINE objfun(mode,n,x,objf,objgrd,nstate,iuser,ruser)
!         Routine to evaluate F(x) and its 1st derivatives.

!         .. 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)                  :: expx1, x1, x2
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          x1 = x(1)
          x2 = x(2)
          expx1 = exp(x1)
          objf = expx1*(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*expx1*(2.0_nag_wp*x1+x2) + objf, &
                2.0_nag_wp*expx1*(2.0_nag_wp*x2+2.0_nag_wp*x1+1.0_nag_wp) /)
          END IF

          RETURN

       END SUBROUTINE objfun
    END MODULE e04dgae_mod
    PROGRAM e04dgae

!      E04DGA Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : e04dga, e04wbf
       USE e04dgae_mod, ONLY : lcwsav, liwsav, llwsav, lrwsav, nag_wp, nin,    &
                               nout, objfun
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: objf
       INTEGER                             :: i, ifail, iter, n
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: objgrd(:), work(:), x(:)
       REAL (KIND=nag_wp)                  :: rwsav(lrwsav), user(1)
       INTEGER                             :: iuser(1), iwsav(liwsav)
       INTEGER, ALLOCATABLE                :: iwork(:)
       LOGICAL                             :: lwsav(llwsav)
       CHARACTER (80)                      :: cwsav(lcwsav)
!      .. Executable Statements ..
       WRITE (nout,*) 'E04DGA Example Program Results'

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

       READ (nin,*) n
       ALLOCATE (iwork(n+1),objgrd(n),x(n),work(13*n))

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

!      Initialise E04DGA

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

!      Solve the problem

       ifail = -1
       CALL e04dga(n,objfun,iter,objf,objgrd,x,iwork,work,iuser,user,lwsav, &
          iwsav,rwsav,ifail)

       SELECT CASE (ifail)
       CASE (0:8)
          WRITE (nout,*)
          WRITE (nout,99999)
          WRITE (nout,*)

          DO i = 1, n
             WRITE (nout,99998) i, x(i), objgrd(i)
          END DO

          WRITE (nout,*)
          WRITE (nout,*)
          WRITE (nout,99997) objf
       END SELECT

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)
    END PROGRAM e04dgae