! D02UYF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d02uyfe_mod ! D02UYF 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 = 3.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: zero = 0.0_nag_wp INTEGER, PARAMETER :: nin = 5, nout = 6 LOGICAL, PARAMETER :: reqerr = .FALSE., reqwgt = .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 ! .. Executable Statements .. exact = 3.0_nag_wp*x**2 RETURN END FUNCTION exact END MODULE d02uyfe_mod PROGRAM d02uyfe ! D02UYF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d02ucf, d02uyf, ddot, nag_wp, x02ajf USE d02uyfe_mod, ONLY : a, b, exact, nin, nout, reqerr, reqwgt ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: integ, scale, uerr INTEGER :: i, ifail, iu, n ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: f(:), w(:), x(:) ! .. Intrinsic Functions .. INTRINSIC abs, int ! .. Executable Statements .. WRITE (nout,*) ' D02UYF Example Program Results ' WRITE (nout,*) READ (nin,*) READ (nin,*) n ALLOCATE (f(n+1),w(n+1),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 scale = 0.5_nag_wp*(b-a) ! Solve on equally spaced grid ifail = 0 CALL d02uyf(n,w,ifail) ! The NAG name equivalent of ddot is f06eaf integ = ddot(n+1,w,1,f,1)*scale ! Print function values and weights if required IF (reqwgt) THEN WRITE (nout,*) ' f(x) and Integral weights' WRITE (nout,*) WRITE (nout,99999) WRITE (nout,99998) (x(i),f(i),w(i),i=1,n+1) END IF ! Print approximation to integral WRITE (nout,99996) a, b, integ IF (reqerr) THEN uerr = abs(integ-28.0_nag_wp) iu = 10*(int(uerr/10.0_nag_wp/x02ajf())+1) WRITE (nout,99997) iu END IF 99999 FORMAT (1X,T8,'X',T18,'f(X)',T28,'W') 99998 FORMAT (1X,3F10.4) 99997 FORMAT (/1X,'Integral is within a multiple ',I8, & ' of machine precision.') 99996 FORMAT (/1X,'Integral of f(x) from ',F6.1,' to ',F6.2,' = ',F13.5,'.'/) END PROGRAM d02uyfe