/* DECK DCHU */
doublereal dchu_(doublereal *a, doublereal *b, doublereal *x)
{
/* Initialized data */
static doublereal pi = 3.141592653589793238462643383279503;
static doublereal eps = 0.;
/* System generated locals */
integer i__1;
doublereal ret_val, d__1, d__2, d__3;
/* Local variables */
static integer i__, m, n;
static doublereal t, a0, b0, c0, xi, xn, xi1, sum, beps, alnx, pch1i;
extern doublereal d9chu_(doublereal *, doublereal *, doublereal *);
static doublereal xeps1;
extern doublereal dgamr_(doublereal *);
static doublereal aintb;
extern doublereal dpoch_(doublereal *, doublereal *), d1mach_(integer *);
static doublereal pch1ai;
static integer istrt;
extern doublereal dpoch1_(doublereal *, doublereal *);
static doublereal gamri1;
extern doublereal dgamma_(doublereal *);
static doublereal pochai, gamrni, factor;
extern doublereal dexprl_(doublereal *);
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
static doublereal xtoeps;
/* ***BEGIN PROLOGUE DCHU */
/* ***PURPOSE Compute the logarithmic confluent hypergeometric function. */
/* ***LIBRARY SLATEC (FNLIB) */
/* ***CATEGORY C11 */
/* ***TYPE DOUBLE PRECISION (CHU-S, DCHU-D) */
/* ***KEYWORDS FNLIB, LOGARITHMIC CONFLUENT HYPERGEOMETRIC FUNCTION, */
/* SPECIAL FUNCTIONS */
/* ***AUTHOR Fullerton, W., (LANL) */
/* ***DESCRIPTION */
/* DCHU(A,B,X) calculates the double precision logarithmic confluent */
/* hypergeometric function U(A,B,X) for double precision arguments */
/* A, B, and X. */
/* This routine is not valid when 1+A-B is close to zero if X is small. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED D1MACH, D9CHU, DEXPRL, DGAMMA, DGAMR, DPOCH, */
/* DPOCH1, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 770801 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890531 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
/* 900727 Added EXTERNAL statement. (WRB) */
/* ***END PROLOGUE DCHU */
/* ***FIRST EXECUTABLE STATEMENT DCHU */
if (eps == 0.) {
eps = d1mach_(&c__3);
}
if (*x == 0.) {
xermsg_("SLATEC", "DCHU", "X IS ZERO SO DCHU IS INFINITE", &c__1, &
c__2, (ftnlen)6, (ftnlen)4, (ftnlen)29);
}
if (*x < 0.) {
xermsg_("SLATEC", "DCHU", "X IS NEGATIVE, USE CCHU", &c__2, &c__2, (
ftnlen)6, (ftnlen)4, (ftnlen)23);
}
/* Computing MAX */
d__2 = abs(*a);
/* Computing MAX */
d__3 = (d__1 = *a + 1. - *b, abs(d__1));
if (max(d__2,1.) * max(d__3,1.) < abs(*x) * .99) {
goto L120;
}
/* THE ASCENDING SERIES WILL BE USED, BECAUSE THE DESCENDING RATIONAL */
/* APPROXIMATION (WHICH IS BASED ON THE ASYMPTOTIC SERIES) IS UNSTABLE. */
if ((d__1 = *a + 1. - *b, abs(d__1)) < sqrt(eps)) {
xermsg_("SLATEC", "DCHU", "ALGORITHMIS BAD WHEN 1+A-B IS NEAR ZERO F"
"OR SMALL X", &c__10, &c__2, (ftnlen)6, (ftnlen)4, (ftnlen)51);
}
if (*b >= 0.) {
d__1 = *b + .5;
aintb = d_int(&d__1);
}
if (*b < 0.) {
d__1 = *b - .5;
aintb = d_int(&d__1);
}
beps = *b - aintb;
n = (integer) aintb;
alnx = log(*x);
xtoeps = exp(-beps * alnx);
/* EVALUATE THE FINITE SUM. ----------------------------------------- */
if (n >= 1) {
goto L40;
}
/* CONSIDER THE CASE B .LT. 1.0 FIRST. */
sum = 1.;
if (n == 0) {
goto L30;
}
t = 1.;
m = -n;
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
xi1 = (doublereal) (i__ - 1);
t = t * (*a + xi1) * *x / ((*b + xi1) * (xi1 + 1.));
sum += t;
/* L20: */
}
L30:
d__1 = *a + 1. - *b;
d__2 = -(*a);
sum = dpoch_(&d__1, &d__2) * sum;
goto L70;
/* NOW CONSIDER THE CASE B .GE. 1.0. */
L40:
sum = 0.;
m = n - 2;
if (m < 0) {
goto L70;
}
t = 1.;
sum = 1.;
if (m == 0) {
goto L60;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
xi = (doublereal) i__;
t = t * (*a - *b + xi) * *x / ((1. - *b + xi) * xi);
sum += t;
/* L50: */
}
L60:
d__1 = *b - 1.;
i__1 = 1 - n;
sum = dgamma_(&d__1) * dgamr_(a) * pow_di(x, &i__1) * xtoeps * sum;
/* NEXT EVALUATE THE INFINITE SUM. ---------------------------------- */
L70:
istrt = 0;
if (n < 1) {
istrt = 1 - n;
}
xi = (doublereal) istrt;
d__1 = *a + 1. - *b;
factor = pow_di(&c_b25, &n) * dgamr_(&d__1) * pow_di(x, &istrt);
if (beps != 0.) {
factor = factor * beps * pi / sin(beps * pi);
}
pochai = dpoch_(a, &xi);
d__1 = xi + 1.;
gamri1 = dgamr_(&d__1);
d__1 = aintb + xi;
gamrni = dgamr_(&d__1);
d__1 = xi - beps;
d__2 = xi + 1. - beps;
b0 = factor * dpoch_(a, &d__1) * gamrni * dgamr_(&d__2);
if ((d__1 = xtoeps - 1., abs(d__1)) > .5) {
goto L90;
}
/* X**(-BEPS) IS CLOSE TO 1.0D0, SO WE MUST BE CAREFUL IN EVALUATING THE */
/* DIFFERENCES. */
d__1 = *a + xi;
d__2 = -beps;
pch1ai = dpoch1_(&d__1, &d__2);
d__1 = xi + 1. - beps;
pch1i = dpoch1_(&d__1, &beps);
d__1 = *b + xi;
d__2 = -beps;
c0 = factor * pochai * gamrni * gamri1 * (-dpoch1_(&d__1, &d__2) + pch1ai
- pch1i + beps * pch1ai * pch1i);
/* XEPS1 = (1.0 - X**(-BEPS))/BEPS = (X**(-BEPS) - 1.0)/(-BEPS) */
d__1 = -beps * alnx;
xeps1 = alnx * dexprl_(&d__1);
ret_val = sum + c0 + xeps1 * b0;
xn = (doublereal) n;
for (i__ = 1; i__ <= 1000; ++i__) {
xi = (doublereal) (istrt + i__);
xi1 = (doublereal) (istrt + i__ - 1);
b0 = (*a + xi1 - beps) * b0 * *x / ((xn + xi1) * (xi - beps));
c0 = (*a + xi1) * c0 * *x / ((*b + xi1) * xi) - ((*a - 1.) * (xn + xi
* 2. - 1.) + xi * (xi - beps)) * b0 / (xi * (*b + xi1) * (*a
+ xi1 - beps));
t = c0 + xeps1 * b0;
ret_val += t;
if (abs(t) < eps * abs(ret_val)) {
goto L130;
}
/* L80: */
}
xermsg_("SLATEC", "DCHU", "NO CONVERGENCE IN 1000 TERMS OF THE ASCENDING"
" SERIES", &c__3, &c__2, (ftnlen)6, (ftnlen)4, (ftnlen)52);
/* X**(-BEPS) IS VERY DIFFERENT FROM 1.0, SO THE STRAIGHTFORWARD */
/* FORMULATION IS STABLE. */
L90:
d__1 = *b + xi;
a0 = factor * pochai * dgamr_(&d__1) * gamri1 / beps;
b0 = xtoeps * b0 / beps;
ret_val = sum + a0 - b0;
for (i__ = 1; i__ <= 1000; ++i__) {
xi = (doublereal) (istrt + i__);
xi1 = (doublereal) (istrt + i__ - 1);
a0 = (*a + xi1) * a0 * *x / ((*b + xi1) * xi);
b0 = (*a + xi1 - beps) * b0 * *x / ((aintb + xi1) * (xi - beps));
t = a0 - b0;
ret_val += t;
if (abs(t) < eps * abs(ret_val)) {
goto L130;
}
/* L100: */
}
xermsg_("SLATEC", "DCHU", "NO CONVERGENCE IN 1000 TERMS OF THE ASCENDING"
" SERIES", &c__3, &c__2, (ftnlen)6, (ftnlen)4, (ftnlen)52);
/* USE LUKE-S RATIONAL APPROXIMATION IN THE ASYMPTOTIC REGION. */
L120:
d__1 = -(*a);
ret_val = pow_dd(x, &d__1) * d9chu_(a, b, x);
L130:
return ret_val;
} /* dchu_ */
/* DECK DGAMR */
doublereal dgamr_(doublereal *x)
{
/* System generated locals */
doublereal ret_val;
/* Builtin functions */
double d_int(doublereal *), exp(doublereal);
/* Local variables */
doublereal alngx;
// integer irold;
// extern /* Subroutine */ int xgetf_(integer *);
doublereal sgngx;
// extern /* Subroutine */ int xsetf_(integer *);
extern doublereal dgamma_(doublereal *);
extern /* Subroutine */ int dlgams_(doublereal *, doublereal *,
doublereal *), xerclr_(void);
/* ***BEGIN PROLOGUE DGAMR */
/* ***PURPOSE Compute the reciprocal of the Gamma function. */
/* ***LIBRARY SLATEC (FNLIB) */
/* ***CATEGORY C7A */
/* ***TYPE DOUBLE PRECISION (GAMR-S, DGAMR-D, CGAMR-C) */
/* ***KEYWORDS FNLIB, RECIPROCAL GAMMA FUNCTION, SPECIAL FUNCTIONS */
/* ***AUTHOR Fullerton, W., (LANL) */
/* ***DESCRIPTION */
/* DGAMR(X) calculates the double precision reciprocal of the */
/* complete Gamma function for double precision argument X. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED DGAMMA, DLGAMS, XERCLR, XGETF, XSETF */
/* ***REVISION HISTORY (YYMMDD) */
/* 770701 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890531 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900727 Added EXTERNAL statement. (WRB) */
/* ***END PROLOGUE DGAMR */
/* ***FIRST EXECUTABLE STATEMENT DGAMR */
ret_val = 0.;
if (*x <= 0. && d_int(x) == *x) {
return ret_val;
}
// xgetf_(&irold);
// xsetf_(&c__1);
if (abs(*x) > 10.) {
goto L10;
}
ret_val = 1. / dgamma_(x);
// xerclr_();
// xsetf_(&irold);
return ret_val;
L10:
dlgams_(x, &alngx, &sgngx);
// xerclr_();
// xsetf_(&irold);
ret_val = sgngx * exp(-alngx);
return ret_val;
} /* dgamr_ */
/* DECK DBSKNU */
/* Subroutine */ int dbsknu_(doublereal *x, doublereal *fnu, integer *kode,
integer *n, doublereal *y, integer *nz)
{
/* Initialized data */
static doublereal x1 = 2.;
static doublereal x2 = 17.;
static doublereal pi = 3.14159265358979;
static doublereal rthpi = 1.2533141373155;
static doublereal cc[8] = { .577215664901533,-.0420026350340952,
-.0421977345555443,.007218943246663,-2.152416741149e-4,
-2.01348547807e-5,1.133027232e-6,6.116095e-9 };
/* System generated locals */
integer i__1;
/* Local variables */
static doublereal a[160], b[160], f;
static integer i__, j, k;
static doublereal p, q, s, a1, a2, g1, g2, p1, p2, s1, s2, t1, t2, fc, ak,
bk, ck, dk, fk;
static integer kk;
static doublereal cx;
static integer nn;
static doublereal ex, tm, pt, st, rx, fhs, fks, dnu, fmu;
static integer inu;
static doublereal sqk, tol, smu, dnu2, coef, elim, flrx;
static integer iflag, koded;
static doublereal etest;
extern doublereal d1mach_(integer *);
extern integer i1mach_(integer *);
extern doublereal dgamma_(doublereal *);
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* ***BEGIN PROLOGUE DBSKNU */
/* ***SUBSIDIARY */
/* ***PURPOSE Subsidiary to DBESK */
/* ***LIBRARY SLATEC */
/* ***TYPE DOUBLE PRECISION (BESKNU-S, DBSKNU-D) */
/* ***AUTHOR Amos, D. E., (SNLA) */
/* ***DESCRIPTION */
/* Abstract **** A DOUBLE PRECISION routine **** */
/* DBSKNU computes N member sequences of K Bessel functions */
/* K/SUB(FNU+I-1)/(X), I=1,N for non-negative orders FNU and */
/* positive X. Equations of the references are implemented on */
/* small orders DNU for K/SUB(DNU)/(X) and K/SUB(DNU+1)/(X). */
/* Forward recursion with the three term recursion relation */
/* generates higher orders FNU+I-1, I=1,...,N. The parameter */
/* KODE permits K/SUB(FNU+I-1)/(X) values or scaled values */
/* EXP(X)*K/SUB(FNU+I-1)/(X), I=1,N to be returned. */
/* To start the recursion FNU is normalized to the interval */
/* -0.5.LE.DNU.LT.0.5. A special form of the power series is */
/* implemented on 0.LT.X.LE.X1 while the Miller algorithm for the */
/* K Bessel function in terms of the confluent hypergeometric */
/* function U(FNU+0.5,2*FNU+1,X) is implemented on X1.LT.X.LE.X2. */
/* For X.GT.X2, the asymptotic expansion for large X is used. */
/* When FNU is a half odd integer, a special formula for */
/* DNU=-0.5 and DNU+1.0=0.5 is used to start the recursion. */
/* The maximum number of significant digits obtainable */
/* is the smaller of 14 and the number of digits carried in */
/* DOUBLE PRECISION arithmetic. */
/* DBSKNU assumes that a significant digit SINH function is */
/* available. */
/* Description of Arguments */
/* INPUT X,FNU are DOUBLE PRECISION */
/* X - X.GT.0.0D0 */
/* FNU - Order of initial K function, FNU.GE.0.0D0 */
/* N - Number of members of the sequence, N.GE.1 */
/* KODE - A parameter to indicate the scaling option */
/* KODE= 1 returns */
/* Y(I)= K/SUB(FNU+I-1)/(X) */
/* I=1,...,N */
/* = 2 returns */
/* Y(I)=EXP(X)*K/SUB(FNU+I-1)/(X) */
/* I=1,...,N */
/* OUTPUT Y is DOUBLE PRECISION */
/* Y - A vector whose first N components contain values */
/* for the sequence */
/* Y(I)= K/SUB(FNU+I-1)/(X), I=1,...,N or */
/* Y(I)=EXP(X)*K/SUB(FNU+I-1)/(X), I=1,...,N */
/* depending on KODE */
/* NZ - Number of components set to zero due to */
/* underflow, */
/* NZ= 0 , normal return */
/* NZ.NE.0 , first NZ components of Y set to zero */
/* due to underflow, Y(I)=0.0D0,I=1,...,NZ */
/* Error Conditions */
/* Improper input arguments - a fatal error */
/* Overflow - a fatal error */
/* Underflow with KODE=1 - a non-fatal error (NZ.NE.0) */
/* ***SEE ALSO DBESK */
/* ***REFERENCES N. M. Temme, On the numerical evaluation of the modified */
/* Bessel function of the third kind, Journal of */
/* Computational Physics 19, (1975), pp. 324-337. */
/* ***ROUTINES CALLED D1MACH, DGAMMA, I1MACH, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 790201 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890911 Removed unnecessary intrinsics. (WRB) */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
/* 900326 Removed duplicate information from DESCRIPTION section. */
/* (WRB) */
/* 900328 Added TYPE section. (WRB) */
/* 900727 Added EXTERNAL statement. (WRB) */
/* 910408 Updated the AUTHOR and REFERENCES sections. (WRB) */
/* 920501 Reformatted the REFERENCES section. (WRB) */
/* ***END PROLOGUE DBSKNU */
/* Parameter adjustments */
--y;
/* Function Body */
/* ***FIRST EXECUTABLE STATEMENT DBSKNU */
kk = -i1mach_(&c__15);
elim = (kk * d1mach_(&c__5) - 3.) * 2.303;
ak = d1mach_(&c__3);
tol = max(ak,1e-15);
if (*x <= 0.) {
goto L350;
}
if (*fnu < 0.) {
goto L360;
}
if (*kode < 1 || *kode > 2) {
goto L370;
}
if (*n < 1) {
goto L380;
}
*nz = 0;
iflag = 0;
koded = *kode;
rx = 2. / *x;
inu = (integer) (*fnu + .5);
dnu = *fnu - inu;
if (abs(dnu) == .5) {
goto L120;
}
dnu2 = 0.;
if (abs(dnu) < tol) {
goto L10;
}
dnu2 = dnu * dnu;
L10:
if (*x > x1) {
goto L120;
}
/* SERIES FOR X.LE.X1 */
a1 = 1. - dnu;
a2 = dnu + 1.;
t1 = 1. / dgamma_(&a1);
t2 = 1. / dgamma_(&a2);
if (abs(dnu) > .1) {
goto L40;
}
/* SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) */
s = cc[0];
ak = 1.;
for (k = 2; k <= 8; ++k) {
ak *= dnu2;
tm = cc[k - 1] * ak;
s += tm;
if (abs(tm) < tol) {
goto L30;
}
/* L20: */
}
L30:
g1 = -s;
goto L50;
L40:
g1 = (t1 - t2) / (dnu + dnu);
L50:
g2 = (t1 + t2) * .5;
smu = 1.;
fc = 1.;
flrx = log(rx);
fmu = dnu * flrx;
if (dnu == 0.) {
goto L60;
}
fc = dnu * pi;
fc /= sin(fc);
if (fmu != 0.) {
smu = sinh(fmu) / fmu;
}
L60:
f = fc * (g1 * cosh(fmu) + g2 * flrx * smu);
fc = exp(fmu);
p = fc * .5 / t2;
q = .5 / (fc * t1);
ak = 1.;
ck = 1.;
bk = 1.;
s1 = f;
s2 = p;
if (inu > 0 || *n > 1) {
goto L90;
}
if (*x < tol) {
goto L80;
}
cx = *x * *x * .25;
L70:
f = (ak * f + p + q) / (bk - dnu2);
p /= ak - dnu;
q /= ak + dnu;
ck = ck * cx / ak;
t1 = ck * f;
s1 += t1;
bk = bk + ak + ak + 1.;
ak += 1.;
s = abs(t1) / (abs(s1) + 1.);
if (s > tol) {
goto L70;
}
L80:
y[1] = s1;
if (koded == 1) {
return 0;
}
y[1] = s1 * exp(*x);
return 0;
L90:
if (*x < tol) {
goto L110;
}
cx = *x * *x * .25;
L100:
f = (ak * f + p + q) / (bk - dnu2);
p /= ak - dnu;
q /= ak + dnu;
ck = ck * cx / ak;
t1 = ck * f;
s1 += t1;
t2 = ck * (p - ak * f);
s2 += t2;
bk = bk + ak + ak + 1.;
ak += 1.;
s = abs(t1) / (abs(s1) + 1.) + abs(t2) / (abs(s2) + 1.);
if (s > tol) {
goto L100;
}
L110:
s2 *= rx;
if (koded == 1) {
goto L170;
}
f = exp(*x);
s1 *= f;
s2 *= f;
goto L170;
L120:
coef = rthpi / sqrt(*x);
if (koded == 2) {
goto L130;
}
if (*x > elim) {
goto L330;
}
coef *= exp(-(*x));
L130:
if (abs(dnu) == .5) {
goto L340;
}
if (*x > x2) {
goto L280;
}
/* MILLER ALGORITHM FOR X1.LT.X.LE.X2 */
etest = cos(pi * dnu) / (pi * *x * tol);
fks = 1.;
fhs = .25;
fk = 0.;
ck = *x + *x + 2.;
p1 = 0.;
p2 = 1.;
k = 0;
L140:
++k;
fk += 1.;
ak = (fhs - dnu2) / (fks + fk);
bk = ck / (fk + 1.);
pt = p2;
p2 = bk * p2 - ak * p1;
p1 = pt;
a[k - 1] = ak;
b[k - 1] = bk;
ck += 2.;
fks = fks + fk + fk + 1.;
fhs = fhs + fk + fk;
if (etest > fk * p1) {
goto L140;
}
kk = k;
s = 1.;
p1 = 0.;
p2 = 1.;
i__1 = k;
for (i__ = 1; i__ <= i__1; ++i__) {
pt = p2;
p2 = (b[kk - 1] * p2 - p1) / a[kk - 1];
p1 = pt;
s += p2;
--kk;
/* L150: */
}
s1 = coef * (p2 / s);
if (inu > 0 || *n > 1) {
goto L160;
}
goto L200;
L160:
s2 = s1 * (*x + dnu + .5 - p1 / p2) / *x;
/* FORWARD RECURSION ON THE THREE TERM RECURSION RELATION */
L170:
ck = (dnu + dnu + 2.) / *x;
if (*n == 1) {
--inu;
}
if (inu > 0) {
goto L180;
}
if (*n > 1) {
goto L200;
}
s1 = s2;
goto L200;
L180:
i__1 = inu;
for (i__ = 1; i__ <= i__1; ++i__) {
st = s2;
s2 = ck * s2 + s1;
s1 = st;
ck += rx;
/* L190: */
}
if (*n == 1) {
s1 = s2;
}
L200:
if (iflag == 1) {
goto L220;
}
y[1] = s1;
if (*n == 1) {
return 0;
}
y[2] = s2;
if (*n == 2) {
return 0;
}
i__1 = *n;
for (i__ = 3; i__ <= i__1; ++i__) {
y[i__] = ck * y[i__ - 1] + y[i__ - 2];
ck += rx;
/* L210: */
}
return 0;
/* IFLAG=1 CASES */
L220:
s = -(*x) + log(s1);
y[1] = 0.;
*nz = 1;
if (s < -elim) {
goto L230;
}
y[1] = exp(s);
*nz = 0;
L230:
if (*n == 1) {
return 0;
}
s = -(*x) + log(s2);
y[2] = 0.;
++(*nz);
if (s < -elim) {
goto L240;
}
--(*nz);
y[2] = exp(s);
L240:
if (*n == 2) {
return 0;
}
kk = 2;
if (*nz < 2) {
goto L260;
}
i__1 = *n;
for (i__ = 3; i__ <= i__1; ++i__) {
kk = i__;
st = s2;
s2 = ck * s2 + s1;
s1 = st;
ck += rx;
s = -(*x) + log(s2);
++(*nz);
y[i__] = 0.;
if (s < -elim) {
goto L250;
}
y[i__] = exp(s);
--(*nz);
goto L260;
L250:
;
}
return 0;
L260:
if (kk == *n) {
return 0;
}
s2 = s2 * ck + s1;
ck += rx;
++kk;
y[kk] = exp(-(*x) + log(s2));
if (kk == *n) {
return 0;
}
++kk;
i__1 = *n;
for (i__ = kk; i__ <= i__1; ++i__) {
y[i__] = ck * y[i__ - 1] + y[i__ - 2];
ck += rx;
/* L270: */
}
return 0;
/* ASYMPTOTIC EXPANSION FOR LARGE X, X.GT.X2 */
/* IFLAG=0 MEANS NO UNDERFLOW OCCURRED */
/* IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH */
/* KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD */
/* RECURSION */
L280:
nn = 2;
if (inu == 0 && *n == 1) {
nn = 1;
}
dnu2 = dnu + dnu;
fmu = 0.;
if (abs(dnu2) < tol) {
goto L290;
}
fmu = dnu2 * dnu2;
L290:
ex = *x * 8.;
s2 = 0.;
i__1 = nn;
for (k = 1; k <= i__1; ++k) {
s1 = s2;
s = 1.;
ak = 0.;
ck = 1.;
sqk = 1.;
dk = ex;
for (j = 1; j <= 30; ++j) {
ck = ck * (fmu - sqk) / dk;
s += ck;
dk += ex;
ak += 8.;
sqk += ak;
if (abs(ck) < tol) {
goto L310;
}
/* L300: */
}
L310:
s2 = s * coef;
fmu = fmu + dnu * 8. + 4.;
/* L320: */
}
if (nn > 1) {
goto L170;
}
s1 = s2;
goto L200;
L330:
koded = 2;
iflag = 1;
goto L120;
/* FNU=HALF ODD INTEGER CASE */
L340:
s1 = coef;
s2 = coef;
goto L170;
L350:
xermsg_("SLATEC", "DBSKNU", "X NOT GREATER THAN ZERO", &c__2, &c__1, (
ftnlen)6, (ftnlen)6, (ftnlen)23);
return 0;
L360:
xermsg_("SLATEC", "DBSKNU", "FNU NOT ZERO OR POSITIVE", &c__2, &c__1, (
ftnlen)6, (ftnlen)6, (ftnlen)24);
return 0;
L370:
xermsg_("SLATEC", "DBSKNU", "KODE NOT 1 OR 2", &c__2, &c__1, (ftnlen)6, (
ftnlen)6, (ftnlen)15);
return 0;
L380:
xermsg_("SLATEC", "DBSKNU", "N NOT GREATER THAN 0", &c__2, &c__1, (ftnlen)
6, (ftnlen)6, (ftnlen)20);
return 0;
} /* dbsknu_ */
