! D01BAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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) ! .. 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) ! .. Function Return Value .. Real (Kind=nag_wp) :: fun2 ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. Intrinsic :: log ! .. Executable Statements .. fun2 = 1.0E0_nag_wp/(x*x*log(x)) Return End Function fun2 Function fun3(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: fun3 ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. Intrinsic :: exp ! .. Executable Statements .. fun3 = exp(-x)/x Return End Function fun3 Function fun4(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: fun4 ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Intrinsic Procedures .. 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