! C06LBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module c06lbfe_mod ! C06LBF 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 Function f(s) ! .. Function Return Value .. Complex (Kind=nag_wp) :: f ! .. Scalar Arguments .. Complex (Kind=nag_wp), Intent (In) :: s ! .. Intrinsic Procedures .. Intrinsic :: cmplx ! .. Executable Statements .. f = cmplx(3.0E0_nag_wp,kind=nag_wp)/(s**2-cmplx(9.0E0_nag_wp,kind= & nag_wp)) Return End Function f End Module c06lbfe_mod Program c06lbfe ! C06LBF Example Main Program ! .. Use Statements .. Use nag_library, Only: c06lbf, c06lcf, nag_wp Use c06lbfe_mod, Only: f, nin, nout ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: b, epstol, exact, finv, pserr, & sigma, sigma0, t Integer :: ifail, j, m, mmax ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: acoef(:) Real (Kind=nag_wp) :: errvec(8) ! .. Intrinsic Procedures .. Intrinsic :: abs, exp, real, sinh ! .. Executable Statements .. Write (nout,*) 'C06LBF Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) mmax Allocate (acoef(mmax)) Read (nin,*) sigma0, epstol, sigma, b ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 ! Compute inverse transform Call c06lbf(f,sigma0,sigma,b,epstol,mmax,m,acoef,errvec,ifail) Write (nout,*) Write (nout,99999) 'No. of coefficients returned by C06LBF =', m Write (nout,*) Write (nout,99998) ' ', 'Computed', 'Exact', 'Pseudo' Write (nout,99998) 'T', ' f(T)', ' f(T)', ' error' Write (nout,*) ! Evaluate inverse transform for different values of t Do j = 0, 5 t = real(j,kind=nag_wp) Call c06lcf(t,sigma,b,m,acoef,errvec,finv,ifail) exact = sinh(3.0E0_nag_wp*t) pserr = abs(finv-exact)/exp(sigma*t) Write (nout,99997) t, finv, exact, pserr End Do 99999 Format (1X,A,I6) 99998 Format (1X,A10,A15,A15,A12) 99997 Format (1X,1P,E10.2,2E15.4,E12.1) End Program c06lbfe