NAG Library Manual, Mark 30.2
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   E04VJF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

    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 e04vjfe_mod, Only: lencw, leniw, lenrw, nin, nout, usrfun
      Use nag_library, Only: e04vgf, e04vhf, e04vjf, e04vlf, e04vmf, nag_wp
!     .. 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
      Logical                          :: verbose_output
      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))

      Write (nout,99999) n

!     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,99998) nea
      Write (nout,99997)
      Write (nout,99996)

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

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

      Do i = 1, neg
        Write (nout,99991) i, igfun(i), jgvar(i)
      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

!     Set this to .True. to cause e04nqf to produce intermediate
!     progress output
      verbose_output = .False.

      If (verbose_output) Then
!       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)
      End If

!     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,99990) f(objrow)
        Write (nout,99989)(x(i),i=1,n)
      End Select

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