! E04CCA Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE e04ccae_mod ! E04CCA Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: n = 2, nout = 6 INTEGER, PARAMETER :: iw = n + 1 ! .. Local Scalars .. LOGICAL :: monitoring CONTAINS SUBROUTINE funct(n,xc,fc,iuser,ruser) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: fc INTEGER, INTENT (IN) :: n ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: ruser(*) REAL (KIND=nag_wp), INTENT (IN) :: xc(n) INTEGER, INTENT (INOUT) :: iuser(*) ! .. Intrinsic Functions .. INTRINSIC exp ! .. Executable Statements .. fc = exp(xc(1))*(4.0_nag_wp*xc(1)*(xc(1)+xc(2))+2.0_nag_wp*xc(2)*(xc & (2)+1.0_nag_wp)+1.0_nag_wp) RETURN END SUBROUTINE funct SUBROUTINE monit(fmin,fmax,sim,n,nvert,ncall,iuser,ruser) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: fmax, fmin INTEGER, INTENT (IN) :: n, ncall, nvert ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (INOUT) :: ruser(*) REAL (KIND=nag_wp), INTENT (IN) :: sim(nvert,n) INTEGER, INTENT (INOUT) :: iuser(*) ! .. Executable Statements .. IF (monitoring) THEN WRITE (nout,99999) 'After', ncall, & ' function calls, the value is', fmin, ' with simplex' WRITE (nout,99998) sim(1:nvert,1:n) END IF RETURN 99999 FORMAT (1X,A,I5,A,F10.4,A) 99998 FORMAT (1X,2F12.4) END SUBROUTINE monit END MODULE e04ccae_mod PROGRAM e04ccae ! E04CCA Example Main Program ! .. Use Statements .. USE nag_library, ONLY : e04cca, nag_wp, x02ajf USE e04ccae_mod, ONLY : funct, iw, monit, monitoring, n, nout ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: f, tol INTEGER :: ifail, maxcal ! .. Local Arrays .. REAL (KIND=nag_wp) :: ruser(1), w1(n), w2(n), w3(n), & w4(n), w5(iw), w6(iw,n), x(n) INTEGER :: iuser(1) ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. WRITE (nout,*) 'E04CCA Example Program Results' ! Set MONITORING to .TRUE. to obtain monitoring information monitoring = .FALSE. x(1:n) = (/ -1.0_nag_wp, 1.0_nag_wp/) tol = sqrt(x02ajf()) maxcal = 100 ifail = 0 CALL e04cca(n,x,f,tol,iw,w1,w2,w3,w4,w5,w6,funct,monit,maxcal,iuser, & ruser,ifail) SELECT CASE (ifail) CASE (0:) WRITE (nout,*) WRITE (nout,99999) 'Final function value is ', f WRITE (nout,99999) 'at the point', x(1:n) END SELECT 99999 FORMAT (1X,A,2F12.4) END PROGRAM e04ccae