! E04DJA Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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 ! .. Parameters .. Integer, Parameter :: 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) ! .. 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) 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 nag_library, Only: e04dga, e04dja, e04dka, e04wbf, nag_wp, x04abf, & x04acf, x04baf Use e04djae_mod, Only: iset, lcwsav, liwsav, llwsav, lrwsav, nin, & ninopt, nout, objfn1 ! .. 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