! E04DJF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module e04djfe_mod ! E04DJF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: 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 e04djfe_mod Program e04djfe ! E04DJF Example Main Program ! .. Use Statements .. Use nag_library, Only: e04dgf, e04djf, e04dkf, nag_wp, x04abf, x04acf, & x04baf Use e04djfe_mod, Only: nin, ninopt, nout, objfn1 ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Character (*), Parameter :: fname = 'e04djfe.opt' ! .. Local Scalars .. Real (Kind=nag_wp) :: objf Integer :: 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) Integer :: iuser(1) Integer, Allocatable :: iwork(:) ! .. Executable Statements .. Write (rec,99998) 'E04DJF 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(1,outchn) Read (nin,*) x(1:n) ! Set two options using E04DKF Call e04dkf(' Verify Level = -1 ') Call e04dkf(' Maximum Step Length = 100.0 ') ! 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 e04djf(ninopt,inform) If (inform/=0) Then Write (rec,99999) 'E04DJF terminated with INFORM = ', inform Call x04baf(nout,rec) Go To 100 End If ! Solve the problem ifail = -1 Call e04dgf(n,objfn1,iter,objf,objgrd,x,iwork,work,iuser,ruser,ifail) 100 Continue 99999 Format (1X,A,I5) 99998 Format (1X,A) End Program e04djfe