!   E04VJF Example Program Text
!   Mark 25 Release. NAG Copyright 2014.

    Module e04vjfe_mod

!     E04VJF 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                               :: usrfun
!     .. Parameters ..
      Integer, Parameter, Public           :: lencw = 600, leniw = 600,        &
                                              lenrw = 600, nin = 5, nout = 6
    Contains
      Subroutine usrfun(status,n,x,needf,nf,f,needg,leng,g,cuser,iuser,ruser)

!       .. Scalar Arguments ..
        Integer, Intent (In)                 :: leng, n, needf, needg, nf
        Integer, Intent (Inout)              :: status
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout)   :: f(nf), g(leng), ruser(*)
        Real (Kind=nag_wp), Intent (In)      :: x(n)
        Integer, Intent (Inout)              :: iuser(*)
        Character (8), Intent (Inout)        :: cuser(*)
!       .. Intrinsic Procedures ..
        Intrinsic                            :: sin
!       .. Executable Statements ..
        If (needf>0) Then
          f(1) = 1000.0E+0_nag_wp*sin(-x(1)-0.25E+0_nag_wp) + &
            1000.0E+0_nag_wp*sin(-x(2)-0.25E+0_nag_wp) - x(3)
          f(2) = 1000.0E+0_nag_wp*sin(x(1)-0.25E+0_nag_wp) + &
            1000.0E+0_nag_wp*sin(x(1)-x(2)-0.25E+0_nag_wp) - x(4)
          f(3) = 1000.0E+0_nag_wp*sin(x(2)-x(1)-0.25E+0_nag_wp) + &
            1000.0E+0_nag_wp*sin(x(2)-0.25E+0_nag_wp)
          f(4) = -x(1) + x(2)
          f(5) = x(1) - x(2)
          f(6) = 1.0E-6_nag_wp*x(3)**3 + 2.0E-6_nag_wp*x(4)**3/3.0E+0_nag_wp + &
            3.0E0_nag_wp*x(3) + 2.0E0_nag_wp*x(4)
        End If

        Return

      End Subroutine usrfun
    End Module e04vjfe_mod
    Program e04vjfe

!     E04VJF Example Main Program

!     .. Use Statements ..
      Use nag_library, Only: e04vgf, e04vhf, e04vjf, e04vlf, e04vmf, nag_wp
      Use e04vjfe_mod, Only: lencw, leniw, lenrw, nin, nout, usrfun
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)                   :: objadd, sinf
      Integer                              :: i, ifail, lena, leng, n, nea,    &
                                              neg, nf, nfname, ninf, ns,       &
                                              nxname, objrow, start
      Character (8)                        :: prob
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable      :: a(:), f(:), flow(:), fmul(:),    &
                                              fupp(:), x(:), xlow(:), xmul(:), &
                                              xupp(:)
      Real (Kind=nag_wp)                   :: ruser(1), rw(lenrw)
      Integer, Allocatable                 :: fstate(:), iafun(:), igfun(:),   &
                                              javar(:), jgvar(:), xstate(:)
      Integer                              :: iuser(1), iw(leniw)
      Character (8)                        :: cuser(1), cw(lencw)
      Character (8), Allocatable           :: fnames(:), xnames(:)
!     .. Executable Statements ..
      Write (nout,*) 'E04VJF Example Program Results'

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

      Read (nin,*) n, nf
      lena = 300
      leng = 300
      nxname = 1
      nfname = 1
      Allocate (iafun(lena),javar(lena),igfun(leng),jgvar(leng),xstate(n), &
        fstate(nf),a(lena),xlow(n),xupp(n),flow(nf),fupp(nf),x(n),xmul(n), &
        f(nf),fmul(nf),xnames(nxname),fnames(nfname))

!     Call E04VGF to initialise E04VJF.

      ifail = 0
      Call e04vgf(cw,lencw,iw,leniw,rw,lenrw,ifail)

!     Read the bounds on the variables.

      Do i = 1, n
        Read (nin,*) xlow(i), xupp(i)
      End Do

      x(1:n) = 0.0E0_nag_wp

!     Determine the Jacobian structure.

      ifail = 0
      Call e04vjf(nf,n,usrfun,iafun,javar,a,lena,nea,igfun,jgvar,leng,neg,x, &
        xlow,xupp,cw,lencw,iw,leniw,rw,lenrw,cuser,iuser,ruser,ifail)

!     Print the Jacobian structure.

      Write (nout,*)
      Write (nout,99999) nea
      Write (nout,99998)
      Write (nout,99997)

      Do i = 1, nea
        Write (nout,99996) i, iafun(i), javar(i), a(i)
      End Do

      Write (nout,*)
      Write (nout,99995) neg
      Write (nout,99994)
      Write (nout,99993)

      Do i = 1, neg
        Write (nout,99992) i, igfun(i), jgvar(i)
        Flush (nout)
      End Do

!     Now that we have the determined the structure of the
!     Jacobian, set up the information necessary to solve
!     the optimization problem.

      start = 0
      prob = ' '
      objadd = 0.0E0_nag_wp
      x(1:n) = 0.0E0_nag_wp
      xstate(1:n) = 0
      xmul(1:n) = 0.0E0_nag_wp
      f(1:nf) = 0.0E0_nag_wp
      fstate(1:nf) = 0
      fmul(1:nf) = 0.0E0_nag_wp

!     The row containing the objective function.

      Read (nin,*) objrow

!     Read the bounds on the functions.

      Do i = 1, nf
        Read (nin,*) flow(i), fupp(i)
      End Do

!     By default E04VHF does not print monitoring
!     information. Set the print file unit or the summary
!     file unit to get information.

      ifail = 0
      Call e04vmf('Print file',nout,cw,iw,rw,ifail)

!     Tell E04VHF that we supply no derivatives in USRFUN.

      ifail = 0
      Call e04vlf('Derivative option 0',cw,iw,rw,ifail)

!     Solve the problem.

      ifail = -1
      Call e04vhf(start,nf,n,nxname,nfname,objadd,objrow,prob,usrfun,iafun, &
        javar,a,lena,nea,igfun,jgvar,leng,neg,xlow,xupp,xnames,flow,fupp, &
        fnames,x,xstate,xmul,f,fstate,fmul,ns,ninf,sinf,cw,lencw,iw,leniw,rw, &
        lenrw,cuser,iuser,ruser,ifail)

      Select Case (ifail)
      Case (0,4)
        Write (nout,*)
        Write (nout,99991) f(objrow)
        Write (nout,99990)(x(i),i=1,n)
      End Select

99999 Format (1X,'NEA (the number of non-zero entries in A) = ',I3)
99998 Format (1X,'  I     IAFUN(I)   JAVAR(I)          A(I)')
99997 Format (1X,'----    --------   --------   -----------')
99996 Format (1X,I3,2I10,1P,E18.4)
99995 Format (1X,'NEG (the number of non-zero entries in G) = ',I3)
99994 Format (1X,'  I     IGFUN(I)   JGVAR(I)')
99993 Format (1X,'----    --------   --------')
99992 Format (1X,I3,2I10)
99991 Format (1X,'Final objective value = ',F11.1)
99990 Format (1X,'Optimal X = ',7F9.2)
    End Program e04vjfe