! D01JAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01jafe_mod ! D01JAF 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 Function f(ndim,x) ! .. Function Return Value .. Real (Kind=nag_wp) :: f ! .. Scalar Arguments .. Integer, Intent (In) :: ndim ! .. Array Arguments .. Real (Kind=nag_wp), Intent (In) :: x(ndim) ! .. Local Scalars .. Real (Kind=nag_wp) :: a, rho ! .. Intrinsic Procedures .. Intrinsic :: sqrt ! .. Executable Statements .. rho = x(1) a = (1.0E0_nag_wp-rho)*(1.0E0_nag_wp+rho) If (a/=0.0E0_nag_wp) Then f = 1.0E0_nag_wp/sqrt(a) Else f = 0.0E0_nag_wp End If Return End Function f End Module d01jafe_mod Program d01jafe ! D01JAF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01jaf, nag_wp Use d01jafe_mod, Only: f, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: epsa, epsr, esterr, radius, & relest, result Integer :: icoord, ifail, method, ndim, & nevals ! .. Executable Statements .. Write (nout,*) 'D01JAF Example Program Results' radius = 1.0E0_nag_wp method = 0 icoord = 1 epsa = 0.0E0_nag_wp epsr = 0.5E-4_nag_wp test: Do ndim = 2, 4, 2 ifail = -1 Call d01jaf(f,ndim,radius,epsa,epsr,method,icoord,result,esterr, & nevals,ifail) Select Case (ifail) Case (:-1) Exit test Case (0:3) relest = esterr/result Write (nout,*) Write (nout,99999) 'Dimension of the sphere =', ndim Write (nout,99998) 'Requested relative tolerance =', epsr Write (nout,99997) 'Approximation to the integral =', result Write (nout,99999) 'No. of function evaluations =', nevals Write (nout,99998) 'Estimated relative error =', relest End Select End Do test 99999 Format (1X,A,I5) 99998 Format (1X,A,E9.2) 99997 Format (1X,A,F9.5) End Program d01jafe