! D02UWF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d02uwfe_mod ! D02UWF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: a = -1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: b = 1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: zero = 0.0_nag_wp INTEGER, PARAMETER :: nin = 5, nout = 6 LOGICAL, PARAMETER :: reqerr = .FALSE. CONTAINS FUNCTION exact(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: exact ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Intrinsic Functions .. INTRINSIC cos ! .. Executable Statements .. exact = x + cos(5.0_nag_wp*x) RETURN END FUNCTION exact END MODULE d02uwfe_mod PROGRAM d02uwfe ! D02UWF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d02ucf, d02uwf, nag_wp, x02ajf USE d02uwfe_mod, ONLY : a, b, exact, nin, nout, reqerr, zero ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: uerr INTEGER :: i, ifail, iu, n, nip ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: f(:), fip(:), x(:), xip(:) ! .. Intrinsic Functions .. INTRINSIC abs, int, max ! .. Executable Statements .. WRITE (nout,*) ' D02UWF Example Program Results ' WRITE (nout,*) READ (nin,*) READ (nin,*) n, nip ALLOCATE (f(n+1),fip(nip),xip(nip),x(n+1)) ! Set up solution grid ifail = 0 CALL d02ucf(n,a,b,x,ifail) ! Set up problem right hand sides for grid DO i = 1, n + 1 f(i) = exact(x(i)) END DO ! Map to an equally spaced grid ifail = 0 CALL d02uwf(n,nip,x,f,xip,fip,ifail) ! Print solution WRITE (nout,*) ' Numerical solution F' WRITE (nout,*) WRITE (nout,99999) WRITE (nout,99998) (xip(i),fip(i),i=1,nip) IF (reqerr) THEN uerr = zero DO i = 1, nip uerr = max(uerr,abs(fip(i)-exact(xip(i)))) END DO iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1) WRITE (nout,99997) iu END IF 99999 FORMAT (1X,T8,'X',T19,'F') 99998 FORMAT (1X,F10.4,1X,F10.4) 99997 FORMAT (//1X,'F is within a multiple ',I8,' of machine precision.') END PROGRAM d02uwfe