! D01ASF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01asfe_mod ! D01ASF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: limlst = 50, lw = 800, nout = 6 Integer, Parameter :: liw = lw/2 Contains Function g(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: g ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. Intrinsic :: sqrt ! .. Executable Statements .. If (x>0.0E0_nag_wp) Then g = 1.0E0_nag_wp/sqrt(x) Else g = 0.0E0_nag_wp End If Return End Function g End Module d01asfe_mod Program d01asfe ! D01ASF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01asf, nag_wp, x01aaf Use d01asfe_mod, Only: g, limlst, liw, lw, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: a, abserr, epsabs, omega, result Integer :: ifail, key, lst ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: erlst(:), rslst(:), w(:) Integer, Allocatable :: ierlst(:), iw(:) ! .. Executable Statements .. Write (nout,*) 'D01ASF Example Program Results' Allocate (erlst(limlst),rslst(limlst),w(lw),ierlst(limlst),iw(liw)) epsabs = 1.0E-03_nag_wp a = 0.0E0_nag_wp omega = 0.5E0_nag_wp*x01aaf(omega) key = 1 ifail = -1 Call d01asf(g,a,omega,key,epsabs,result,abserr,limlst,lst,erlst,rslst, & ierlst,w,lw,iw,liw,ifail) If (ifail>=0) Then Write (nout,*) Write (nout,99999) 'A - lower limit of integration = ', a Write (nout,*) 'B - upper limit of integration = infinity' Write (nout,99998) 'EPSABS - absolute accuracy requested = ', epsabs If (ifail/=6 .And. ifail/=10) 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) 'LST - number of intervals used = ', lst Write (nout,99996) & 'IW(1) - max. no. of subintervals used in any one interval = ', & iw(1) End If End If 99999 Format (1X,A,F10.4) 99998 Format (1X,A,E9.2) 99997 Format (1X,A,F9.5) 99996 Format (1X,A,I4) End Program d01asfe