    !CAMB spherical and hyperspherical Bessel function routines
    !This version May 2006 - minor changes to bjl (http://cosmocoffee.info/viewtopic.php?t=530)
    !Feb 2007: fixed for high l, uses Ranges
    !Feb 2009: minor fix for non-flat compiled with non-smart IF evaluation
    !Dec 2011: minor tweak to DoRecurs for smoother errors across flat for L~O(30)
    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !Flat bessel function module

    module SpherBessels
    use Precision
    use results
    use RangeUtils
    use MpiUtils
    use splines
    implicit none
    private

    ! Bessel functions and their second derivatives for interpolation

    real(dl), dimension(:,:), allocatable ::  ajl, ajlpr, ddajlpr

    integer  num_xx, kmaxfile, max_ix
    Type(lSamples), save :: file_l
    ! parameters for working out where the flat Bessel functions are small
    ! Both should increase for higher accuracy
    ! real(dl), parameter :: xlimmin=15._dl  , xlimfrac = 0.05_dl
    real(dl), parameter :: xlimmin=35._dl  , xlimfrac = 0.05_dl
    real(dl) file_acc

    type(TRanges), save:: BessRanges

    public ajl, ajlpr, ddajlpr, BessRanges, InitSpherBessels, xlimmin, xlimfrac
    public USpherBesselWithDeriv, phi_recurs,phi_langer, bjl, Bessels_Free

    contains

    subroutine InitSpherBessels(lSamp, CP,max_bessels_l_index, max_bessels_etak)
    Type(lSamples) lSamp
    Type(CAMBParams) :: CP
    integer, intent(in) :: max_bessels_l_index
    real(dl), intent(in) :: max_bessels_etak

    !See if already loaded with enough (and correct) lSamp%l values and k*eta values
    if (lSamp%nl <= file_l%nl) then
        if (allocated(ajl) .and. all(file_l%l(1:lSamp%nl)==lSamp%l(1:lSamp%nl) .and. (max_bessels_l_index <= max_ix)) &
            .and. (int(min(max_bessels_etak,CP%Max_eta_k))+1 <= kmaxfile) &
            .and. (abs(CP%Accuracy%BesselBoost*CP%Accuracy%AccuracyBoost - file_acc) < 1d-2)) return
    end if

    !Haven't made them before, so make them now
    kmaxfile = int(min(CP%Max_eta_k,max_bessels_etak))+1
    max_ix = min(max_bessels_l_index,lSamp%nl)

    call GenerateBessels(lSamp, CP)

    if (DebugMsgs .and. FeedbackLevel > 0) write(*,*) 'Calculated Bessels'

    end subroutine InitSpherBessels

    subroutine GenerateBessels(lSamp, CP)
    Type(lSamples) lSamp
    Type(CAMBParams) :: CP
    real(dl) x
    real(dl) xlim
    integer i,j

    if (DebugMsgs .and. FeedbackLevel > 0) write (*,*) 'Generating flat Bessels...'

    file_l = lSamp
    if (do_bispectrum) kmaxfile = kmaxfile*2

    if (DebugMsgs .and. FeedbackLevel > 0) write (*,*) 'x_max bessels', kmaxfile

    call BessRanges%Init()

    call BessRanges%Add_delta(0._dl, 1._dl,0.01_dl/CP%Accuracy%BesselBoost)
    call BessRanges%Add_delta(1._dl, 5._dl,0.1_dl/CP%Accuracy%BesselBoost)
    call BessRanges%Add_delta(5._dl, 25._dl,0.2_dl/CP%Accuracy%BesselBoost)
    file_acc = CP%Accuracy%BesselBoost*CP%Accuracy%AccuracyBoost
    call BessRanges%Add_delta(25._dl, 150._dl,0.5_dl/file_acc)
    call BessRanges%Add_delta(150._dl, real(kmaxfile,dl),0.8_dl/file_acc)

    call BessRanges%GetArray(.false.)
    num_xx = BessRanges%npoints


    ! The three arrays are always (de-)allocated together. Therefore checking
    ! one of them for allocation is sufficient.
    if (.not. allocated(ajl) .or. any(ubound(ajl) < [num_xx, max_ix])) then
        if (allocated(ajl)) deallocate(ajl, ajlpr, ddajlpr)
        allocate(ajl(1:num_xx,1:max_ix), ajlpr(1:num_xx,1:max_ix), &
            ddajlpr(1:num_xx,1:max_ix))
    end if

    !$OMP PARALLEL DO DEFAULT(SHARED), SCHEDULE(STATIC), PRIVATE(i, x, xlim)
    do j=1,max_ix
        do  i=1,num_xx
            x=BessRanges%points(i)
            xlim=xlimfrac*lSamp%l(j)
            xlim=max(xlim,xlimmin)
            xlim=lSamp%l(j)-xlim
            if (x > xlim) then
                if ((lSamp%l(j)==3).and.(x <=0.2) .or. (lSamp%l(j) > 3).and.(x < 0.5) .or. &
                    (lSamp%l(j)>5).and.(x < 1.0)) then
                    ajl(i,j)=0
                else
                    !if ( lSamp%l(j) > 40000) then
                    ! ajl(i,j) = phi_langer(lSamp%l(j),0,1._dl,x)
                    !else
                    call bjl(lSamp%l(j),x,ajl(i,j))
                    !end if
                end if
            else
                ajl(i,j)=0
            end if
        end do

        !     get the interpolation matrix for bessel functions
        call spline_def(BessRanges%points,ajl(:,j),num_xx,ajlpr(:,j))
        call spline_def(BessRanges%points,ajlpr(:,j),num_xx,ddajlpr(:,j))
    end do
    !$OMP END PARALLEL DO

    end subroutine GenerateBessels

    subroutine Bessels_Free

    if (allocated(ajl)) deallocate(ajl)
    if (allocated(ajlpr)) deallocate(ajlpr)
    if (allocated(ddajlpr)) deallocate(ddajlpr)
    call BessRanges%Free()

    end  subroutine Bessels_Free


    SUBROUTINE BJL(L,X,JL)
    !!== MODIFIED SUBROUTINE FOR SPHERICAL BESSEL FUNCTIONS.                       ==!!
    !!== CORRECTED THE SMALL BUGS IN PACKAGE CMBFAST&CAMB(for l=4,5, x~0.001-0.002)==!!
    !!== CORRECTED THE SIGN OF J_L(X) FOR X<0 CASE                                 ==!!
    !!== WORKS FASTER AND MORE ACCURATE FOR LOW L, X<<L, AND L<<X cases            ==!!
    !!== zqhuang@astro.utoronto.ca                                                 ==!!
    IMPLICIT NONE
    INTEGER L
    real(dl) X,JL
    real(dl) AX,AX2
    real(dl),PARAMETER::LN2=0.6931471805599453094D0
    real(dl),PARAMETER::ONEMLN2=0.30685281944005469058277D0
    real(dl),PARAMETER::PID2=1.5707963267948966192313217D0
    real(dl),PARAMETER::PID4=0.78539816339744830961566084582D0
    real(dl),parameter::ROOTPI12 = 21.269446210866192327578D0
    real(dl),parameter::GAMMA1 =   2.6789385347077476336556D0 !/* Gamma function of 1/3 */
    real(dl),parameter::GAMMA2 =   1.3541179394264004169452D0 !/* Gamma function of 2/3 */
    real(dl),PARAMETER::PI=3.141592653589793238463D0
    real(dl) NU,NU2,BETA,BETA2,COSB
    real(dl) sx,sx2
    real(dl) cotb,cot3b,cot6b,secb,sec2b
    real(dl) trigarg,expterm,L3

    IF(L.LT.0)THEN
        error stop 'Can not evaluate Spherical Bessel Function with index l<0'
    ENDIF
    AX=DABS(X)
    AX2=AX**2
    IF(L.LT.7)THEN
        IF(L.EQ.0)THEN
            IF(AX.LT.1.D-1)THEN
                JL=1.D0-AX2/6.D0*(1.D0-AX2/20.D0)
            ELSE
                JL=DSIN(AX)/AX
            ENDIF

        ELSEIF(L.EQ.1)THEN
            IF(AX.LT.2.D-1)THEN
                JL=AX/3.D0*(1.D0-AX2/10.D0*(1.D0-AX2/28.D0))
            ELSE
                JL=(DSIN(AX)/AX-DCOS(AX))/AX
            ENDIF
        ELSEIF(L.EQ.2)THEN
            IF(AX.LT.3.D-1)THEN
                JL=AX2/15.D0*(1.D0-AX2/14.D0*(1.D0-AX2/36.D0))
            ELSE
                JL=(-3.0D0*DCOS(AX)/AX-DSIN(AX)*(1.D0-3.D0/AX2))/AX
            ENDIF
        ELSEIF(L.EQ.3)THEN
            IF(AX.LT.4.D-1)THEN
                JL=AX*AX2/105.D0*(1.D0-AX2/18.D0*(1.D0-AX2/44.D0))
            ELSE
                JL=(DCOS(AX)*(1.D0-15.D0/AX2)-DSIN(AX)*(6.D0-15.D0/AX2)/AX)/AX
            ENDIF
        ELSEIF(L.EQ.4)THEN
            IF(AX.LT.6.D-1)THEN
                JL=AX2**2/945.D0*(1.D0-AX2/22.D0*(1.D0-AX2/52.D0))
            ELSE
                JL=(DSIN(AX)*(1.D0-(45.D0-105.D0/AX2)/AX2)+DCOS(AX)*(10.D0-105.D0/AX2)/AX)/AX
            ENDIF
        ELSEIF(L.EQ.5)THEN
            IF(AX.LT.1.D0)THEN
                JL=AX2**2*AX/10395.D0*(1.D0-AX2/26.D0*(1.D0-AX2/60.D0))
            ELSE
                JL=(DSIN(AX)*(15.D0-(420.D0-945.D0/AX2)/AX2)/AX-DCOS(AX)*(1.D0-(105.D0-945.0d0/AX2)/AX2))/AX
            ENDIF
        ELSE
            IF(AX.LT.1.D0)THEN
                JL=AX2**3/135135.D0*(1.D0-AX2/30.D0*(1.D0-AX2/68.D0))
            ELSE
                JL=(DSIN(AX)*(-1.D0+(210.D0-(4725.D0-10395.D0/AX2)/AX2)/AX2)+ &
                    DCOS(AX)*(-21.D0+(1260.D0-10395.D0/AX2)/AX2)/AX)/AX
            ENDIF
        ENDIF
    ELSE
        NU=0.5D0+L
        NU2=NU**2
        IF(AX.LT.1.D-40)THEN
            JL=0.D0
        ELSEIF((AX2/L).LT.5.D-1)THEN
            JL=DEXP(L*DLOG(AX/NU)-LN2+NU*ONEMLN2-(1.D0-(1.D0-3.5D0/NU2)/NU2/30.D0)/12.D0/NU) &
                /NU*(1.D0-AX2/(4.D0*NU+4.D0)*(1.D0-AX2/(8.D0*NU+16.D0)*(1.D0-AX2/(12.D0*NU+36.D0))))
        ELSEIF((real(L,dl)**2/AX).LT.5.D-1)THEN
            BETA=AX-PID2*(L+1)
            JL=(DCOS(BETA)*(1.D0-(NU2-0.25D0)*(NU2-2.25D0)/8.D0/AX2*(1.D0-(NU2-6.25)*(NU2-12.25D0)/48.D0/AX2)) &
                -DSIN(BETA)*(NU2-0.25D0)/2.D0/AX* (1.D0-(NU2-2.25D0)*(NU2-6.25D0)/24.D0/AX2*(1.D0-(NU2-12.25)* &
                (NU2-20.25)/80.D0/AX2)) )/AX
        ELSE
            L3=NU**0.325
            IF(AX .LT. NU-1.31*L3) then
                COSB=NU/AX
                SX = DSQRT(NU2-AX2)
                COTB=NU/SX
                SECB=AX/NU
                BETA=DLOG(COSB+SX/AX)
                COT3B=COTB**3
                COT6B=COT3B**2
                SEC2B=SECB**2
                EXPTERM=( (2.D0+3.D0*SEC2B)*COT3B/24.D0 &
                    - ( (4.D0+SEC2B)*SEC2B*COT6B/16.D0 &
                    + ((16.D0-(1512.D0+(3654.D0+375.D0*SEC2B)*SEC2B)*SEC2B)*COT3B/5760.D0 &
                    + (32.D0+(288.D0+(232.D0+13.D0*SEC2B)*SEC2B)*SEC2B)*SEC2B*COT6B/128.D0/NU)*COT6B/NU) &
                    /NU)/NU
                JL=DSQRT(COTB*COSB)/(2.D0*NU)*DEXP(-NU*BETA+NU/COTB-EXPTERM)

                !          /**************** Region 2: x >> l ****************/

            ELSEIF (AX .GT. NU+1.48*L3) then
                COSB=NU/AX
                SX=DSQRT(AX2-NU2)
                COTB=NU/SX
                SECB=AX/NU
                BETA=DACOS(COSB)
                COT3B=COTB**3
                COT6B=COT3B**2
                SEC2B=SECB**2
                TRIGARG=NU/COTB-NU*BETA-PID4 &
                    -((2.0+3.0*SEC2B)*COT3B/24.D0  &
                    +(16.D0-(1512.D0+(3654.D0+375.D0*SEC2B)*SEC2B)*SEC2B)*COT3B*COT6B/5760.D0/NU2)/NU
                EXPTERM=( (4.D0+sec2b)*sec2b*cot6b/16.D0 &
                    -(32.D0+(288.D0+(232.D0+13.D0*SEC2B)*SEC2B)*SEC2B)*SEC2B*COT6B**2/128.D0/NU2)/NU2
                JL=DSQRT(COTB*COSB)/NU*DEXP(-EXPTERM)*DCOS(TRIGARG)

                !          /***************** Region 3: x near l ****************/

            ELSE
                BETA=AX-NU
                BETA2=BETA**2
                SX=6.D0/AX
                SX2=SX**2
                SECB=SX**0.3333333333333333d0
                SEC2B=SECB**2
                JL=( GAMMA1*SECB + BETA*GAMMA2*SEC2B &
                    -(BETA2/18.D0-1.D0/45.D0)*BETA*SX*SECB*GAMMA1 &
                    -((BETA2-1.D0)*BETA2/36.D0+1.D0/420.D0)*SX*SEC2B*GAMMA2   &
                    +(((BETA2/1620.D0-7.D0/3240.D0)*BETA2+1.D0/648.D0)*BETA2-1.D0/8100.D0)*SX2*SECB*GAMMA1 &
                    +(((BETA2/4536.D0-1.D0/810.D0)*BETA2+19.D0/11340.D0)*BETA2-13.D0/28350.D0)*BETA*SX2*SEC2B*GAMMA2 &
                    -((((BETA2/349920.D0-1.D0/29160.D0)*BETA2+71.D0/583200.D0)*BETA2-121.D0/874800.D0)* &
                    BETA2+7939.D0/224532000.D0)*BETA*SX2*SX*SECB*GAMMA1)*DSQRT(SX)/ROOTPI12
            ENDIF
        ENDIF
    ENDIF
    IF(X.LT.0.AND.MOD(L,2).NE.0)JL=-JL
    END SUBROUTINE BJL

    !    end module SpherBessels




    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !                                                                      c
    ! Calculation of ultraspherical Bessel functions.                      c
    ! Fortran version of the c program hyperjl.c by Arthur Kosowsky.       c
    ! WKB approx described in astro-ph/9805173                             c
    !                                                                      c
    ! Modifications by Anthony Challinor and Antony Lewis                  c
    ! Minor modifications to correct K=1 case outside [0,pi],              c
    ! the small chi approximations for lSamp%l=0 and lSamp%l=1, and                    c
    ! the quadratic approximation to Q(x) around Q(x)=0.                   c
    ! Bug fixed in downwards recursion (phi_recurs)                        c
    !                                                                      c
    ! The routine phi_recurs uses recursion relations to calculate         c
    ! the functions, which is accurate but relatively slow.                c
    !   ***NOT STABLE FOR K=1 or for all cases ***                         c
    !                                                                      c
    ! The routine phi_langer uses Langer's formula for a                   c
    ! uniform first-order asymptotic approximation in the open, closed     c
    ! and flat cases. This approximation is EXCELLENT for all lSamp%l >= 3.      c
    !                                                                      c
    ! The routine qintegral calculates the closed-form answer              c
    ! to the eikonal integral used in the WKB approximation.               c
    !                                                                      c
    ! The routine airy_ai returns the Airy function Ai(x) of the argument  c
    ! passed. It employs a Pade-type approximation away from zero and      c
    ! a Taylor expansion around zero. Highly accurate.                     c
    !                                                                      c
    ! The routines polevl and p1evl are auxiliary polynomial               c
    ! evaluation routines used in the airy function calculation.           c
    !                                                                      c
    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

    subroutine USpherBesselWithDeriv(closed,CP,Chi,l,beta,y1,y2)
    !returns y1=ujl*sinhChi and y2=diff(y1,Chi)
    !aim for accuracy > 1% for all inputs
    real(dl) Chi,beta,y1,y2,sinhChi,cothChi
    real(dl) sin_K, cot_K
    integer l,K
    logical, intent(IN) :: closed
    Type(CAMBParams), intent(in) :: CP
    logical DoRecurs

    if (closed) then
        sin_K = sin(Chi)
        cot_K= 1._dl/tan(Chi)
        K=1
    else
        sin_K=sinh(Chi)
        cot_K = 1._dl/tanh(Chi)
        K=-1
    end if

    sinhChi = sin_K
    cothChi = cot_K

    DoRecurs = ((l<=45*CP%Accuracy%AccuracyBoost).OR.((.not.closed.or.(abs(Chi-const_pi/2)>0.2d0))&
        .and.(beta*l<750).or.closed.and.(beta*l<4000)))

    !Deep in the tails the closed recursion relation is not stable
    !Added July 2003 to prevent problems with very nearly flat models
    if (DoRecurs .and. closed) then
        if  (Chi < asin(sqrt(l*(l+1._dl))/beta) - 2/beta) then
            if (phi_langer(l,K,beta,Chi) < 1e-7) then
                call phi_small_closed_int(l,beta,chi,y1,y2)
                return
            end if
        end if
    end if

    if (DoRecurs) then
        !use recursive evaluation where WKB is poor and recurs is fast anyway.
        y1=phi_recurs(l,K,beta,Chi)*sinhChi
        y2=y1*(l+1)*cothChi
        if (.not.closed.or.(l+1<nint(beta))) y2=y2 - &
            sqrt(beta**2-(K*(l+1)**2))*phi_recurs(l+1,K,beta,Chi)*sinhChi
        !of course we could get y2 much more quickly by modifying
        !phi_recurs to return l and l+1 for each beta,Chi...


    else !WKB approx
        y1=phi_langer(l,K,beta,Chi)*sinhChi
        y2=y1*(l+1)*cothChi
        if (.not.closed.or.(l+1<nint(beta))) y2=y2 - &
            sqrt(beta**2-(K*(l+1)**2))*phi_langer(l+1,K,beta,Chi)*sinhChi

    end if

    end subroutine USpherBesselWithDeriv



    !Calculates y1,y2 (noramlized to a value near the turning point)
    !by integrating up the differential equation and normalizing to phi_recurs
    !in the region in which phi_recurs is stable
    !This allows closed functions to be computed where chi << turning point
    subroutine phi_small_closed_int(l,beta,chi,y1,y2)
    integer, intent(IN) :: l
    real(dl), intent(IN) :: beta, chi
    real(dl) y1,y2

    integer nsteps,i

    real(dl) ap1,nu2,dydchi1,dydchi2,yt1,yt2,dyt1,dyt2,dym1,dym2
    real(dl) x0, delchi,sh, h6,x
    real(dl) y1_x,y2_x, tmp,xh,hh

    nsteps = 200
    ap1 = l*(l+1)
    x0 = sqrt(ap1)/beta
    nu2 = beta**2

    if ((beta*chi)**2/l < 0.005) then
        !Series solution

        x = chi
        sh = sin(x)
        tmp=(ap1/sh**2 - nu2)
        y1=1e-20
        y2 = ((l+1)/x - (nu2-ap1/3)/(2*l+3)*x) * y1
    else

        x = max(1d-7,chi - 50._dl/l)
        y1=1e-20
        y2 = (l+1)*y1/x

        delchi = (chi-x)/nSteps
        h6=delchi/6
        hh=delchi/2
        sh = sin(x)
        tmp=(ap1/sh**2 - nu2)

        do i=1,nSteps
            ! One step in the ujl integration
            ! fourth-order Runge-Kutta method to integrate equation for ujl

            dydchi1=y2         !deriv y1
            dydchi2=tmp*y1     !deriv y2
            xh=x+hh          !midpoint of step
            yt1=y1+hh*dydchi1  !y1 at midpoint
            yt2=y2+hh*dydchi2  !y2 at midpoint
            dyt1=yt2           !deriv y1 at mid
            tmp=(ap1/sin(xh)**2 - nu2)


            dyt2=tmp*yt1       !deriv y2 at mid

            yt1=y1+hh*dyt1     !y1 at mid
            yt2=y2+hh*dyt2     !y2 at mid

            dym1=yt2           !deriv y1 at mid
            dym2=tmp*yt1       !deriv y2 at mid
            yt1=y1+delchi*dym1 !y1 at end
            dym1=dyt1+dym1
            yt2=y2+delchi*dym2 !y2 at end
            dym2=dyt2+dym2

            x=x+delchi     !end point
            sh=sin(x)
            dyt1=yt2           !deriv y1 at end
            tmp=(ap1/sh**2 - nu2)
            dyt2=tmp*yt1       !deriv y2 at end
            y1=y1+h6*(dydchi1+dyt1+2*dym1) !add up
            y2=y2+h6*(dydchi2+dyt2+2*dym2)
            if (y1 > 1d10 .or. y2> 1d10) then

                y1=y1/1d10
                y2=y2/1d10

            end if
        end do

    end if

    y1_x = y1; y2_x = y2

    delchi = (x0 - chi)/nSteps
    h6=delchi/6
    hh=delchi/2

    do i=1,nSteps
        ! One step in the ujl integration
        ! fourth-order Runge-Kutta method to integrate equation for ujl

        dydchi1=y2         !deriv y1
        dydchi2=tmp*y1     !deriv y2
        xh=x+hh          !midpoint of step
        yt1=y1+hh*dydchi1  !y1 at midpoint
        yt2=y2+hh*dydchi2  !y2 at midpoint
        dyt1=yt2           !deriv y1 at mid
        tmp=(ap1/sin(xh)**2 - nu2)


        dyt2=tmp*yt1       !deriv y2 at mid

        yt1=y1+hh*dyt1     !y1 at mid
        yt2=y2+hh*dyt2     !y2 at mid

        dym1=yt2           !deriv y1 at mid
        dym2=tmp*yt1       !deriv y2 at mid
        yt1=y1+delchi*dym1 !y1 at end
        dym1=dyt1+dym1
        yt2=y2+delchi*dym2 !y2 at end
        dym2=dyt2+dym2

        x=x+delchi     !end point
        sh=sin(x)
        dyt1=yt2           !deriv y1 at end
        tmp=(ap1/sh**2 - nu2)
        dyt2=tmp*yt1       !deriv y2 at end
        y1=y1+h6*(dydchi1+dyt1+2*dym1) !add up
        y2=y2+h6*(dydchi2+dyt2+2*dym2)
        if (y1 > 1d10 .or. y2 > 1d10) then
            y1=y1/1d10
            y2=y2/1d10
            y1_x = y1_x/1d10
            y2_x = y2_x/1d10

        end if
    end do


    tmp = phi_recurs(l,1,beta,x0)*sin(x0) / y1
    y1 = y1_x * tmp
    y2 = y2_x * tmp


    end subroutine phi_small_closed_int

    !***********************************************************************
    !                                                                      *
    ! Calculates Phi(l,beta,chi) using recursion on l.                     *
    ! See Abbot and Schaefer, ApJ 308, 546 (1986) for needed               *
    ! recursion relations and closed-form expressions for l=0,1.           *
    ! (Note: Their variable y is the same as chi here.)                    *
    !                                                                      *
    ! When the flag direction is negative, downwards recursion on l        *
    ! must be used because the upwards direction is unstable to roundoff   *
    ! errors. The downwards recursion begins with arbitrary values and     *
    ! continues downwards to l=1, where the desired l value is normalized  *
    ! using the closed form solution for l=1. (See, e.g., Numerical        *
    ! Recipes of Bessel functions for more detail)                         *
    !                                                                      *
    !***********************************************************************

    function phi_recurs(l, K, beta, chi)
    !doesn't like values which give exponentially small phi
    integer, intent(IN) :: l, K
    real(dl), intent(IN) :: beta, chi
    real(dl) phi_recurs
    integer j, direction, lstart,ibeta
    real(dl) ell, kay, arg, answer,beta2
    real(dl) root_K
    real(dl) phi0, phi1, phi_plus, phi_zero, phi_minus, b_zero, b_minus
    real(dl), parameter :: ACC=40._dl, BIG=1.d10
    real(dl) sin_K, cot_K

    ell=dble(l)


    ! Test input values

    if(l<0) call MpiStop("Bessel function index ell < 0")
    if(beta<0._dl) call MpiStop("Wavenumber beta < 0")
    if ((abs(K)/=1).and.(K/=0)) call MpiStop("K must be 1, 0 or -1")

    if(K==1) then
        ibeta=nint(beta)
        if(ibeta<3) call MpiStop("Wavenumber beta < 3 for K=1")
        if(ibeta<=l) call MpiStop("Wavenumber beta <= l")
    endif

    if (chi<1/BIG) then
        phi_recurs=0
        return
    end if

    kay = dble(K)
    arg = beta * chi
    beta2 = beta**2

    if(K == 0) then
        cot_K = 1._dl/chi
        sin_K = chi
        root_K = beta
    else
        root_K = sqrt(beta2 -kay*ell*ell)

        if(K == -1) then
            cot_K = 1._dl/tanh(chi)
            sin_K = sinh(chi)
        else
            cot_K = 1._dl/tan(chi)
            sin_K = sin(chi)
        end if

    endif


    ! Closed form solution for l=0

    if (abs(chi) < 1.d-4) then
        if (abs(arg)<1.d-4) then
            phi0 = 1._dl-chi**2*(beta*beta-kay)/6._dl
        else
            phi0=sin(arg)/arg
        end if
    else
        phi0 = sin(arg) / (beta * sin_K)
    end if

    if (l==0) then
        phi_recurs=phi0
        return
    end if


    ! Closed form solution for l=1

    if((abs(chi) < 1.d-4).and.(K/=0)) then
        if(arg < 1.d-4) then
            phi1 = chi*sqrt(beta*beta-kay)/3._dl
            !beta2 * chi / (3._dl * sqrt(1._dl+ kay * beta2))
        else
            phi1 = (sin(arg)/arg-cos(arg))/(sqrt(beta*beta-kay)*chi)
            !(sin(arg)/arg - cos(arg))/arg
        end if
    elseif ((abs(arg) < 1.d-4).and.(K == 0)) then
        phi1 = arg / 3._dl
    else
        if (K /= 0 ) then
            phi1 = sin(arg) * cot_K / (beta * sin_K) - cos(arg) / sin_K
            phi1 = phi1/sqrt(beta2 - kay)
        else
            phi1 = (sin(arg)/arg - cos(arg))/arg
        end if
    end if
    if(l==1) then
        phi_recurs=phi1
        return
    end if
    ! Find recursion direction
    !  direction = +1 for upward recursion, -1 for downward

    if(abs(cot_K) < root_K / ell) then
        direction = 1
    else
        direction = -1
    end if

    ! For K=1, must do upwards recursion:
    ! NOT STABLE for all values of chi

    if(K==1) direction = 1

    ! Do upwards recursion on l


    if(direction == 1)then
        b_minus = sqrt(beta2 - kay)
        phi_minus = phi0
        phi_zero = phi1

        do j=2,l

            if(K == 0) then
                phi_plus = ((2*j-1) * cot_K * phi_zero - beta*phi_minus)/ beta
            else
                b_zero = sqrt(beta2 - (K*j*j))
                phi_plus = ((2*j-1) * cot_K * phi_zero - b_minus * phi_minus) / b_zero
                b_minus = b_zero
            end if
            phi_minus = phi_zero
            phi_zero = phi_plus
        end do


        phi_recurs=phi_plus


        return

        ! Do downwards recursion on l

    else
        lstart = l + 2 * int(sqrt(ell*ACC))

        b_zero = sqrt(beta2 - dble(K*lstart*lstart))
        phi_plus = 0._dl
        phi_zero = 1._dl
        answer = 0._dl

        do j= lstart - 2,1,-1

            if(K == 0) then
                phi_minus = ((2*j + 3) * cot_K * phi_zero - beta * phi_plus) / beta
            else
                b_minus = sqrt(beta2 - (K*(j+1)**2))
                phi_minus = ((2*j + 3) * cot_K * phi_zero - b_zero * phi_plus) / b_minus
                b_zero = b_minus
            end if
            phi_plus = phi_zero
            phi_zero = phi_minus

            if(j == l) answer = phi_minus
            if((abs(phi_zero) > BIG).and.(j/=1)) then
                phi_plus = phi_plus/BIG
                phi_zero = phi_zero/BIG
                answer = answer/BIG
            end if
        end do

        ! Normalize answer to previously computed phi1

        answer = answer*phi1 / phi_minus
        phi_recurs=answer

    end if

    end function phi_recurs


    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !                                                                      c
    ! Calculates Phi(l,beta,chi) using the Langer uniform approximation    c
    ! to the first-order WKB approximation.                                c
    ! See C.M. Bender and S.A. Orszag,  Mathematical Methods for           c
    ! Scientists and Engineers (McGraw-Hill, 1978; LC QA371.B43),          c
    ! chapter 10.                                                          c
    !                                                                      c
    ! Differential equation for needed function can be cast into the       c
    ! Schrodinger form      \epsilon^2 y'' = Q(x) y                        c
    ! where \epsilon^2 = 1/l(l+1) and Q(x) depends on the parameter        c
    ! alpha \equiv beta * epsilon.                                         c
    !                                                                      c
    ! In the K= +1 case, the function is                                   c
    ! determined by its value on the interval [0, pi/2] and the symmetry   c
    ! conditions Phi(chi + pi) = (-1)^{beta - l - 1} Phi(chi),             c
    !            Phi(pi - chi) = (-1)^{beta - l - 1} Phi(chi).             c
    ! This interval contains one turning point, so the Langer formula      c
    ! can be used.                                                         c
    ! Note that the second condition at chi = pi/2 gives an eigenvalue     c
    ! condition on beta, which  must corrected. For the lowest             c
    ! eigenvalue(s), the region between the turning points is not large    c
    ! enough for the asymptotic solution to be valid, so the functions     c
    ! have a small discontinuity or discontinuous derivative at pi/2;      c
    ! this behavior is corrected by employing a 4-term asymptotic          c
    ! series around the regular point chi=pi/2.                            c
    ! The exact eigenvalue condition requires that beta must be an         c
    ! integer >= 3 with beta > l. Note this implies alpha > 1.             c
    !                                                                      c
    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



    function phi_langer(l,K,beta,chi)
    integer l,K,ibeta,kay
    real(dl) phi_langer
    real(dl) ell,symm, anu, alpha2
    real(dl) beta,chi,eikonal, wkb, arg, arg2, tmp
    real(dl) epsilon, alpha, chi0, x, a, b,achi

    real(dl) cot_K, sin_K
    real(dl), parameter :: PI=3.1415926536d0,ROOTPI=1.772453851d0,ROOT2PI=2.506628275d0, &
        PIOVER2=1.570796327d0

    ell=dble(l)
    achi=chi

    symm=1._dl
    !
    ! Test input values
    !
    if(l<0) call MpiStop("Bessel function index ell < 0")
    if(beta<0._dl) call MpiStop("Wavenumber beta < 0")
    if ((abs(K)/=1).and.(K/=0)) call MpiStop("K must be 1, 0 or -1")


    if(K == 1) then
        ibeta=nint(beta)
        if(ibeta<3) call MpiStop("Wavenumber beta < 3 for K=1")
        if(ibeta<=l) call MpiStop("Wavenumber beta <= l")
    endif

    kay=K


    ! For closed case, find equivalent chi in [0,pi/2]
    !
    if(K==1) then
        achi=achi-2._dl*Pi*int(achi/2._dl/PI)
        if(achi>PI) then
            achi=2._dl*PI-achi
            if(2*(l/2).eq.l) then
                symm=symm
            else
                symm=-symm
            endif
        endif
        if(achi>PI/2._dl) then
            achi=PI-achi
            if(2*((ibeta-l-1)/2).eq.(ibeta-l-1)) then
                symm=symm
            else
                symm=-symm
            endif
        endif
    endif

    ! Definitions
    if(K == 0) then
        sin_K = achi
    else
        if(K == -1) then
            sin_K = sinh(achi)
        else
            sin_K = sin(achi)
        end if
    endif

    ! Closed form solution for l=0
    !
    if(l == 0) then
        arg=beta*achi

        if((abs(achi)<1.d-4).and.(K/=0)) then
            if(abs(arg)<1.d-4) then
                wkb=1._dl-achi*achi*(beta*beta-kay)/6._dl
            else
                wkb=sin(arg)/arg
            endif
        else if((abs(arg)<1.d-4).and.(K==0)) then
            wkb=1._dl-arg*arg/6._dl
        else
            wkb=sin(arg)/(beta*sin_K)
        endif
        phi_langer=symm*wkb
        return
    endif
    !
    ! Closed form solution for l=1
    !
    if(l==1) then
        arg=beta*achi

        if((abs(achi)<1.d-4).and.(K/=0)) then
            if(abs(arg)<1.d-4) then
                wkb=achi*sqrt(beta*beta-kay)/3._dl
            else
                wkb=(sin(arg)/arg-cos(arg))/(sqrt(beta*beta-kay)*achi)
            endif
        else if((abs(arg)<1.d-4).and.(K==0)) then
            wkb=arg/3._dl
        else
            if(K/=0) then
                if(K==1) then
                    cot_K=1._dl/tan(achi)
                else
                    cot_K=1._dl/tanh(achi)
                endif
                wkb=sin(arg)*cot_K/(beta*sin_K)-cos(arg)/sin_K
                wkb=wkb/sqrt(beta*beta-kay)
            else
                wkb=(sin(arg)/arg-cos(arg))/arg
            endif
        end if
        phi_langer=symm*wkb
        return
    endif
    !
    ! Closed form solution for K=1 and beta = l+1 (lowest eigenfunction)
    !
    if((K==1).and.(ibeta == (l+1))) then
        wkb=(sin_K**ell)* &
            sqrt(sqrt(2._dl*PI/(2._dl*ell+1._dl))*ell/((ell+1._dl)*(2._dl*ell+1._dl)))
        wkb=wkb*(1+0.1875d0/ell-0.013671875/(ell*ell))
        phi_langer=symm*wkb
        return
    endif

    ! Very close to 0, return 0 (exponentially damped)
    !
    if(abs(achi)<1.d-8) then
        phi_langer=0._dl
        return
    endif


    ! For closed case, find corrected eigenvalue beta
    !
    if(K==1) then
        anu=dble(ibeta)-1._dl/(8._dl*ell)+1._dl/(16._dl*ell*ell)
    else
        anu=beta
    endif
    !
    ! Evaluate epsilon using asymptotic form for large l
    !
    if(l<20) then
        epsilon=1._dl/sqrt(ell*(ell+1._dl))
    else
        epsilon=1._dl/ell-0.5d0/(ell*ell)+0.375d0/(ell*ell*ell)
    endif

    alpha=epsilon*anu
    !
    ! Calculate the turning point where Q(x)=0.
    ! Function in question has only a single simple turning point.
    !
    if(K==-1) chi0=log((1._dl+sqrt(1._dl+alpha*alpha))/alpha)
    if(K==0) chi0=1._dl/alpha
    if(K==1) chi0=asin(1._dl/alpha)


    ! Very close to chi0, use usual wkb form to avoid dividing by zero
    !
    if(abs(achi-chi0)<1.d-5) then

        ! Calculate coefficients of linear and quadratic terms in Q(x) expansion
        ! in the neighborhood of the turning point
        ! Q(chi)=a*(chi0-chi)+b*(chi0-chi)**2
        alpha2=alpha*alpha

        if(K==-1) then
            a=2._dl*alpha2*sqrt(alpha2+1._dl)
            b=3._dl*alpha2**2+2._dl*alpha2
        endif
        if(K==0) then
            a=2._dl*alpha2*alpha
            b=3._dl*alpha2**2
        endif
        if(K==1) then
            a=2._dl*alpha2*sqrt(alpha2-1._dl)
            b=3._dl*alpha2**2-2._dl*alpha2
        endif

        ! Dependent variable x for which Q(x)=0 at x=0
        ! x>0 is the evanescent region
        !
        x=chi0-achi
        !
        ! Argument of Airy function
        !
        arg=(x+b*x*x/(5._dl*a))/(epsilon*epsilon/a)**(0.333333333d0)
        !
        ! Evaluate Airy function
        !
        wkb=airy_ai(arg)
        !
        ! Rest of functional dependence
        !
        wkb=wkb*(1._dl-b*x/(5._dl*a))/sin_K
        !  Normalization factor:

        wkb=wkb*symm*ROOTPI*((a*epsilon)**(-0.1666667d0))*sqrt(epsilon/anu)
        phi_langer=wkb

        return
    endif


    ! Langer approximation.
    !
    ! Transport factor:
    !
    tmp=sqrt(abs(1._dl/(sin_K*sin_K)-alpha*alpha))

    ! Eikonal factor
    !
    eikonal=qintegral(sin_K,alpha,K)



    arg=(1.5d0*eikonal/epsilon)**(1._dl/3._dl)

    arg2=arg*arg
    if(achi>chi0) arg2=-arg2

    ! Multiply factors together

    wkb=airy_ai(arg2)*symm*ROOTPI*sqrt(arg*epsilon/anu/tmp)/Sin_K
    phi_langer=wkb

    end function phi_langer

    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !                                                                       c
    ! Evaluates the exact solution to  the integral giving the WKB          c
    ! eikonal solution,   \int^x sqrt(abs(Q(x))) dx                         c
    !                                                                       c
    ! In the open case, this integral costs 1 or 2 square roots, an atan    c
    ! and a log; its evaluation will be roughly as expensive as the rest    c
    ! of the Phi routine. An analytic fit cannot be substantially faster    c
    ! because the dependence on alpha of the y-intercept of the linear      c
    ! region of the integrand contains a log and an atan, so at best a fit  c
    ! can only save the computation of the square roots.                    c
    !                                                                       c
    ! The integrals are very bland functions of chi and alpha and could     c
    ! be precomputed and cached to save computation time; interpolation     c
    ! on a relatively small number of points should be very accurate        c
    !                                                                       c
    ! Note that for the closed case, the variable arg must be between 0     c
    ! and alpha; for arg > alpha, symmetry properties reduce the needed     c
    ! integral to this case.                                                c
    !                                                                       c
    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    function qintegral(sin_K,alpha, K)
    implicit none
    real(dl) qintegral, sin_K
    integer K
    real(dl) alpha,exact,arg, root1, root2, dummyarg

    real(dl), parameter :: PI=3.1415926536d0,ROOTPI=1.772453851d0,ROOT2PI=2.506628275d0, &
        PIOVER2=1.570796327d0

    arg=alpha*sin_K

    if(K==0) then
        if(arg>1._dl) then
            exact=sqrt(arg*arg-1._dl)-acos(1._dl/arg)
            qintegral=exact
            return
        else
            root1=sqrt(1._dl-arg*arg)
            exact=log((1._dl+root1)/arg)-root1
            qintegral=exact
            return
        endif
    else if(K==-1) then
        if(arg>1._dl) then
            root1=sqrt(arg*arg-1._dl)
            root2=sqrt(arg*arg+alpha*alpha)
            exact=alpha/2._dl*log((2._dl*arg*arg+alpha*alpha-1._dl+ &
                2._dl*root1*root2)/(1._dl+alpha*alpha))+atan(root2/ &
                (alpha*root1))-PIOVER2
            qintegral=exact
            return
        else
            root1=sqrt((1._dl-arg*arg)*(arg*arg+alpha*alpha))
            exact=alpha/2._dl*atan(-2._dl*root1/(2*arg*arg+alpha*alpha- &
                1._dl))+0.5d0*log((2._dl*alpha*root1+2._dl*alpha*alpha+ &
                arg*arg*(1._dl-alpha*alpha))/(arg*arg*(1._dl+ &
                alpha*alpha)))
            if(2._dl*arg*arg+alpha*alpha-1._dl<0._dl) then
                exact=exact-alpha*PIOVER2
            endif
            qintegral=exact
            return
        endif
    else
        if(arg>1._dl) then
            root1=sqrt(arg*arg-1._dl)
            root2=sqrt(alpha*alpha-arg*arg)
            exact=alpha/2._dl*atan(-2._dl*root1*root2/ &
                (2._dl*arg*arg-alpha*alpha-1._dl))- &
                atan(-root2/(root1*alpha))-PIOVER2
            if(2._dl*arg*arg-alpha*alpha-1._dl>0._dl) then
                exact=exact+alpha*PIOVER2
            endif
        else
            root1=sqrt((1._dl-arg*arg)*(alpha*alpha-arg*arg))
            dummyarg=alpha*(1._dl-arg*arg)/root1
            exact=0.5d0*log((1._dl+dummyarg)/(1._dl-dummyarg))- &
                alpha/2._dl*log((alpha*alpha-2._dl*arg*arg+1._dl+2._dl*root1)/ &
                (alpha*alpha-1._dl))
        endif
        qintegral=exact
        return
    endif

    end function qintegral

    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !                                                                      c
    !       Airy function                                                  c
    !                                                                      c
    ! Modified from original routine by Stephen Moshier, available         c
    ! as part of the Cephes library at www.netlib.com                      c
    ! Modifications: eliminates calculation of Bi(x), Ai'(x), Bi'(x)       c
    ! and translation to Fortran                                           c
    !                                                                      c
    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !
    ! DESCRIPTION:
    !
    ! Solution of the differential equation
    !
    !       y"(x) = xy.
    !
    ! The function returns the two independent solutions Ai, Bi
    ! and their first derivatives Ai'(x), Bi'(x).
    !
    ! Evaluation is by power series summation for small x,
    ! by rational minimax approximations for large x.
    !
    !
    !
    ! ACCURACY:
    ! Error criterion is absolute when function <= 1, relative
    ! when function > 1, except * denotes relative error criterion.
    ! For large negative x, the absolute error increases as x^1.5.
    ! For large positive x, the relative error increases as x^1.5.
    !
    ! Arithmetic  domain   function  # trials      peak         rms
    ! IEEE        -10, 0     Ai        10000       1.6e-15     2.7e-16
    ! IEEE          0, 10    Ai        10000       2.3e-14*    1.8e-15*
    ! IEEE        -10, 0     Ai'       10000       4.6e-15     7.6e-16
    ! IEEE          0, 10    Ai'       10000       1.8e-14*    1.5e-15*
    ! IEEE        -10, 10    Bi        30000       4.2e-15     5.3e-16
    ! IEEE        -10, 10    Bi'       30000       4.9e-15     7.3e-16
    ! DEC         -10, 0     Ai         5000       1.7e-16     2.8e-17
    ! DEC           0, 10    Ai         5000       2.1e-15*    1.7e-16*
    ! DEC         -10, 0     Ai'        5000       4.7e-16     7.8e-17
    ! DEC           0, 10    Ai'       12000       1.8e-15*    1.5e-16*
    ! DEC         -10, 10    Bi        10000       5.5e-16     6.8e-17
    ! DEC         -10, 10    Bi'        7000       5.3e-16     8.7e-17
    !
    !
    ! Cephes Math Library Release 2.1:  January, 1989
    ! Copyright 1984, 1987, 1989 by Stephen lSamp%l. Moshier
    ! Direct inquiries to 30 Frost Street, Cambridge, MA 02140
    !

    function airy_ai(x)
    implicit none
    real(dl) airy_ai
    real(dl) x,z, zz, t, f, g, uf, ug, zeta, theta
    real(dl) ak
    real(dl) AN(8),AD(8),AFN(9),AFD(9),AGN(11),AGD(10)
    real(dl), parameter :: AMAXAIRY=25.77d0,ACC=1.d-8,PI=3.1415926536d0
    real(dl), parameter :: c1=0.35502805388781723926d0, c2=0.258819403792806798405d0
    real(dl), parameter :: sqrt3=1.732050807568877293527d0,sqpii=5.64189583547756286948d-1


    AN(1)=3.46538101525629032477d-1
    AN(2)=1.20075952739645805542d1
    AN(3)=7.62796053615234516538d1
    AN(4)=1.68089224934630576269d2
    AN(5)=1.59756391350164413639d2
    AN(6)=7.05360906840444183113d1
    AN(7)=1.40264691163389668864d1
    AN(8)=9.99999999999999995305d-1

    AD(1)=5.67594532638770212846d-1
    AD(2)=1.47562562584847203173d1
    AD(3)=8.45138970141474626562d1
    AD(4)=1.77318088145400459522d2
    AD(5)=1.64234692871529701831d2
    AD(6)=7.14778400825575695274d1
    AD(7)=1.40959135607834029598d1
    AD(8)=1.00000000000000000470d0

    AFN(1)=-1.31696323418331795333d-1
    AFN(2)=-6.26456544431912369773d-1
    AFN(3)=-6.93158036036933542233d-1
    AFN(4)=-2.79779981545119124951d-1
    AFN(5)=-4.91900132609500318020d-2
    AFN(6)=-4.06265923594885404393d-3
    AFN(7)=-1.59276496239262096340d-4
    AFN(8)=-2.77649108155232920844d-6
    AFN(9)=-1.67787698489114633780d-8

    AFD(1)=1.33560420706553243746d1
    AFD(2)=3.26825032795224613948d1
    AFD(3)=2.67367040941499554804d1
    AFD(4)=9.18707402907259625840d0
    AFD(5)=1.47529146771666414581d0
    AFD(6)=1.15687173795188044134d-1
    AFD(7)=4.40291641615211203805d-3
    AFD(8)=7.54720348287414296618d-5
    AFD(9)=4.51850092970580378464d-7

    AGN(1)=1.97339932091685679179d-2
    AGN(2)=3.91103029615688277255d-1
    AGN(3)=1.06579897599595591108d0
    AGN(4)=9.39169229816650230044d-1
    AGN(5)=3.51465656105547619242d-1
    AGN(6)=6.33888919628925490927d-2
    AGN(7)=5.85804113048388458567d-3
    AGN(8)=2.82851600836737019778d-4
    AGN(9)=6.98793669997260967291d-6
    AGN(10)=8.11789239554389293311d-8
    AGN(11)=3.41551784765923618484d-10

    AGD(1)=9.30892908077441974853d0
    AGD(2)=1.98352928718312140417d1
    AGD(3)=1.55646628932864612953d1
    AGD(4)=5.47686069422975497931d0
    AGD(5)=9.54293611618961883998d-1
    AGD(6)=8.64580826352392193095d-2
    AGD(7)=4.12656523824222607191d-3
    AGD(8)=1.01259085116509135510d-4
    AGD(9)=1.17166733214413521882d-6
    AGD(10)=4.91834570062930015649d-9
    !
    ! Exponentially tiny for large enough argument
    !
    if(x>AMAXAIRY) then
        airy_ai=0._dl
        return
    endif
    !
    ! Pade fit for large negative arguments
    !
    if(x<-2.09d0) then
        t=sqrt(-x)
        zeta=-2._dl*x*t/3._dl
        t=sqrt(t)
        ak=sqpii/t
        z=1._dl/zeta
        zz=z*z
        uf=1._dl+zz*polevl(zz,AFN,8)/p1evl(zz,AFD,9)
        ug=z*polevl(zz,AGN,10)/p1evl(zz,AGD,10)
        theta=zeta+0.25d0*PI
        f=sin(theta)
        g=cos(theta)
        airy_ai=ak*(f*uf-g*ug)
        return
    endif
    !
    ! Pade fit for large positive arguments
    !
    if(x>=2.09) then
        t=sqrt(x)
        zeta=2._dl*x*t/3._dl
        g=exp(zeta)
        t=sqrt(t)
        ak=2._dl*t*g
        z=1._dl/zeta
        f=polevl(z,AN,7)/polevl(z,AD,7)
        airy_ai=sqpii*f/ak
        return
    endif
    !
    ! Taylor series for region around x=0
    !

    f=1._dl
    g=x
    t=1._dl
    uf=1._dl
    ug=x
    ak=1._dl
    z=x*x*x
    do while (t>ACC)
        uf=uf*z
        ak=ak+1._dl
        uf=uf/ak
        ug=ug*z
        ak=ak+1._dl
        ug=ug/ak
        uf=uf/ak
        f=f+uf
        ak=ak+1._dl
        ug=ug/ak
        g=g+ug
        t=abs(uf/f)
    end do


    airy_ai=c1*f-c2*g

    end function airy_ai

    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    !  Evaluate polynomial                                          c
    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    ! DESCRIPTION:
    !
    ! Evaluates polynomial of degree N:
    !
    !                     2          N
    ! y  =  C  + C x + C x  +...+ C x
    !        0    1     2          N
    !
    ! Coefficients are stored in reverse order:
    !
    ! coef(1) = C  , ..., coef(N+1) = C  .
    !            N                     0
    !
    ! The function p1evl() assumes that C = 1.0 and is
    !                                    N
    ! omitted from the array.  Its calling arguments are
    ! otherwise the same as polevl().
    !
    !
    ! SPEED:
    !
    ! In the interest of speed, there are no checks for out
    ! of bounds arithmetic.  This routine is used by most of
    ! the functions in the library.  Depending on available
    ! equipment features, the user may wish to rewrite the
    ! program in microcode or assembly language.
    !
    ! Cephes Math Library Release 2.1:  December, 1988
    ! Copyright 1984, 1987, 1988 by Stephen lSamp%l. Moshier
    ! Direct inquiries to 30 Frost Street, Cambridge, MA 02140
    !
    function polevl(x,coef,N)
    implicit none
    real(dl) polevl
    real(dl) x,ans
    real(dl) coef
    integer N,i

    dimension coef(N+1)

    ans=coef(1)
    do i=2,N+1
        ans=ans*x+coef(i)
    end do
    polevl=ans

    end function polevl

    !
    !
    ! Evaluate polynomial when coefficient of x  is 1.0.
    ! Otherwise same as polevl.
    !
    function p1evl(x,coef,N)
    implicit none
    real(dl) p1evl
    real(dl) x,coef,ans
    integer N,i
    dimension coef(N)

    ans=x+coef(1)
    do i=2,N
        ans=ans*x+coef(i)
    end do
    p1evl=ans

    end function p1evl



    end module SpherBessels !USpherBessels



    SUBROUTINE BJL_EXTERNAL(L,X,JL)
    use SpherBessels
    use Precision
    !!== MODIFIED SUBROUTINE FOR SPHERICAL BESSEL FUNCTIONS.                       ==!!
    !!== CORRECTED THE SMALL BUGS IN PACKAGE CMBFAST&CAMB(for l=4,5, x~0.001-0.002)==!!
    !!== CORRECTED THE SIGN OF J_L(X) FOR X<0 CASE                                 ==!!
    !!== WORKS FASTER AND MORE ACCURATE FOR LOW L, X<<L, AND L<<X cases            ==!!
    !!== zqhuang@astro.utoronto.ca                                                 ==!!
    IMPLICIT NONE
    INTEGER L
    real(dl) X,JL

    call BJL(L,X,JL)

    END SUBROUTINE BJL_EXTERNAL

