! D01EAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01eafe_mod ! D01EAF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: mulcls = 1, ndim = 4, nfun = 10, & nout = 6 Integer, Parameter :: ircls = 2**ndim + 2*ndim*(ndim + & 1) + 1 Integer, Parameter :: & lenwrk = (ndim+nfun+2)*(10+mulcls) Integer, Parameter :: mxcls = mulcls*ircls Contains Subroutine funsub(ndim,z,nfun,f) ! .. Scalar Arguments .. Integer, Intent (In) :: ndim, nfun ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: f(nfun) Real (Kind=nag_wp), Intent (In) :: z(ndim) ! .. Local Scalars .. Real (Kind=nag_wp) :: sum Integer :: i, n ! .. Intrinsic Procedures .. Intrinsic :: log, real, sin ! .. Executable Statements .. sum = 0.0E0_nag_wp Do n = 1, ndim sum = sum + real(n,kind=nag_wp)*z(n) End Do Do i = 1, nfun f(i) = log(sum)*sin(real(i,kind=nag_wp)+sum) End Do Return End Subroutine funsub End Module d01eafe_mod Program d01eafe ! D01EAF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01eaf, nag_wp Use d01eafe_mod, Only: funsub, lenwrk, mxcls, ndim, nfun, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: absreq, relreq Integer :: i, ifail, maxcls, mincls, mulfac ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:), absest(:), b(:), & finest(:), wrkstr(:) ! .. Executable Statements .. Write (nout,*) 'D01EAF Example Program Results' Flush (nout) Allocate (a(ndim),absest(nfun),b(ndim),finest(nfun),wrkstr(lenwrk)) a(1:ndim) = 0.0_nag_wp b(1:ndim) = 1.0_nag_wp mincls = 0 maxcls = mxcls absreq = 0.0_nag_wp relreq = 1.0E-3_nag_wp If (ndim<=10) Then mulfac = 2**ndim Else mulfac = 2*ndim**3 End If loop: Do ifail = -1 Call d01eaf(ndim,a,b,mincls,maxcls,nfun,funsub,absreq,relreq,lenwrk, & wrkstr,finest,absest,ifail) Select Case (ifail) Case (1,3) Write (nout,*) Write (nout,99999) mincls Write (nout,99998) Do i = 1, nfun Write (nout,99997) i, finest(i), absest(i) End Do Write (nout,*) Flush (nout) mincls = -1 maxcls = maxcls*mulfac Case (0) Write (nout,*) Write (nout,99996) mincls Write (nout,99998) Do i = 1, nfun Write (nout,99997) i, finest(i), absest(i) End Do Exit loop Case Default Exit loop End Select End Do loop 99999 Format (1X,'Results so far (',I7,' FUNSUB calls in last call of D01EAF)' & ) 99998 Format (/1X,' I Integral Estimated error') 99997 Format (1X,I4,2F14.4) 99996 Format (1X,'Final Results (',I7,' FUNSUB calls in last call of D01EAF)') End Program d01eafe