! E04DJA Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
Module e04djae_mod
! E04DJA 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 :: objfn1
! .. Parameters ..
Integer, Parameter, Public :: iset = 1, lcwsav = 1, liwsav = 610, &
llwsav = 120, lrwsav = 475, nin = 5, &
ninopt = 7, nout = 6
Contains
Subroutine objfn2(mode,n,x,objf,objgrd,nstate,iuser,ruser)
! Routine to evaluate F(x) and its exact 1st derivatives
! .. 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 Procedures ..
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)
If (mode==2) Then
objgrd(1:n) = (/4.0_nag_wp*exp(x1)*(2.0_nag_wp*x1+x2)+objf, &
2.0_nag_wp*exp(x1)*(2.0_nag_wp*x2+2.0_nag_wp*x1+1.0_nag_wp)/)
End If
Return
End Subroutine objfn2
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
! .. 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
End Subroutine objfn1
End Module e04djae_mod
Program e04djae
! E04DJA Example Main Program
! .. Use Statements ..
Use e04djae_mod, Only: iset, lcwsav, liwsav, llwsav, lrwsav, nin, &
ninopt, nout, objfn1
Use nag_library, Only: e04dga, e04dja, e04dka, e04wbf, nag_wp, x04abf, &
x04acf, x04baf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Character (*), Parameter :: fname = 'e04djae.opt'
! .. Local Scalars ..
Real (Kind=nag_wp) :: objf
Integer :: i, 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), rwsav(lrwsav)
Integer :: iuser(1), iwsav(liwsav)
Integer, Allocatable :: iwork(:)
Logical :: lwsav(llwsav)
Character (80) :: cwsav(lcwsav)
! .. Executable Statements ..
Write (rec,99995) 'E04DJA 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(iset,outchn)
Read (nin,*) x(1:n)
! Initialise using E04WBF
ifail = 0
Call e04wbf('E04DGA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav, &
lrwsav,ifail)
! Set two options using E04DKA
Call e04dka(' Verify Level = -1 ',lwsav,iwsav,rwsav,inform)
If (inform==0) Then
Call e04dka(' Maximum Step Length = 100.0 ',lwsav,iwsav,rwsav,inform)
End If
If (inform/=0) Then
Write (rec,99996) 'E04DKA terminated with INFORM = ', inform
Call x04baf(nout,rec)
Go To 100
End If
! 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 e04dja(ninopt,lwsav,iwsav,rwsav,inform)
If (inform/=0) Then
Write (rec,99996) 'E04DJA terminated with INFORM = ', inform
Call x04baf(nout,rec)
Go To 100
End If
! Solve the problem
ifail = -1
Call e04dga(n,objfn1,iter,objf,objgrd,x,iwork,work,iuser,ruser,lwsav, &
iwsav,rwsav,ifail)
Select Case (ifail)
Case (0:8)
Write (rec,'()')
Call x04baf(nout,rec)
Write (rec,99999)
Call x04baf(nout,rec)
Write (rec,'()')
Call x04baf(nout,rec)
Do i = 1, n
Write (rec,99998) i, x(i), objgrd(i)
Call x04baf(nout,rec)
End Do
Write (rec,'()')
Call x04baf(nout,rec)
Write (rec,'()')
Call x04baf(nout,rec)
Write (rec,99997) objf
Call x04baf(nout,rec)
End Select
100 Continue
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)
99996 Format (1X,A,I5)
99995 Format (1X,A)
End Program e04djae