! C06LAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module c06lafe_mod ! C06LAF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 Contains Subroutine fun(pr,pi,fr,fi) ! Function to be inverted ! .. Use Statements .. Use nag_library, Only: a02acf ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: fi, fr Real (Kind=nag_wp), Intent (In) :: pi, pr ! .. Local Scalars .. Real (Kind=nag_wp) :: xi, xr, yi, yr ! .. Executable Statements .. xr = 1.0_nag_wp xi = 0.0_nag_wp yr = pr + 0.5_nag_wp yi = pi Call a02acf(xr,xi,yr,yi,fr,fi) Return End Subroutine fun End Module c06lafe_mod Program c06lafe ! C06LAF Example Main Program ! .. Use Statements .. Use nag_library, Only: c06laf, nag_wp Use c06lafe_mod, Only: fun, nin, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: ahigh, alow, alphab, relerr, tfac Integer :: i, ifail, itest, mxterm, n, n1, & na, nfeval, nterms ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: errest(:), t(:), trurel(:), & trures(:), valinv(:), work(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, exp, real ! .. Executable Statements .. Write (nout,*) 'C06LAF Example Program Results' Write (nout,*) Write (nout,*) '(results may be machine-dependent)' ! Skip heading in data file Read (nin,*) Read (nin,*) n, mxterm Allocate (errest(n),t(n),trurel(n),trures(n),valinv(n),work(4*mxterm+2)) t(1) = 1.0_nag_wp alphab = -0.5_nag_wp tests: Do itest = 1, 3 Select Case (itest) Case (1) ! Test for values of a close to alphab relerr = 0.01E0_nag_wp tfac = 7.5E0_nag_wp n1 = 1 Write (nout,99997) t(1) Case (2) ! Test for larger values of a relerr = 1.0E-3_nag_wp tfac = 0.8E0_nag_wp n1 = 1 Write (nout,99997) t(1) Case (3) Write (nout,'(/1x,A/)') 'Compute inverse' n1 = 5 Do i = 1, n1 t(i) = real(i,kind=nag_wp) End Do End Select Write (nout,99999) mxterm, tfac, alphab, relerr ifail = -1 Call c06laf(fun,n1,t,valinv,errest,relerr,alphab,tfac,mxterm,nterms, & na,alow,ahigh,nfeval,work,ifail) If (ifail==0 .Or. ifail>=5) Then Write (nout,*) Write (nout,*) ' T Result exp(-T/2) ', & 'Relative error Error estimate' trures(1:n1) = exp(-0.5_nag_wp*t(1:n1)) trurel(1:n1) = abs((valinv(1:n1)-trures(1:n1))/trures(1:n1)) Write (nout,99998)(t(i),valinv(i),trures(i),trurel(i),errest(i),i=1, & n1) Else Exit tests End If End Do tests If (ifail>=0) Then Write (nout,99996) nterms, nfeval, alow, ahigh, ifail End If 99999 Format (1X,' MXTERM =',I4,' TFAC =',F6.2,' ALPHAB =',F6.2, & ' RELERR =',1P,E8.1) 99998 Format (1X,F4.1,7X,F6.3,9X,F6.3,8X,E8.1,8X,E8.1) 99997 Format (/1X,'Test with T(1) =',F4.1/) 99996 Format (/1X,' NTERMS =',I4,' NFEVAL =',I4,' ALOW =',F7.2,' AHIGH =', & F7.2,' IFAIL =',I2) End Program c06lafe