! D01BAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d01bafe_mod ! D01BAF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE CONTAINS FUNCTION fun1(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: fun1 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Executable Statements .. fun1 = 4.0E0_nag_wp/(1.0E0_nag_wp+x*x) RETURN END FUNCTION fun1 FUNCTION fun2(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: fun2 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Intrinsic Functions .. INTRINSIC log ! .. Executable Statements .. fun2 = 1.0E0_nag_wp/(x*x*log(x)) RETURN END FUNCTION fun2 FUNCTION fun3(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: fun3 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Intrinsic Functions .. INTRINSIC exp ! .. Executable Statements .. fun3 = exp(-x)/x RETURN END FUNCTION fun3 FUNCTION fun4(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: fun4 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Intrinsic Functions .. INTRINSIC exp ! .. Executable Statements .. fun4 = exp(-3.0E0_nag_wp*x*x-4.0E0_nag_wp*x-1.0E0_nag_wp) RETURN END FUNCTION fun4 END MODULE d01bafe_mod PROGRAM d01bafe ! D01BAF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d01baf, d01baw, d01bax, d01bay, d01baz, nag_wp USE d01bafe_mod, ONLY : fun1, fun2, fun3, fun4 ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: a, ans, b INTEGER :: i, icase, ifail, nstor ! .. Executable Statements .. WRITE (nout,*) 'D01BAF Example Program Results' CASES: DO icase = 1, 4 WRITE (nout,*) SELECT CASE (icase) CASE (1) WRITE (nout,*) 'Gauss-Legendre example' a = 0.0_nag_wp b = 1.0_nag_wp CASE (2) WRITE (nout,*) 'Gauss-Rational example' a = 2.0_nag_wp b = 0.0_nag_wp CASE (3) WRITE (nout,*) 'Gauss-Laguerre example' a = 2.0_nag_wp b = 1.0_nag_wp CASE (4) WRITE (nout,*) 'Gauss-Hermite example' a = -1.0_nag_wp b = 3.0_nag_wp END SELECT DO i = 1, 3 nstor = 2**(i+1) ifail = -1 SELECT CASE (icase) CASE (1) ans = d01baf(d01baz,a,b,nstor,fun1,ifail) CASE (2) ans = d01baf(d01bay,a,b,nstor,fun2,ifail) CASE (3) ans = d01baf(d01bax,a,b,nstor,fun3,ifail) CASE (4) ans = d01baf(d01baw,a,b,nstor,fun4,ifail) END SELECT IF (ifail<0) EXIT CASES IF (ifail==0 .OR. ifail==1) WRITE (nout,99999) nstor, ans END DO WRITE (nout,*) END DO CASES 99999 FORMAT (1X,I5,' Points Answer = ',F10.5) END PROGRAM d01bafe