! D01EAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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) ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 Functions .. 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