! E04DGA Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module e04dgae_mod ! E04DGA Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: lcwsav = 1, liwsav = 610, & llwsav = 120, lrwsav = 475, & nin = 5, nout = 6 Contains Subroutine objfun(mode,n,x,objf,objgrd,nstate,iuser,ruser) ! Routine to evaluate F(x) and its 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) :: expx1, x1, x2 ! .. Intrinsic Procedures .. Intrinsic :: exp ! .. Executable Statements .. x1 = x(1) x2 = x(2) expx1 = exp(x1) objf = expx1*(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*expx1*(2.0_nag_wp*x1+x2)+objf, & 2.0_nag_wp*expx1*(2.0_nag_wp*x2+2.0_nag_wp*x1+1.0_nag_wp)/) End If Return End Subroutine objfun End Module e04dgae_mod Program e04dgae ! E04DGA Example Main Program ! .. Use Statements .. Use nag_library, Only: e04dga, e04wbf, nag_wp Use e04dgae_mod, Only: lcwsav, liwsav, llwsav, lrwsav, nin, nout, objfun ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: objf Integer :: i, ifail, iter, n ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: objgrd(:), work(:), x(:) Real (Kind=nag_wp) :: rwsav(lrwsav), user(1) Integer :: iuser(1), iwsav(liwsav) Integer, Allocatable :: iwork(:) Logical :: lwsav(llwsav) Character (80) :: cwsav(lcwsav) ! .. Executable Statements .. Write (nout,*) 'E04DGA Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) n Allocate (iwork(n+1),objgrd(n),x(n),work(13*n)) Read (nin,*) x(1:n) ! Initialise E04DGA ifail = 0 Call e04wbf('E04DGA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav, & lrwsav,ifail) ! Solve the problem ifail = -1 Call e04dga(n,objfun,iter,objf,objgrd,x,iwork,work,iuser,user,lwsav, & iwsav,rwsav,ifail) Select Case (ifail) Case (0:8) Write (nout,*) Write (nout,99999) Write (nout,*) Do i = 1, n Write (nout,99998) i, x(i), objgrd(i) End Do Write (nout,*) Write (nout,*) Write (nout,99997) objf End Select 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) End Program e04dgae