! E04DGA Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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. ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 Functions .. 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 USE e04dgae_mod, ONLY : lcwsav, liwsav, llwsav, lrwsav, nag_wp, 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