! D01PAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01pafe_mod ! D01PAF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: mxord = 5, ndim = 3, nout = 6 Integer, Parameter :: sdvert = 2*(ndim+1) Integer, Parameter :: ldvert = ndim + 1 Contains Function functn(ndim,x) ! .. Function Return Value .. Real (Kind=nag_wp) :: functn ! .. Scalar Arguments .. Integer, Intent (In) :: ndim ! .. Array Arguments .. Real (Kind=nag_wp), Intent (In) :: x(ndim) ! .. Intrinsic Procedures .. Intrinsic :: cos, exp ! .. Executable Statements .. functn = exp(x(1)+x(2)+x(3))*cos(x(1)+x(2)+x(3)) Return End Function functn End Module d01pafe_mod Program d01pafe ! D01PAF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01paf, nag_wp Use d01pafe_mod, Only: functn, ldvert, mxord, ndim, nout, sdvert ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: esterr Integer :: ifail, j, maxord, minord, nevals ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: finvls(:), vert(:,:) ! .. Executable Statements .. Write (nout,*) 'D01PAF Example Program Results' Allocate (finvls(mxord),vert(ldvert,sdvert)) vert(1:ldvert,1:ndim) = 0.0_nag_wp Do j = 2, ldvert vert(j,j-1) = 1.0_nag_wp End Do minord = 0 nevals = 1 Do maxord = 1, mxord ifail = 0 Call d01paf(ndim,vert,ldvert,sdvert,functn,minord,maxord,finvls, & esterr,ifail) If (maxord==1) Write (nout,99999) Write (nout,99998) maxord, finvls(maxord), esterr, nevals nevals = (nevals*(maxord+ndim+1))/maxord End Do 99999 Format (/1X,'MAXORD Estimated Estimated Integrand'/1X, & ' value accuracy evaluations') 99998 Format (1X,I4,F13.5,E16.3,I15) End Program d01pafe