! E04ABA Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module e04abae_mod ! E04ABA Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nout = 6 Contains Subroutine funct(xc,fc,iuser,ruser) ! Routine to evaluate F(x) at any point in (A, B) ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: fc Real (Kind=nag_wp), Intent (In) :: xc ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: ruser(*) Integer, Intent (Inout) :: iuser(*) ! .. Intrinsic Procedures .. Intrinsic :: sin ! .. Executable Statements .. fc = sin(xc)/xc Return End Subroutine funct End Module e04abae_mod Program e04abae ! E04ABA Example Main Program ! .. Use Statements .. Use nag_library, Only: e04aba, nag_wp Use e04abae_mod, Only: funct, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: a, b, e1, e2, f, x Integer :: ifail, maxcal ! .. Local Arrays .. Real (Kind=nag_wp) :: ruser(1) Integer :: iuser(1) ! .. Executable Statements .. Write (nout,*) 'E04ABA Example Program Results' ! E1 and E2 are set to zero so that E04ABA will reset them to ! their default values e1 = 0.0_nag_wp e2 = 0.0_nag_wp ! The minimum is known to lie in the range (3.5, 5.0) a = 3.5_nag_wp b = 5.0_nag_wp ! Allow 30 calls of FUNCT maxcal = 30 ifail = -1 Call e04aba(funct,e1,e2,a,b,maxcal,x,f,iuser,ruser,ifail) Select Case (ifail) Case (0,2) Write (nout,*) Write (nout,99999) 'The minimum lies in the interval', a, ' to', b Write (nout,99999) 'Its estimated position is', x, ',' Write (nout,99998) 'where the function value is ', f Write (nout,99997) maxcal, 'function evaluations were required' End Select 99999 Format (1X,A,F11.8,A,F11.8) 99998 Format (1X,A,F7.4) 99997 Format (1X,I2,1X,A) End Program e04abae