! D01APF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module d01apfe_mod ! D01APF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: lw = 800, nout = 6 Integer, Parameter :: liw = lw/4 Contains Function g1(x) ! .. Use Statements .. Use nag_library, Only: x01aaf ! .. Function Return Value .. Real (Kind=nag_wp) :: g1 ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Local Scalars .. Real (Kind=nag_wp) :: a, pi ! .. Intrinsic Procedures .. Intrinsic :: cos ! .. Executable Statements .. pi = x01aaf(pi) a = 10.0E0_nag_wp*pi g1 = cos(a*x) Return End Function g1 Function g2(x) ! .. Function Return Value .. Real (Kind=nag_wp) :: g2 ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: x ! .. Local Scalars .. Real (Kind=nag_wp) :: omega ! .. Intrinsic Procedures .. Intrinsic :: sin ! .. Executable Statements .. omega = 10.0E0_nag_wp g2 = sin(omega*x) Return End Function g2 End Module d01apfe_mod Program d01apfe ! D01APF Example Main Program ! .. Use Statements .. Use nag_library, Only: d01apf, nag_wp Use d01apfe_mod, Only: g1, g2, liw, lw, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: a, abserr, alpha, b, beta, & epsabs, epsrel, result Integer :: ifail, key, nof ! .. Local Arrays .. Real (Kind=nag_wp) :: alpha_a(2), beta_a(2) Real (Kind=nag_wp), Allocatable :: w(:) Integer, Allocatable :: iw(:) Integer :: key_a(2) ! .. Executable Statements .. Write (nout,*) 'D01APF Example Program Results' Allocate (w(lw),iw(liw)) alpha_a = (/0.0_nag_wp,-0.5_nag_wp/) beta_a = (/0.0_nag_wp,-0.5_nag_wp/) key_a = (/2,1/) epsabs = 0.0_nag_wp epsrel = 1.0E-04_nag_wp a = 0.0_nag_wp b = 1.0_nag_wp funs: Do nof = 1, 2 alpha = alpha_a(nof) beta = beta_a(nof) key = key_a(nof) ifail = -1 If (nof==1) Then Call d01apf(g1,a,b,alpha,beta,key,epsabs,epsrel,result,abserr,w,lw, & iw,liw,ifail) Else Call d01apf(g2,a,b,alpha,beta,key,epsabs,epsrel,result,abserr,w,lw, & iw,liw,ifail) End If If (ifail<0) Then Exit funs End If Write (nout,*) Write (nout,99999) 'A ', 'lower limit of integration', a Write (nout,99999) 'B ', 'upper limit of integration', b Write (nout,99998) 'EPSABS', 'absolute accuracy requested', epsabs Write (nout,99998) 'EPSREL', 'relative accuracy requested', epsrel Write (nout,*) Write (nout,99998) 'ALPHA ', 'parameter in the weight function', alpha Write (nout,99998) 'BETA ', 'parameter in the weight function', beta Write (nout,99997) 'KEY ', 'which weight function is used', key If (ifail>3) Then Cycle funs End If Write (nout,*) Write (nout,99996) 'RESULT', 'approximation to the integral', result Write (nout,99998) 'ABSERR', 'estimate of the absolute error', abserr Write (nout,99997) 'IW(1)', 'number of subintervals used ', iw(1) End Do funs 99999 Format (1X,A6,' - ',A32,' = ',F10.4) 99998 Format (1X,A6,' - ',A32,' = ',E9.2) 99997 Format (1X,A6,' - ',A32,' = ',I4) 99996 Format (1X,A6,' - ',A32,' = ',F9.5) End Program d01apfe