! D01ATF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01atfe_mod ! D01ATF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: lw = 800, nout = 6 Integer, Parameter :: liw = lw/4 ! .. Local Scalars .. Real (Kind=nag_wp) :: pi Contains Subroutine f(x,fv,n) ! .. Scalar Arguments .. Integer, Intent (In) :: n ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: fv(n) Real (Kind=nag_wp), Intent (In) :: x(n) ! .. Intrinsic Procedures .. Intrinsic :: sin, sqrt ! .. Executable Statements .. fv(1:n) = x(1:n)*sin(30.0E0_nag_wp*x(1:n))/sqrt(1.0E0_nag_wp-x(1:n)**2 & /(4.0E0_nag_wp*pi**2)) Return End Subroutine f End Module d01atfe_mod Program d01atfe ! D01ATF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01atf, nag_wp, x01aaf Use d01atfe_mod, Only: f, liw, lw, nout, pi ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: a, abserr, b, epsabs, epsrel, & result Integer :: ifail ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: w(:) Integer, Allocatable :: iw(:) ! .. Executable Statements .. Write (nout,*) 'D01ATF Example Program Results' Allocate (w(lw),iw(liw)) pi = x01aaf(pi) epsabs = 0.0_nag_wp epsrel = 1.0E-04_nag_wp a = 0.0_nag_wp b = 2.0_nag_wp*pi ifail = -1 Call d01atf(f,a,b,epsabs,epsrel,result,abserr,w,lw,iw,liw,ifail) If (ifail>=0) Then Write (nout,*) Write (nout,99999) 'A ', 'lower limit of integration', a Write (nout,99999) 'B ', 'upper limit of integration', b Write (nout,99998) 'EPSABS', 'absolute accuracy requested', epsabs Write (nout,99998) 'EPSREL', 'relative accuracy requested', epsrel End If If (ifail>=0 .And. ifail<=5) Then Write (nout,*) Write (nout,99997) 'RESULT', 'approximation to the integral', result Write (nout,99998) 'ABSERR', 'estimate of the absolute error', abserr Write (nout,99996) 'IW(1) ', 'number of subintervals used', iw(1) End If 99999 Format (1X,A6,' - ',A30,' = ',F10.4) 99998 Format (1X,A6,' - ',A30,' = ',E9.2) 99997 Format (1X,A6,' - ',A30,' = ',F9.5) 99996 Format (1X,A6,' - ',A30,' = ',I4) End Program d01atfe