! 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