/*
 * METRIC --- Mode expansion modeling in integrated optics / photonics
 * http://metric.computational-photonics.eu/ 
 */

/*
 * cylfunc.cpp
 * Bessel-  and Hankel-functions 
 */

#include<stdio.h>
#include<stdlib.h>
#include<cmath>
#include"complex.h"
#include"matrix.h"
#include"gengwed.h"
#include"cylfunc.h"

/* ---------------------------------------------------------------------- */

/*
 * Bessel and Hankel functions of integer order, real argument
 * (C) Copr. 1986-92 Numerical Recipes Software 5.)13. 
 * - modified -
 */

/* error message */
void besselferror(const char *m)
{
        fprintf(stderr, "\n(NR) %s.\n", m);
        exit(1);
}

/* Bessel function of the first kind J_0, real argument, modified version of 
   float bessj0(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_J0(const double& x)
{
	double ax,z;
	double xx,y,ans,ans1,ans2;

	if ((ax=fabs(x)) < 8.0) {
		y=x*x;
		ans1=57568490574.0+y*(-13362590354.0+y*(651619640.7
			+y*(-11214424.18+y*(77392.33017+y*(-184.9052456)))));
		ans2=57568490411.0+y*(1029532985.0+y*(9494680.718
			+y*(59272.64853+y*(267.8532712+y*1.0))));
		ans=ans1/ans2;
	} else {
		z=8.0/ax;
		y=z*z;
		xx=ax-0.785398164;
		ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4
			+y*(-0.2073370639e-5+y*0.2093887211e-6)));
		ans2 = -0.1562499995e-1+y*(0.1430488765e-3
			+y*(-0.6911147651e-5+y*(0.7621095161e-6
			-y*0.934935152e-7)));
		ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2);
	}
	return ans;
}


/* Bessel function of the first kind J_1, real argument, modified version of 
   float bessj1(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_J1(const double& x)
{
	double ax,z;
	double xx,y,ans,ans1,ans2;

	if ((ax=fabs(x)) < 8.0) {
		y=x*x;
		ans1=x*(72362614232.0+y*(-7895059235.0+y*(242396853.1
			+y*(-2972611.439+y*(15704.48260+y*(-30.16036606))))));
		ans2=144725228442.0+y*(2300535178.0+y*(18583304.74
			+y*(99447.43394+y*(376.9991397+y*1.0))));
		ans=ans1/ans2;
	} else {
		z=8.0/ax;
		y=z*z;
		xx=ax-2.356194491;
		ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4
			+y*(0.2457520174e-5+y*(-0.240337019e-6))));
		ans2=0.04687499995+y*(-0.2002690873e-3
			+y*(0.8449199096e-5+y*(-0.88228987e-6
			+y*0.105787412e-6)));
		ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2);
		if (x < 0.0) ans = -ans;
	}
	return ans;
}

/* Bessel function of the first kind J_n, integer order n>=2, real argument, modified version of 
   float bessj(int n, float x) 
   (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
#define ACC 40.0
#define BIGNO 1.0e10
#define BIGNI 1.0e-10
double bessel_J(int n, const double& x)
{
	int j,jsum,m;
	double ax,bj,bjm,bjp,sum,tox,ans;

	// if(n < 2) besselferror("bessel_J: n < 2");
	if(n == 0) return bessel_J0(x);
	if(n == 1) return bessel_J1(x);

	ax=fabs(x);
	if (ax == 0.0)
		return 0.0;
	else if (ax > (double) n) {
		tox=2.0/ax;
		bjm=bessel_J0(ax);
		bj=bessel_J1(ax);
		for (j=1;j<n;j++) {
			bjp=j*tox*bj-bjm;
			bjm=bj;
			bj=bjp;
		}
		ans=bj;
	} else {
		tox=2.0/ax;
		m=2*((n+(int) sqrt(ACC*n))/2);
		jsum=0;
		bjp=ans=sum=0.0;
		bj=1.0;
		for (j=m;j>0;j--) {
			bjm=j*tox*bj-bjp;
			bjp=bj;
			bj=bjm;
			if (fabs(bj) > BIGNO) {
				bj *= BIGNI;
				bjp *= BIGNI;
				ans *= BIGNI;
				sum *= BIGNI;
			}
			if (jsum) sum += bj;
			jsum=!jsum;
			if (j == n) ans=bjp;
		}
		sum=2.0*sum-bj;
		ans /= sum;
	}
	return x < 0.0 && (n & 1) ? -ans : ans;
}
#undef ACC
#undef BIGNO
#undef BIGNI

/* Bessel function of the second kind Y_0, real argument, modified version of 
   float bessy0(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_Y0(const double& x)
{
	double z;
	double xx,y,ans,ans1,ans2;

	if (x < 8.0) {
		y=x*x;
		ans1 = -2957821389.0+y*(7062834065.0+y*(-512359803.6
			+y*(10879881.29+y*(-86327.92757+y*228.4622733))));
		ans2=40076544269.0+y*(745249964.8+y*(7189466.438
			+y*(47447.26470+y*(226.1030244+y*1.0))));
		ans=(ans1/ans2)+0.636619772*bessel_J0(x)*log(x);
	} else {
		z=8.0/x;
		y=z*z;
		xx=x-0.785398164;
		ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4
			+y*(-0.2073370639e-5+y*0.2093887211e-6)));
		ans2 = -0.1562499995e-1+y*(0.1430488765e-3
			+y*(-0.6911147651e-5+y*(0.7621095161e-6
			+y*(-0.934945152e-7))));
		ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2);
	}
	return ans;
}

/* Bessel function of the second kind Y_1, real argument, modified version of 
   float bessy1(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_Y1(const double& x)
{
	double z;
	double xx,y,ans,ans1,ans2;

	if (x < 8.0) {
		y=x*x;
		ans1=x*(-0.4900604943e13+y*(0.1275274390e13
			+y*(-0.5153438139e11+y*(0.7349264551e9
			+y*(-0.4237922726e7+y*0.8511937935e4)))));
		ans2=0.2499580570e14+y*(0.4244419664e12
			+y*(0.3733650367e10+y*(0.2245904002e8
			+y*(0.1020426050e6+y*(0.3549632885e3+y)))));
		ans=(ans1/ans2)+0.636619772*(bessel_J1(x)*log(x)-1.0/x);
	} else {
		z=8.0/x;
		y=z*z;
		xx=x-2.356194491;
		ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4
			+y*(0.2457520174e-5+y*(-0.240337019e-6))));
		ans2=0.04687499995+y*(-0.2002690873e-3
			+y*(0.8449199096e-5+y*(-0.88228987e-6
			+y*0.105787412e-6)));
		ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2);
	}
	return ans;
}

/* Bessel function of the second kind Y_n, integer order n>=2, real argument, modified version of 
   float bessy(int n, float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_Y(int n, const double& x)
{
	int j;
	double by,bym,byp,tox;

	// if(n < 2) besselferror("bessel_Y: n < 2");
	if(n == 0) return bessel_Y0(x);
	if(n == 1) return bessel_Y1(x);

	tox=2.0/x;
	by=bessel_Y1(x);
	bym=bessel_Y0(x);
	for (j=1;j<n;j++) {
		byp=j*tox*by-bym;
		bym=by;
		by=byp;
	}
	return by;
}

/* modified Bessel function of the first kind I_0, real argument, modified version of 
   float bessi0(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_I0(const double &x)
{
	double ax,ans;
	double y;
	if ((ax=fabs(x)) < 3.75) {
		y=x/3.75;
		y*=y;
		ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492
			+y*(0.2659732+y*(0.360768e-1+y*0.45813e-2)))));
	} else {
		y=3.75/ax;
		ans=(exp(ax)/sqrt(ax))*(0.39894228+y*(0.1328592e-1
			+y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2
			+y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1
			+y*0.392377e-2))))))));
	}
	return ans;
}

/* modified Bessel function of the first kind I_1, real argument, modified version of 
   float bessi1(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_I1(const double &x)
{
	double ax,ans;
	double y;
	if ((ax=fabs(x)) < 3.75) {
		y=x/3.75;
		y*=y;
		ans=ax*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934
			+y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3))))));
	} else {
		y=3.75/ax;
		ans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1
			-y*0.420059e-2));
		ans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2
			+y*(0.163801e-2+y*(-0.1031555e-1+y*ans))));
		ans *= (exp(ax)/sqrt(ax));
	}
	return x < 0.0 ? -ans : ans;
}

/* modified Bessel function of the first kind I_n, integer order n>=2, real argument, modified version of 
   float bessi(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
#define ACC 40.0
#define BIGNO 1.0e10
#define BIGNI 1.0e-10
double bessel_I(int n, const double &x)
{
	// if(n < 2) besselferror("bessel_I: n < 2");
	if(n == 0) return bessel_I0(x);
	if(n == 1) return bessel_I1(x);
	int j;
	double bi,bim,bip,tox,ans;
	if (x == 0.0)
		return 0.0;
	else {
		tox=2.0/fabs(x);
		bip=ans=0.0;
		bi=1.0;
		for (j=2*(n+(int) sqrt(ACC*n));j>0;j--) {
			bim=bip+j*tox*bi;
			bip=bi;
			bi=bim;
			if (fabs(bi) > BIGNO) {
				ans *= BIGNI;
				bi *= BIGNI;
				bip *= BIGNI;
			}
			if (j == n) ans=bip;
		}
		ans *= bessel_I0(x)/bi;
		return x < 0.0 && (n & 1) ? -ans : ans;
	}
}
#undef ACC
#undef BIGNO
#undef BIGNI

/* modified Bessel function of the second kind K_0, real argument, modified version of 
   float bessk0(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_K0(const double &x)
{
	double y,ans;
	if (x <= 2.0) {
		y=x*x/4.0;
		ans=(-log(x/2.0)*bessel_I0(x))+(-0.57721566+y*(0.42278420
			+y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2
			+y*(0.10750e-3+y*0.74e-5))))));
	} else {
		y=2.0/x;
		ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1
			+y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2
			+y*(-0.251540e-2+y*0.53208e-3))))));
	}
	return ans;
}

/* modified Bessel function of the second kind K_1, real argument, modified version of 
   float bessk1(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_K1(const double &x)
{
	double y,ans;
	if (x <= 2.0) {
		y=x*x/4.0;
		ans=(log(x/2.0)*bessel_I1(x))+(1.0/x)*(1.0+y*(0.15443144
			+y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1
			+y*(-0.110404e-2+y*(-0.4686e-4)))))));
	} else {
		y=2.0/x;
		ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619
			+y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2
			+y*(0.325614e-2+y*(-0.68245e-3)))))));
	}
	return ans;
}

/* modified Bessel function of the second kind K_n, integer order n>=2, real argument, modified version of 
   float bessk(float x), (C) Copr. 1986-92 Numerical Recipes Software 5.)13. */
double bessel_K(int n, const double &x)
{
	// if(n < 2) besselferror("bessel_K: n < 2");
	if(n == 0) return bessel_K0(x);
	if(n == 1) return bessel_K1(x);
	int j;
	double bk,bkm,bkp,tox;
	tox=2.0/x;
	bkm=bessel_K0(x);
	bk=bessel_K1(x);
	for (j=1;j<n;j++) {
		bkp=bkm+j*tox*bk;
		bkm=bk;
		bk=bkp;
	}
	return bk;
}

/* Hankel function H_n^(2), integer order n>=0, real argument */
Complex hankel_H2(int n, const double& x)
{
	if(n == 0) return Complex(bessel_J0(x), -bessel_Y0(x)); 
	if(n == 1) return Complex(bessel_J1(x), -bessel_Y1(x)); 
	return Complex(bessel_J(n, x), -bessel_Y(n, x)); 
}

/* Hankel function H_n^(2), integer order n>=0, real argument, 
   first derivative  */
Complex d_hankel_H2(int n, const double& x)
{
	if(n == 0) return Complex(-bessel_J1(x), bessel_Y1(x)); 
	return hankel_H2(n-1, x)-hankel_H2(n, x)*((double)n)/x;
}

/* ---------------------------------------------------------------------- 
                                    %%%
   ---------------------------------------------------------------------- */

/* 
 * Bessel- and Hankel-functions of complex order, for complex arguments
 * based on: File mod_zbes.f90
 *
 * Author: Masao Kodama
 * Address: 21-20, Gakuen 1 chome, Mastue-shi, Shimane-ken, 690-0825 Japan
 * Email: mkodama@mable.ne.jp
 *
 * Masao Kodama, "Algorithm 912: A module for calculating cylindrical
 * functions of complex order and complex argument," ACM Transactions on
 * Mathematical Software 37 (4), Article No. 47 
 *
 * & references cited therein
 */

/* global variables and constants */

double huge1 = (1.7976931348623157E+308)/3.0;
double tiny1 = 2.2250738585072014E-308;
int    ihuge = 2147483647;
double epsilon0 = 2.2204460492503131E-016;
double alog2 = log(2.0);

double ai_arg_m = 1.0E3;
double epsilon1;
double alog_huge = -1;
double alog_tiny;
double ai_znu_m; 
double alog_eps1;

Complex znua;
Complex zza;
Complex znupi;
Complex znupi_i;

double ai_znu; 
double re_znu; 
double re_zz; 
double ai_zz; 
double ai_znupi;

/* internal computational routines */

int max(const int& a, const int& b)
{
	if(a >= b) return a; 
	return b;
}

int max(const int& a, const int& b, const int& c)
{
	if(a >= b) 
	{
		if(a >= c) return a;
		return c;
	}
	if(b >= c) return b;
	return c;
}

int min(const int& a, const int& b, const int& c)
{
	if(a <= b) 
	{
		if(a <= c) return a;
		return c;
	}
	if(b <= c) return b;
	return c;
}
double min(const double& a, const double& b)
{
	if(a <= b) return a; 
	return b;
}

double sign(const double& a, const double& b)
{
	if(b >= 0.0) return fabs(a);
	return -fabs(a);
}

double mod(const double& a, const double& b)
{
	double iab = a/b;
	if(iab >= 0) iab = floor(iab);
	else         iab = ceil(iab);
	return a-iab*b;
}

double abs1(const Complex& za)
{
	return fabs(za.re)+fabs(za.im);
}

double exponent(const double& x)
{
	return ceil(log(x)/alog2);
}

int num_region(const Complex& znu, const Complex& zz)
{
	double abs_reznu;

	if(alog_huge<0)
	{
		epsilon1 = fmax(epsilon0,1.0E-20);      
		alog_eps1 = log(epsilon1);           
		alog_huge = log(huge1/2);            
		ai_znu_m = alog_huge/PI;             
		alog_tiny = log(12*tiny1/epsilon1);  
		alog2 = log(2.0);
	} 
	znua = -znu;
	zza = -zz;
	re_znu = znu.re;
	ai_znu = znu.im;
	znupi = znu*PI;
	ai_znupi = znupi.im;
	re_zz = zz.re;
	ai_zz = zz.im;
	znupi_i = Complex(-znupi.im,znupi.re);
	abs_reznu = fabs(re_znu);
	if(abs1(zz)>ai_arg_m) return 0;  
	if(zz.abs()<1)
	{
		if(abs_reznu>ihuge) return 0; 
		if((znu-round(re_znu)).abs()>0.3) return 1;
		return 2;
	} 
	if(abs_reznu>ai_arg_m)  return 0;  
	return 3; 
}

class bes1_series
{
public:
	Complex znu, zz;

	bes1_series() { return; }
	bes1_series(const Complex& znu_t, const Complex& zz_t)
	{
		znu = znu_t;
		zz = zz_t;
		return;
	}

	Complex za, zloggam, zfct, zxx2;

	void exec(Complex& zsum, Complex& zlogbes, int& info)
	{
		zlogbes = 0;
		info = 0;
		zxx2 = (zz/2)*(zz/2);
		za = 1;
		zsum = za;
		for(int i=1; i<=500; ++i)
		{
			za = -za*zxx2/(i*(znu+i));
			zsum = za + zsum;
			if(abs1(za)<epsilon1) break; 
		}
		zgamma(znu+1, zfct, zloggam, info);
		zsum = zsum/zfct;
		if(info>5) return;
		if(abs1(zz)<tiny1)
		{
			if(znu.re>0)
			{
				zsum = 0;
				zlogbes = 0;
				return;
			}
			if(abs1(znu)<tiny1)
			{
				zsum = 1;
				zlogbes = 0;
				return;
			}
			zsum = 1;
			zlogbes = 20;
			info = 10;
			return; 
		}
		zlogbes = znu*log(zz/2) - zloggam;
		if(abs1(zlogbes)>ai_arg_m) info = 10;
		return;
	}

	void zgamma(const Complex& zx, Complex& zfct, Complex& zloggam, int& info) 
	{
		Complex zx1, zx2, zlog_zsn, z1, zfct1;
		double pi2 = PI*2;
		int i2;

		zfct = 1;
		zloggam = 0;
		info = 0;
		i2 = 1;
		if(zx.re<0.5)
		{
			subgam(1-zx, zfct1, zloggam, info);
			if(info!=0) return;
			zx1 = zx;
			if(abs1(zx1-round(zx1.re))<epsilon1)
			{
				info = 10;
				zloggam = 0;
				zfct = huge1;
				return;
			}
			if(zx.im>0)
			{
				zx1 = zx.conj();
				i2 = -1;
			}
			zx2 = Complex(-zx1.im,zx1.re)*PI;
			zlog_zsn = zx2;
			z1 = Complex(0,pi2)/(1-exp(-2*zx2));
			if(i2<0)
			{
				zlog_zsn = zlog_zsn.conj();
				z1 = z1.conj();
			}
			zfct = z1/zfct1;
			zloggam = -zloggam - zlog_zsn; 
			return;
		}
		subgam(zx, zfct, zloggam, info);
		return;
	}

	void subgam(const Complex& zx, Complex& zfct, Complex& zgam, int& info) 
	{
		Complex za, za1, zb, zf, zx1, zx2;
		double sq_pi2 = 2.5066282746310005024158; 
		double dis = 20, dis2 = dis*dis;
		int i;
		Dvector coeff(8); 
		coeff(1) = 8.33333333333333333333E-2; 
		coeff(2) = -2.77777777777777777778E-3; 
		coeff(3) = 7.93650793650793650794E-4; 
		coeff(4) = -5.95238095238095238095E-4; 
		coeff(5) = 8.41750841750841750842E-4; 
		coeff(6) = -1.91752691752691752692E-3; 
		coeff(7) = 6.41025641025641025641E-3;

		info = 0;
		zgam = 0;
		zfct = 0;
		zf = 1;
		zx1 = zx;
		while(zx1.re*zx1.re+zx1.im*zx1.im<dis2)
		{
			zf = zf*zx1;
			zx1 = zx1 + 1;
		}
		za = zx1;
		zx2 = zx1*zx1;
		zb = (zx1-0.5)*log(zx1) - zx1;
		for(i=1; i<=7; ++i)
		{
			za1 = coeff(i)/za;
			zb = zb + za1;
			if(abs1(za1/zb)<epsilon1) break; 
			if(i>=7)
			{
				info = 20;
				return;
			}
			za = za*zx2;
		}
		zfct = sq_pi2/zf;
		zgam = zb;
		return;
	}
};


class bes2_series
{
public:
	Complex znu, zz;

	bes2_series() { return; }
	bes2_series(const Complex& znu_t, const Complex& zz_t)
	{
		znu = znu_t;
		zz = zz_t;
		return;
	}

	Complex zeps, z1, z2, z3;

	void exec(Complex& zbes2, int& info)
	{
		zbes2 = 0;
		info = 0;
		if(abs1(zz)<tiny1*2)
		{
			zbes2 = 1E10;
			info = 10;
			return;
		}
		double re_znud = znu.re;
		if(fabs(re_znud)>ihuge)
		{
			info = 20;
			return;
		}
		int nn = (int) round(re_znud);
		zeps = znu - nn;
		if(nn<=1)
		{ 
			bes2_srs_init(nn, zz, zbes2, info);
			if(info>1) return;
		}
		else 
		{
			bes2_srs_init(0, zz, z1, info);
			if(info>1) return;
			bes2_srs_init(1, zz, z2, info);
			if(info>1) return;
			if(nn>huge1*abs1(zz)/10)
			{
				info = 20;
				return;
			}
			double a1 = abs1(2*((nn-1)+zeps)/zz)*5;
			z2 = z2/a1;
			z1 = z1/a1;
			for(int i=2; i<=nn; ++i)
			{
				z3 = (2*((i-1)+zeps)/zz)*z2 - z1;
				if(abs1(z3)>huge1/a1)
				{
					zbes2 = huge1;
					info = 10;
					return;
				}
				z1 = z2;
				z2 = z3;
			}
			zbes2 = z3*a1;
		}
		return;
	}
	
	void bes2_srs_init(const int nn, const Complex& zz, Complex& zbes2, int& info)
	{
		Complex zbes0, zbesp, zbesm, zcsbes, zepspi, zepsm, zeps2, zdcos, zsin1, z0, z1, z2;
		int i, nnm;

		zbes2 = 0;
		info = 0;
		zepsm = -zeps;
		nnm = -nn;
		def_bessel1(nn, zeps, zz, zbes0, zbesp, info);
		if(info>1) return;
		def_bessel1(nnm, zepsm, zz, z2, zbesm, info);
		if(info>1) return;
		if(nn>=1) zbesm = -zbesm;
		zbes0 = zbes0 + zeps*zbesp; 
		zepspi = PI*zeps;
		zeps2 = zepspi*zepspi;
		z0 = -0.5;
		z1 = z0;
		for(i=3; i<=55; i+=2)
		{
			z0 = -z0*zeps2/(i*(i+1));
			z1 = z1 + z0;
			if(abs1(z0)<epsilon1) break; 
			if(i>50)
			{
				info = 35;
				return;
			}
		}
		zdcos = PI*zepspi*z1;

		zcsbes = zdcos*zbes0;

		if(abs1(zepspi)<1E-5)
		{
			zsin1 = PI*(1-zepspi*zepspi/6);
		}
		else
		{
			zsin1 = sin(zepspi)/zeps;
		}
		zbes2 = (zcsbes+zbesp+zbesm)/zsin1;
		return;
	}

	void def_bessel1(const int nn, const Complex& zeps, const Complex& zz, Complex& zbes10, Complex& zbes11, int& info)
	{
		Complex za, zalogzz, za0, za1, zexp0, zexp1, zgamma1, zsig0, zsig1, zd1, ze1, zb1, zs, zss, zeps3, zz2, z1, z2, z3, zd0, ze0, zexp;
		double amax, a0, a1, a2, gamma0, bmax, b2;
		int i, i5, n1;
		int m3 = 26;
		Dvector da(m3+1);
		da( 1) = 0.5772156649015328606064;
		da( 2) = -0.6558780715202538810765;
		da( 3) = -0.0420026350340952355289;
		da( 4) = 0.1665386113822914895012;
		da( 5) = -0.0421977345555443367480;
		da( 6) = -0.0096219715278769735622;
		da( 7) = 0.0072189432466630995427;
		da( 8) = -0.0011651675918590651118;
		da( 9) = -0.0002152416741149509743;
		da(10) = 0.0001280502823881161874;
		da(11) = -0.0000201348547807882377;
		da(12) = -0.0000012504934821426730;
		da(13) = 0.0000011330272319816972;
		da(14) = -0.0000002056338416977615;
		da(15) = 0.0000000061160951044836;
		da(16) = 0.0000000050020076444708;
		da(17) = -0.0000000011812745704992;
		da(18) = 0.0000000001043426711827;
		da(19) = 0.0000000000077822634465;
		da(20) = -0.0000000000036968056444;
		da(21) = 0.0000000000005100370461;
		da(22) = -0.0000000000000205832667;
		da(23) = -0.0000000000000053481037;
		da(24) = 0.0000000000000012267886;
		da(25) = -0.0000000000000001182577;
		da(26) = 0.0000000000000000013656;

		info = 0;
		zbes10 = 0;
		zbes11 = 0;

		gamma0 = 1;
		zgamma1 = 0;
		zeps3 = 1;
		amax = 0;
		for(i=1; i<=m3; ++i)
		{
			zs = da(i)*zeps3;
			zgamma1 = zgamma1 + zs;
			a1 = abs1(zs);
			amax = fmax(amax,a1);
			if(a1/amax<epsilon1) break; 
			if(i==m3)
			{
				info = 35;
				return;
			}
			zeps3 = zeps3*zeps;
		}
		if(nn>=1)
		{ 
			a0 = gamma0;
			z1 = zgamma1;
			divis(zeps, a0, z1, 1.0, CC1, gamma0, zgamma1);
		}

		zz2 = (zz/2)*(zz/2);
		if(nn>=0)
		{ 
			zsig0 = 1;
			zsig1 = 0;
			ze0 = 1;
			n1 = 0;
		}
		else 
		{
			zsig0 = -zz2;
			zsig1 = 1;
			ze0 = -zz2;
			n1 = 1;
		}
		ze1 = 0;
		amax = fmax(abs1(zsig0),tiny1);
		bmax = fmax(abs1(zsig1),tiny1);
		for(i=1; i<=200; ++i)
		{
			n1 = n1 + 1;
			a0 = nn + n1;
			zb1 = 1;
			zd0 = -ze0*zz2/n1;
			zd1 = -ze1*zz2/n1;
			divis_z(zeps, zd0, zd1, a0, zb1, ze0, ze1);
			zsig0 = zsig0 + ze0;
			zsig1 = zsig1 + ze1;
			a2 = abs1(ze0);
			amax = fmax(a2,amax);
			b2 = abs1(ze1);
			bmax = fmax(b2,bmax);
			if(a2/amax<epsilon1 && b2/bmax<epsilon1) break; 
			if(i>=12)
			{
				info = 35;
				return;
			}
		}
		multi(zeps, Complex(gamma0,0), zgamma1, zsig0, zsig1, za0, za1);

		z2 = pow((zz/2), zeps);
		z3 = z2 - 1;
		zalogzz = log(zz/2);
		if(abs1(z3)<0.5)
		{
			za = 1;
			zss = zeps*zalogzz;
			i5 = (int) round(zss.im/(2*PI));
			zss = Complex(zss.re,zss.im-i5*2*PI);
			zexp1 = 1;
			for(i=2; i<=50; ++i)
			{
				za = za*zss/i;
				zexp1 = zexp1 + za;
				if(abs1(za)<epsilon1) break; 
				if(i==50)
				{
					info = 35;
					return;
				}
			}
			z1 = 0;
			if(i5!=0) z1 = Complex(0,i5*2*PI)/zeps;
			zexp1 = zexp1*(zalogzz-z1);
		}
		else
		{
			zexp1 = z3/zeps;
		}
		if(zalogzz.re*(nn-abs1(zeps))>alog_huge)
		{
			info = 20;
			return;
		}
		zexp0 = pow((zz/2), nn);
		if((exponent(abs1(zz/2))*nn+exponent(abs1(zexp1)))*alog2>alog_huge)
		{
			info = 10;
			zbes10 = 0;
			zbes11 = 0;
			return;
		}
		zexp1 = zexp1*zexp0;
		if(nn==-1 && abs1(zz)<1E-10 && (zeps*log(zz/2)).re<-5)
		{
			zexp = zexp0*z2;
			multi_z(za0, za1, zexp0, zexp1, zexp, zbes10, zbes11);
		}
		else
		{
			multi(zeps, za0, za1, zexp0, zexp1, zbes10, zbes11);
		}
		return;
	}

        void multi(const Complex& zeps, const Complex& zin10, const Complex& zin11, const Complex& zin20, const Complex& zin21, Complex& zout0, Complex& zout1)
	{
		zout0 = zin10*zin20;
		zout1 = zin10*zin21 + zin11*(zin20+zeps*zin21);
		return;
	}

        void multi_z(const Complex& zin10, const Complex& zin11, const Complex& zin20, const Complex& zin21, const Complex& zin22, Complex& zout0, Complex& zout1)
	{
		zout0 = zin10*zin20;
		zout1 = zin10*zin21 + zin11*zin22;
		return;
	}

	void divis(const Complex& zeps, const double& ain1, const Complex& zin1, const double& ain2, const Complex& zin2, double& aout, Complex& zout)
	{
		aout = ain1/ain2;
		zout = (zin1-(ain1/ain2)*zin2)/(ain2+zeps*zin2);
		return;
	}

	void divis_z(const Complex& zeps, const Complex& zin0, const Complex& zin1, const double& aid0, const Complex& zid1, Complex& zout0, Complex& zout1)
	{
		zout0 = zin0/aid0;
		zout1 = (zin1-(zin0/aid0)*zid1)/(aid0+zeps*zid1);
		return;
	}
};

class cylin_inte
{
public:
	Complex znu, zz;

	cylin_inte() { return; }
	cylin_inte(const Complex& znu_t, const Complex& zz_t)
	{
		znu = znu_t;
		zz = zz_t;
		return;
	}

        double abs_re_zgamma, abs_re_zgamma_d, thetaz, phi_lim, a1, pivot, radius, ai_zw0, am_area, tiny2;
        Complex zw0, zw0s, zw0t, zfun0, zfun00, znut, zexd, zgamma0, zinte, zt1, zinte1, zw1, z1, z2, zh, za;
	Cmatrix zam; 
        double radius0, ab_er;
        int i, in, ip, is, j, jj, k, k1, l, mpsn1, mpsn2, nn;
	Ivector ind; 
	Ivector isd; 
	Ivector id;  
	int kft[3][4][3][3]; 

	void exec(Complex& zbes1_t, Complex& zhan1_t, Complex& zhan2_t, Ivector& nfv, int& info)
	{
		radius0 = 0.15;
		ab_er = 0.05;
		zam = Cmatrix(4, 5); 
		ind = Ivector(3); 
		isd = Ivector(4); 
		id = Ivector(4);  

		for(int i0=0; i0<=2; ++i0) 
		{
			for(int i1=0; i1<=3; ++i1)
			{
				for(int i2=0; i2<=2; ++i2)
				{
					for(int i3=0; i3<=2; ++i3)
					{
						kft[i0][i1][i2][i3] = 0;
					}
				}
			}
		}

		zbes1_t = 0;
		zhan1_t = 0;
		zhan2_t = 0;
		thetaz = atan2(zz.im,zz.re);
		znut = znu/zz;
		za = sqrt(CC1-znut)*sqrt(znut+CC1);
		z1 = Complex(-za.im,za.re);
		zgamma0 = log(znut+z1);
		if(zgamma0.re<0) zgamma0 = -zgamma0;
		abs_re_zgamma = fabs(zgamma0.re);
		abs_re_zgamma_d = abs_re_zgamma + 1;
		if(fabs(ai_znu)>ai_znu_m*0.565)
		{
			info = 10;
			return;
		}
		if(PI*fabs(re_znu)>ai_arg_m)
		{
			info = 20;
			return;
		}
		zexd = exp(Complex(0,PI)*znu);
		zam.init(CC0);
		tiny2 = tiny1/sqrt(epsilon1);
		for(jj=1; jj<=2; ++jj)
		{
			integration(zinte, info);
			if(info>1) return;
			zam(jj,4) = zinte; 
			switch(mpsn1)
			{
				case 10:
					if(mpsn2==11)
					{
						kft[jj][2][1][1] = 1;
						kft[jj][2][1][2] = 1;
						kft[jj][3][1][1] = 1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				case 9:
					if(mpsn2==11)
					{
						kft[jj][2][1][1] = 1;
						kft[jj][2][1][2] = 0;
						kft[jj][2][2][1] = 1;
						kft[jj][2][2][2] = 1;
						kft[jj][3][1][1] = 1;
						kft[jj][3][1][2] = 0;
						kft[jj][3][2][1] = 1;
						kft[jj][3][2][2] = -1;
					}
					else if(mpsn2==10)
					{
						kft[jj][2][1][1] = 1;
						kft[jj][3][1][1] = 1;
						kft[jj][3][1][2] = -1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				case 1:
					if(mpsn2==10)
					{
						kft[jj][1][1][1] = -1;
						kft[jj][1][1][2] = 1;
						kft[jj][3][1][1] = -1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				case 0:
					if(mpsn2==11)
					{
						kft[jj][2][1][1] = 1;
						kft[jj][2][1][2] = 1;
					}
					else if(mpsn2==10)
					{
						kft[jj][3][1][1] = -1;
					}
					else if(mpsn2==9)
					{
						kft[jj][2][1][1] = -1;
						kft[jj][3][1][1] = -1;
						kft[jj][3][1][2] = 0;
						kft[jj][3][2][1] = -1;
						kft[jj][3][2][2] = -1;
					}
					else if(mpsn2==1)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = 1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				case -1:
					if(mpsn2==11)
					{
						kft[jj][2][1][1] = 1;
						kft[jj][2][1][2] = 0;
						kft[jj][2][2][1] = 1;
						kft[jj][2][2][2] = 1;
						kft[jj][3][1][1] = 1;
					}
					else if(mpsn2==10)
					{
						kft[jj][2][1][1] = 1;
					}
					else if(mpsn2==9)
					{
						kft[jj][3][1][1] = -1;
						kft[jj][3][1][2] = -1;
					}
					else if(mpsn2==1)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = 0;
						kft[jj][1][2][1] = 1;
						kft[jj][1][2][2] = 1;
					}
					else if(mpsn2==0)
					{
						kft[jj][1][1][1] = 1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				case -2:
					if(mpsn2==11)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = -1;
						kft[jj][2][1][1] = 1;
						kft[jj][2][1][2] = 0;
						kft[jj][2][2][1] = 1;
						kft[jj][2][2][2] = 1;
						kft[jj][3][1][1] = 1;
					}
					else if(mpsn2==10)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = -1;
						kft[jj][2][1][1] = 1;
					}
					else if(mpsn2==0)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = 0;
						kft[jj][1][2][1] = 1;
						kft[jj][1][2][2] = -1;
					}
					else if(mpsn2==-1)
					{
						kft[jj][1][1][1] = 1;
						kft[jj][1][1][2] = -1;
					}
					else
					{
						info = 50;
						return;
					}
					break;
				default: 
					info = 51;
					return;
			} 
		}
		if(znu.im>=0)
		{ 
			nfv.init(5); 
			for(k1=1; k1<=3; ++k1)
			{
				for(jj=1; jj<=2; ++jj)
				{
					nfv(k1) = min(nfv(k1),kft[jj][k1][1][2],kft[jj][k1][2][2]);
				}
			}
		}
		else 
		{
			nfv.init(-5); 
			for(k1=1; k1<=3; ++k1)
			{
				for(jj=1; jj<=2; ++jj)
				{
					nfv(k1) = max(nfv(k1),kft[jj][k1][1][2],kft[jj][k1][2][2]);
				}
			}
		}
		for(k1=1; k1<=3; ++k1)
		{
			for(jj=1; jj<=2; ++jj)
			{
				kft[jj][k1][1][2] = kft[jj][k1][1][2] - nfv(k1);
				kft[jj][k1][2][2] = kft[jj][k1][2][2] - nfv(k1);
			}
		}
		z1 = 0;
		z2 = 0;
		k = 0;
		for(jj=1; jj<=2; ++jj)
		{
			for(k1=1; k1<=3; ++k1)
			{
				if(kft[jj][k1][1][1]!=0)
				{
					if(kft[jj][k1][1][2]>0)
					{
						z1 = pow(zexd, (2*kft[jj][k1][1][2]));
					}
					else if(kft[jj][k1][1][2]==0)
					{
						z1 = 1;
					}
					else
					{
						if((2*kft[jj][k1][1][2])*PI*znu.im>alog_huge)
						{
							info = 10;
							return;
						}
						z1 = pow((1/zexd), (-2*kft[jj][k1][1][2]));
					}
					if(abs1(z1)<tiny2) k = 1;
				}
				if(kft[jj][k1][2][1]!=0)
				{
					if(kft[jj][k1][2][2]>0)
					{
						z2 = pow(zexd, (2*kft[jj][k1][2][2]));
					}
					else if(kft[jj][k1][2][2]==0)
					{
						z2 = 1;
					}
					else
					{
						z2 = pow((1/zexd), (-2*kft[jj][k1][2][2]));
					}
					if(abs1(z2)<tiny2) k = 1;
				}
				if(k==1)
				{
					info = 10;
					return;
				}
				zam(jj,k1) = kft[jj][k1][1][1]*z1 + kft[jj][k1][2][1]*z2;
			}
		}
		zam(3,1) = 1;
		zam(3,2) = -1;
		zam(3,3) = -1;
		zam(3,4) = 0; 
		for(k1=1; k1<=3; ++k1)
		{
			zam(3,k1) = zam(3,k1)*pow(zexd, (-2*nfv(k1)));
		}
		for(int e=0; e<=nfv.nel-1; ++e) nfv(e) *= -2; 
		for(j=1; j<=2; ++j)
		{
			is = 0;
			for(i=1; i<=3; ++i)
			{
				if(abs1(zam(j,i))>=tiny1)
				{
					is = is + 1;
					in = i;
				}
			}
			if(is==0)
			{
				info = 27;
				return;
			}
			isd(j) = is;
			ind(j) = in;
		}
		isd(3) = 3;
		if(isd(1)>=2 && isd(2)==1)
		{
			for(i=1; i<=4; ++i)
			{
				zw1 = zam(1,i);
				zam(1,i) = zam(2,i);
				zam(2,i) = zw1;
			}
			k = isd(1);
			isd(1) = isd(2);
			isd(2) = k;
			k = ind(1);
			ind(1) = ind(2);
			ind(2) = k;
		}
		id(1) = 1; id(2) = 2; id(3) = 3; 
		for(i=1; i<=2; ++i)
		{
			if(isd(i)==1 && ind(i)!=i)
			{
				for(j=1; j<=3; ++j)
				{
					zw1 = zam(j,i);
					zam(j,i) = zam(j,ind(i));
					zam(j,ind(i)) = zw1;
				}
				k = id(i);
				id(i) = id(ind(i));
				id(ind(i)) = k;
				for(k=1; k<=2; ++k)
				{
					if(k==i) goto ct0; 
					if(ind(k)==i)
					{
						ind(k) = ind(i);
						goto ct0; 
					}
					if(ind(k)==ind(i)) ind(k) = i;
ct0:          				;;
				}
				ind(i) = i;
			}
		}

		info = 0;
		for(nn=1; nn<=3; ++nn)
		{
			if(isd(nn)!=1)
			{
				pivot = 0;
				ip = 1;
				for(i=nn; i<=3; ++i)
				{
					a1 = abs1(zam(i,nn));
					if(a1>pivot)
					{
						pivot = a1;
						ip = i;
					}
				}
				if(pivot<=0)
				{
					info = 52;
					return;
				}
				for(j=nn; j<=4; ++j)
				{
					zw1 = zam(nn,j);
					zam(nn,j) = zam(ip,j);
					zam(ip,j) = zw1;
				}
			}
			for(j=nn+1; j<=4; ++j)
			{
				zam(nn,j) = zam(nn,j)/zam(nn,nn);
			}
			for(i=1; i<=3; ++i)
			{
				if(i==nn) goto ct1; 
				for(j=nn+1; j<=4; ++j)
				{
					zam(i,j) = zam(i,j) - zam(i,nn)*zam(nn,j);
				}
ct1:        			;;
			}
		}
		for(i=1; i<=5; ++i)
		{
			l = 0;
			for(j=1; j<=2; ++j)
			{
				if(id(j)>id(j+1))
				{
					l = l + 1;
					zw1 = zam(j,4);
					zam(j,4) = zam(j+1,4);
					zam(j+1,4) = zw1;
					k = id(j);
					id(j) = id(j+1);
					id(j+1) = k;
				}
			}
			if(l==0) break; 
		}
		zbes1_t = zam(1,4)/2;
		zhan1_t = zam(2,4);
		zhan2_t = zam(3,4);
		return;
	}

        void integration(Complex& zinte, int& info)
	{
		Complex za, zgamma;
		double phi0, phi1, phi2, phi_gam, radius_squ, dis1;
		double phi5 = -1.571;
		int i, kk, ll, lin;

		radius_squ = (radius0*2.1)*(radius0*2.1);
		zgamma = zgamma0;
		phi0 = 0;
		if(jj==2)
		{
			zgamma = -zgamma0;
			phi0 = 3;
		}
		zfun00 = zfun(zgamma);
		if(zfun00.re>alog_huge)
		{
			zinte = huge1;
			info = 10;
			return;
		}
		if(zfun00.re<alog_tiny)
		{
			zinte = tiny1;
			info = 10;
			return;
		}
		if(abs1(zfun00)>ai_arg_m)
		{
			info = 20;
			return;
		}

		zw0 = zgamma;
		zfun0 = zfun00;
		phi_lim = 0.785398; 
		ai_zw0 = zw0.im;
		zinte = 0;
		am_area = 0;
		radius = radius0;
		dis1 = 1E5;
		for(i=-1; i<=1; ++i)
		{
			dis1 = min((zgamma+Complex(0,PI*i)).abs(),dis1);
		}
		if(radius0<5*dis1 && dis1<1.1*radius0) radius = dis1/1.1;
		root1(phi0, phi1, info);
		if(info>1) return;
		phi0 = phi1;
		phi_gam = phi1;
		radius = radius0;
		ll = 0;
		lin = 0;
		for(kk=1; kk<=200; ++kk)
		{
			if(ll!=1 && zw0.re<abs_re_zgamma*0.8)
			{
				if(ai_zw0>thetaz+2*PI)
				{
					zt1 = Complex(-abs_re_zgamma_d-radius0,thetaz+3*PI);
					ll = 1;
				}
				else if(ai_zw0<thetaz-2*PI)
				{
					zt1 = Complex(-abs_re_zgamma_d-radius0,thetaz-3*PI);
					ll = 1;
				}
			}
			for(i=-1; i<=1; ++i)
			{
				za = zw0 + zgamma + Complex(0,2*PI*i); 
				if(abs2(za)>radius_squ) goto ct2; 
				root1(phi0+phi5, phi1, info);
				if(info>1) return;
				phi0 = phi1;
				goto gtlbl12;
ct2:	      			;;
			}
			for(i=-1; i<=1; i+=2)
			{
				za = zw0 - zgamma - Complex(0,2*PI*i); 
				if(abs2(za)>radius_squ) goto ct3; 
				root1(phi0+phi5, phi1, info);
				if(info>1) return;
				phi0 = phi1;
				goto gtlbl12;
ct3:	      			;;
			}
			newton(phi0, phi1, info);
			if(info>1) return;
			phi0 = phi1;
gtlbl12:    		;; 
			phi2 = phi0;
			if(ll==1) cal_phi(zw0, phi0, phi2);
			zw0s = zw0;
			zw0 = zw0 + radius0*Complex(cos(phi2),sin(phi2));
			ai_zw0 = zw0.im;
			zfun0 = zfun(zw0);
			zw0t = zw0;
			if(lin==0)
			{
				if((zfun0-zfun00).re<alog_eps1)
				{
					dfzero2(info);
					if(info>1) return;
					lin = 1;
				}
				zdgaus8d(info);
				if(info>1) return;
			}
			if(lin>0)
			{
				phi_lim = 1.4137; 
				mpsn1 = mposition();
				if(mpsn1<12) break; 
			}
			if(kk>150)
			{
				info = 80;
				return;
			}
		}
		zinte1 = zinte;

		phi_lim = 0.785398;
		zw0 = zgamma;
		zfun0 = zfun00;
		ai_zw0 = zw0.im;
		zinte = 0;
		phi0 = phi_gam + PI;
		ll = 0;
		lin = 0;
		for(kk=1; kk<=200; ++kk)
		{
			if(ll!=1 && zw0.re<abs_re_zgamma*0.8)
			{
				if(ai_zw0>thetaz+2*PI)
				{
					zt1 = Complex(-abs_re_zgamma_d-radius0,thetaz+3*PI);
					ll = 1;
				}
				else if(ai_zw0<thetaz-2*PI)
				{
					zt1 = Complex(-abs_re_zgamma_d-radius0,thetaz-3*PI);
					ll = 1;
				}
			}
			for(i=-1; i<=1; ++i)
			{
				za = zw0 + zgamma + Complex(0,2*PI*i);
				if(abs2(za)>radius_squ) goto ct4; 
				root1(phi0+phi5, phi1, info);
				if(info>1) return;
				phi0 = phi1;
				goto gtlbl22;
ct4:	      			;;
			}
			for(i=-1; i<=1; ++i)
			{
				za = zw0 - zgamma - Complex(0,2*PI*i);
				if(abs2(za)>radius_squ) goto ct5; 
				root1(phi0+phi5, phi1, info);
				if(info>1) return;
				phi0 = phi1;
				goto gtlbl22;
ct5:	      			;;
			}
			newton(phi0, phi1, info);
			if(info>1) return;
			phi0 = phi1;
gtlbl22:    		;;
			phi2 = phi0;
			if(ll==1) cal_phi(zw0, phi0, phi2);
			zw0s = zw0;
			zw0 = zw0 + radius0*Complex(cos(phi2),sin(phi2));
			ai_zw0 = zw0.im;
			zfun0 = zfun(zw0);
			zw0t = zw0;
			if(lin==0)
			{
				if((zfun0-zfun00).re<alog_eps1)
				{
					dfzero2(info);
					if(info>1) return;
					lin = 1;
				}
				zdgaus8d(info);
				if(info>1) return;
			}
			if(lin>0)
			{
				phi_lim = 1.4137;
				mpsn2 = mposition();
				if(mpsn2<12) break; 
			}
			if(kk>150)
			{
				info = 80;
				return;
			}
		}
		if(mpsn1==mpsn2)
		{
			info = 88;
			return;
		}
		za = zinte - zinte1;
		zinte = Complex(za.im,-za.re)/PI;
		if(mpsn1>mpsn2)
		{
			i = mpsn2;
			mpsn2 = mpsn1;
			mpsn1 = i;
			zinte = -zinte;
		}
		return;
	}

	int mposition()
	{
		int i, mpt;

		mpt = 15;
		if(zw0.re<-abs_re_zgamma_d)
		{
			for(i=-2; i<=1; ++i)
			{
				if(fabs(ai_zw0-(thetaz+PI+i*2*PI))<PI)
				{
					mpt = i;
					return mpt;
				}
			}
		}
		if(zw0.re>abs_re_zgamma_d)
		{
			for(i=-1; i<=1; ++i)
			{
				if(fabs(ai_zw0-(-thetaz+i*2*PI))<PI)
				{
					mpt = i + 10;
					return mpt;
				}
			}
		}
		if(ai_zw0>thetaz+3*PI)
		{
			mpt = 1;
		}
		else if(ai_zw0<thetaz-3*PI)
		{
			mpt = -2;
		}
		return mpt;
	}

	double abs2(const Complex& za)
	{
		double ab;
		ab = za.re*za.re + za.im*za.im;
		return ab;
	}

	void root1(const double& phi0, double& phi1, int& info)
	{
		double pha, phb, re_fa, re_fb, ai_fa, ai_fb;
		double phc, ai_fc;
		double acbs, acmb, cmb, p, q;
		double ab_er1 = 0.02, ab_er2 = ab_er1*0.3, del_phi = 0.2;
		int i, ic;

		info = 0;
		phi1 = 0;
		pha = phi0;
		phb = pha + del_phi;
		zfun_stand(pha, re_fa, ai_fa);
		zfun_stand(phb, re_fb, ai_fb);
		while(true) 
		{
			if(pha>phi0+2.0001*PI)
			{
				info = 62;
				return;
			}
			if(ai_fa*ai_fb<=0 && (re_fa<=0 || re_fb<=0))
			{
				phi1 = 0;
				phc = phb;
				ai_fc = ai_fb;
				ic = 0;
				acbs = 0.5*fabs(pha-phb);
				for(i=1; i<=500; ++i)
				{
					if(fabs(ai_fb)<fabs(ai_fa))
					{ 
						phc = pha;
						ai_fc = ai_fa;
						pha = phb;
						ai_fa = ai_fb;
						phb = phc;
						ai_fb = ai_fc;
					}
					cmb = 0.5*(phb-pha);
					acmb = fabs(cmb);
					if(acmb<ab_er1 || fabs(ai_fa)<ab_er2)
					{
						info = 0;
						phi1 = pha;
						break; 
					}
					if(i>80)
					{
						info = 63;
						return;
					}
					p = (pha-phc)*ai_fa;
					q = ai_fc - ai_fa;
					if(p<0)
					{
						p = -p;
						q = -q;
					}
					phc = pha;
					ai_fc = ai_fa;
					ic = ic + 1;
					if(ic>=4)
					{
						if(4*acmb>acbs) goto gtlbl8;
						ic = 0;
						acbs = acmb;
					}
					if(p>cmb*q) goto gtlbl8;
					pha = pha + p/q;
					goto gtlbl9; 
gtlbl8:         			;;
					pha = pha + cmb; 
gtlbl9:         			;; 
					zfun_stand(pha, re_fa, ai_fa);
					if(sign(1.0,ai_fa)*sign(1.0,ai_fb)>0)
					{
						phb = phc;
						ai_fb = ai_fc;
					}
				}
				phi1 = mod(phi1,2*PI);
				return;
			}
			pha = phb;
			phb = phb + del_phi;
			re_fa = re_fb;
			ai_fa = ai_fb;
			zfun_stand(phb, re_fb, ai_fb);
		}
		return;
	}

	void zfun_stand(const double& phi, double& re_zfun_st, double& ai_zfun_st)
	{
		Complex zfun_st, zw;

		zw = zw0 + radius*Complex(cos(phi),sin(phi));
		zfun_st = zfun(zw) - zfun0;
		re_zfun_st = zfun_st.re;
		ai_zfun_st = zfun_st.im;
		return;
	}
	
        void dfzero2(int& info)
	{
		double a, ss, c, acbs, acmb, cmb, fa, fss, fc, p, q;
		int i, ic;

		zh = zw0 - zw0s;
		ss = 0;
		c = 1;
		fss = re_zfun2(ss);
		fc = re_zfun2(c);
		a = c;
		fa = fc;
		ic = 0;
		acbs = 0.5*fabs(ss-c);
		for(i=1; i<=500; ++i)
		{
			if(fabs(fc)<fabs(fss))
			{
				a = ss;
				fa = fss;
				ss = c;
				fss = fc;
				c = a;
				fc = fa; 
			}
			cmb = 0.5*(c-ss);
			acmb = fabs(cmb);
			if(fss<=ab_er)
			{
				info = 0;
				zw0t = ss*zh + zw0s;
				return;
			}
			if(i>80)
			{
				info = 80;
				return;
			}
			p = (ss-a)*fss;
			q = fa - fss;
			if(p<0)
			{
				p = -p;
				q = -q;
			}
			a = ss;
			fa = fss;
			ic = ic + 1;
			if(ic>=4)
			{
				if(4*acmb>acbs) goto gtlbl8a;
				ic = 0;
				acbs = acmb;
			}
			if(p>cmb*q) goto gtlbl8a;
			ss = ss + p/q;
			goto gtlbl9a; 
gtlbl8a:		;;
			ss = ss + cmb; 
gtlbl9a:		;;
			fss = re_zfun2(ss); 
			if(sign(1.0,fss)*sign(1.0,fc)>0)
			{
				c = a;
				fc = fa;
			}
		}
	}

	double re_zfun2(const double& dhh)
	{
		double ref2;
		ref2 = (zfun(dhh*zh+zw0s)-zfun00).re - alog_eps1 - ab_er; 
		return ref2;
	}

	void  newton(const double& phi0, double& phi1, int& info)
	{
		Complex zw, zwd;
		double ai_fun, dif, dif_ai_fun, sint, cost, phip, ar, ai, sih, coh, sit, cot;
		double eps1 = 1E-3;
		int i;
		int mm = 8;

		phip = phi0;
		for(i=1; i<=500; ++i)
		{
			sint = sin(phip);
			cost = cos(phip);
			zw = zw0 + radius*Complex(cost,sint);
			ar = zw.re;
			ai = zw.im;
			sih = sinh(ar);
			coh = cosh(ar);
			sit = sin(ai);
			cot = cos(ai);
			ai_fun = (znu*zw-zz*Complex(sih*cot,coh*sit)-zfun0).im;
			zwd = radius*Complex(-sint,cost); 
			dif_ai_fun = ((znu-zz*Complex(coh*cot,sih*sit))*zwd).im;
			dif = ai_fun/dif_ai_fun;
			phip = phip - dif;
			if(fabs(phip)>15)
			{
				phi1 = phip;
				info = 65;
				return;
			}
			if(i>mm)
			{
				phi1 = phip;
				info = 66;
				return;
			}
			if(fabs(dif)<eps1)
			{
				phi1 = phip;
				info = 0;
				return;
			}
		}
	}

	void cal_phi(const Complex& zw0, const double& phi0, double& phi1)
	{
		Complex za, zt12;
		double phi_d, abs_ph;

		zt12 = zt1;
		if((zw0-zt1).re<0) zt12 = zt1 - 3;
		za = zt12 - zw0;
		phi_d = atan2(za.im,za.re) - phi0;
		phi_d = mod(phi_d,2*PI);
		if(phi_d>PI) phi_d = phi_d - 2*PI;
		if(phi_d<-PI) phi_d = phi_d + 2*PI;
		abs_ph = fabs(phi_d);
		phi1 = phi0 + sign(min(abs_ph,phi_lim),phi_d);
		return;
	}

	void zdgaus8d(int& info)
	{
		Complex zgl, zglr, zest, zvr;
		Cvector zaa(21);
		Cvector zhh(21);
		Cvector zgr(21);
		Cvector zvl(21);

		double ef, tol;
		double fct_ef = 2.5;
		int l, l1;
		Ivector lr(21);

		l = 0;
		zhh(l) = (zw0t-zw0s)/4;
		zaa(l) = zw0s;
		lr(l) = 1;
		zg8(zaa(l)+2*zhh(l), 2*zhh(l), zest);
		am_area = fmax(abs1(zest),am_area);
		ef = 1;
		tol = am_area*epsilon1*50;
gtlbl20:	;;
		zg8(zaa(l)+zhh(l), zhh(l), zgl);
		zg8(zaa(l)+3*zhh(l), zhh(l), zgr(l));
		zglr = zgl + zgr(l);
		if(abs1(zest-zglr)>tol*ef)
		{
			l1 = l + 1;
			for(l=l1; l<=20; ++l)
			{
				ef = fct_ef*ef;
				zhh(l) = zhh(l-1)/2; 
				zest = zgl;
				lr(l) = -1;
				zaa(l) = zaa(l-1);
				zg8(zaa(l)+zhh(l), zhh(l), zgl);
				zg8(zaa(l)+3*zhh(l), zhh(l), zgr(l));
				zglr = zgl + zgr(l);
				if(abs1(zest-zglr)>tol*ef) goto ct6; 
				zvl(l) = zglr;
				zest = zgr(l-1);
				lr(l) = 1;
				zaa(l) = zaa(l) + 4*zhh(l);
				zg8(zaa(l)+zhh(l), zhh(l), zgl);
				zg8(zaa(l)+3*zhh(l), zhh(l), zgr(l));
				zglr = zgl + zgr(l);
				if(abs1(zest-zglr)<tol*ef) break; 
				if(l>12) break; 
ct6:				;;
			}
		}
		zvr = zglr;
		l1 = l - 1;
		for(l=l1; l>=0; --l)
		{
			ef = ef/fct_ef;
			if(lr(l)<0)
			{
				zvl(l) = zvl(l+1) + zvr;
				zest = zgr(l-1);
				lr(l) = 1;
				zaa(l) = zaa(l) + 4*zhh(l);
				goto gtlbl20;
			}
			zvr = zvl(l+1) + zvr;
		}
		zinte = zinte + zvr;
		info = 0;
		return;
	}

	void zg8(const Complex& zx, const Complex& zh, Complex& zg8t)
	{
		double x1 = 0.1834346424956498049394761; 
		double w1 = 0.3626837833783619829651504; 
		double x2 = 0.5255324099163289858177390; 
		double w2 = 0.3137066458778872873379622; 
		double x3 = 0.7966664774136267395915539; 
		double w3 = 0.2223810344533744705443560; 
		double x4 = 0.9602898564975362316835609;
		double w4 = 0.1012285362903762591525314;

		zg8t = w1*(exp(zfun(zx-x1*zh))+exp(zfun(zx+x1*zh))) 
                     + w2*(exp(zfun(zx-x2*zh))+exp(zfun(zx+x2*zh))) 
                     + w3*(exp(zfun(zx-x3*zh))+exp(zfun(zx+x3*zh))) 
                     + w4*(exp(zfun(zx-x4*zh))+exp(zfun(zx+x4*zh)));
		zg8t = zg8t*zh;
		return;
	}

	Complex zfun(const Complex& zw)
	{
		double ar = zw.re;
		double ai = zw.im;
		return znu*zw - zz*Complex(sinh(ar)*cos(ai),cosh(ar)*sin(ai));
	}
};

/* externally visible functions */

/* Bessel function J_n, complex order znu, complex argument zz; 
   status code info is set upon return:
    0: normal completion 
   10: unreliable output: potential underflow/overflow, insufficient precision, 
       theoretically indefinite result (e.g. at origin)
   20: output out of range */
Complex bessel_J(const Complex& znu, const Complex& zz, int& info)
{
	Complex zlogbes, zsum, zbes1_t, zhan1_t, zhan2_t, zbes1a, zbes2a, zsum1, zlogbes1, z1, zex;
	double a1;
	int nregion, info1;
	Ivector nfv(4);

	bes1_series b1s;
	bes2_series b2s;
	cylin_inte  cyi;

	Complex zans = CC0; 
	nregion = num_region(znu,zz);
	if(nregion==0)
	{
		info = 20;
		return zans;
	}
	switch(nregion)
	{
		case 1: 
			b1s = bes1_series(znu, zz); b1s.exec(zsum, zlogbes, info); // CALL bes1_series(znu,zz,zsum,zlogbes,info)
			if(info>1) return zans;
			if(zlogbes.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zans = zsum*exp(zlogbes);
			break;
		case 2: 
			if(re_znu>=0)
			{ 
				b1s = bes1_series(znu, zz); b1s.exec(zsum, zlogbes, info); // CALL bes1_series(znu,zz,zsum,zlogbes,info)
				if(info>1) return zans;
				if(zlogbes.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zans = zsum*exp(zlogbes);
				return zans;
			}
			b1s = bes1_series(znua, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znua,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			if(zlogbes1.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zbes1a = zsum1*exp(zlogbes1);
			b2s = bes2_series(znua, zz); b2s.exec(zbes2a, info1); // CALL bes2_series(znua,zz,zbes2a,info1)
			if(info1>11) return zans;
			if(info1==10 && abs1(znu-round(re_znu))<epsilon1*10)
			{
				zans = zbes1a*cos(znupi);
				info = 0;
				return zans;
			}
			if(info1>1)
			{
				info = info1;
				return zans;
			}
			zans = zbes1a*cos(znupi) + zbes2a*sin(znupi);
			break;
		case 3: 
			if(ai_znu<-ai_znu_m)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zex = exp(znupi_i);
			if(re_znu>=0)
			{
				if(re_zz>=0)
				{ 

					cyi = cylin_inte(znu, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info) 
					if(info>1) return zans;
					zans = zbes1_t*pow(zex, nfv(1));
				}
				else 
				{
					cyi = cylin_inte(znu, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					if(ai_zz>=0)
					{
						if(exponent(abs1(zbes1_t))*alog2-ai_znupi*(nfv(1)+1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = zbes1_t*pow(zex, (nfv(1)+1));
					}
					else 
					{
						if(exponent(abs1(zbes1_t))*alog2-ai_znupi*(nfv(1)-1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(ai_znu>ai_znu_m)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = zbes1_t*pow(zex, (nfv(1)-1));
					}
				}
			} 
			else 
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znua, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(ai_znu>=0)
					{
						if(exponent(abs1(zhan1_t)/2)*alog2+fabs(ai_znupi)-ai_znupi*nfv(2)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = zbes1_t*pow(zex, (1+nfv(1))) - pow(zex, nfv(2))*(zex-1/zex)*zhan1_t/2;
					}
					else 
					{
						if(exponent(abs1(zhan2_t)/2)*alog2+fabs(ai_znupi)-ai_znupi*nfv(3)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = zbes1_t*pow(zex, (nfv(1)-1)) + pow(zex, nfv(3))*(zex-1/zex)*zhan2_t/2;
					}
				} 
				else 
				{
					cyi = cylin_inte(znua, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(ai_zz>=0)
					{
						a1 = -ai_znupi*(nfv(3)+2);
						if(exponent(abs1(zhan2_t)/2)*alog2+a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = (zhan1_t*pow(zex, nfv(2))+zhan2_t*pow(zex, (nfv(3)+2)))/2;
					}		
					else 
					{
						a1 = ai_znupi*(2-nfv(2));
						if(exponent(abs1(zhan1_t))*alog2+a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(nfv(2)-2<0)
						{
							z1 = pow((1/zex), (2-nfv(2)));
						}
						else
						{
							z1 = pow(zex, (nfv(2)-2));
						}
						zans = (zhan1_t*z1+zhan2_t*pow(zex, nfv(3)))/2;
					}
				}
			}
	} 
	return zans; 
} 


/* Bessel function Y_n, complex order znu, complex argument zz; 
   status code info is set upon return:
    0: normal completion 
   10: unreliable output: potential underflow/overflow, insufficient precision, 
       theoretically indefinite result (e.g. at origin)
   20: output out of range */
Complex bessel_Y(const Complex& znu, const Complex& zz, int& info)
{
	Complex zarg1, zarg2, zbes1a, zbes2a, zlogbes1, zlogbes2, zpart1, zpart2, zsum1, zsum2, zbes1_t, zhan1_t, zhan2_t, za, zb, zc, zex;
	double a1;
	int nregion;
	Ivector nfv(4);

	bes1_series b1s;
	bes2_series b2s;
	cylin_inte  cyi;

	Complex zans = CC0; 
	nregion = num_region(znu,zz);
	if(nregion==0)
	{
		info = 20;
		return zans;
	}
	switch(nregion)
	{
		case 1: 
			b1s = bes1_series(znu, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znu,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			if(zlogbes1.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			b1s = bes1_series(znua, zz); b1s.exec(zsum2, zlogbes2, info); // CALL bes1_series(znua,zz,zsum2,zlogbes2,info)
			if(info>1) return zans;
			if(ai_znu>=0)
			{ 
				zarg1 = zlogbes1 + 2*znupi_i;
				zarg2 = zlogbes2 + znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				if((fabs(zarg1.im)>ai_arg_m) || (fabs(zlogbes1.im)>ai_arg_m))
				{
					info = 20;
					return zans;
				}
				zpart1 = zsum1*(exp(zarg1)+exp(zlogbes1));
				zpart2 = -2*zsum2*exp(zarg2);
				zex = exp(znupi_i);
				za = (zpart1+zpart2)/(zex*zex-1);
				zans = Complex(-za.im,za.re);
			}
			else 
			{
				zarg1 = zlogbes1 - 2*znupi_i;
				zarg2 = zlogbes2 - znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zpart1 = zsum1*(exp(zlogbes1)+exp(zarg1));
				zpart2 = -2*zsum2*exp(zarg2);
				za = exp(-znupi_i);
				za = (zpart1+zpart2)/(1-za*za);
				zans = Complex(-za.im,za.re);
			}
			break;
		case 2: 
			if(re_znu>=0)
			{
				b2s = bes2_series(znu, zz); b2s.exec(zans, info); // CALL bes2_series(znu,zz,zans,info)
				return zans;
			} 
			b1s = bes1_series(znua, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znua,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			if(zlogbes1.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zbes1a = zsum1*exp(zlogbes1);
			b2s = bes2_series(znua, zz); b2s.exec(zbes2a, info); // CALL bes2_series(znua,zz,zbes2a,info)
			if(info>1) return zans;
			zans = -zbes1a*sin(znupi) + zbes2a*cos(znupi);
			break;
		case 3: 
			if(ai_znu<-ai_znu_m)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zex = exp(znupi_i);
			if(re_znu>=0)
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znu, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					za = (zhan1_t*pow(zex, nfv(2))-zhan2_t*pow(zex, nfv(3)))/2;
					zans = Complex(za.im,-za.re);
				}
				else 
				{
					cyi = cylin_inte(znu, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					if(ai_zz>=0)
					{
						if(exponent(abs1(zbes1_t))*alog2-ai_znupi*(nfv(1)+1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(exponent(abs1(zhan2_t))*alog2-ai_znupi*(nfv(3)-1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(nfv(3)-1>=0)
						{
							zb = pow(zex, (nfv(3)-1));
						}
						else
						{
							if(ai_znu>ai_znu_m)
							{
								info = 10;
								return zans;
							}
							zb = pow(exp(-znupi_i), (1-nfv(3)));
						}
						za = zbes1_t*pow(zex, (nfv(1)+1)) + zhan2_t*zb;
						zans = Complex(-za.im,za.re);
					} 
					else 
					{
						if(exponent(abs1(zbes1_t))*alog2-ai_znupi*(nfv(1)-1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(exponent(abs1(zhan1_t))*alog2-ai_znupi*(nfv(2)+1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(nfv(2)+1>=0)
						{
							zb = pow(zex, (nfv(2)+1));
						}
						else
						{
							if(ai_znu>ai_znu_m)
							{
								info = 10;
								return zans;
							}
							zb = pow(exp(-znupi_i), (-nfv(2)-1));
						}
						if(nfv(1)-1>=0)
						{
							zc = pow(zex, (nfv(1)-1));
						}
						else
						{
							if(ai_znu>ai_znu_m)
							{
								info = 10;
								return zans;
							}
							zc = pow(exp(-znupi_i), (1-nfv(1)));
						}
						za = zbes1_t*zc + zhan1_t*zb;
						zans = Complex(za.im,-za.re);
					}
				}
			}
			else 
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znua, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(exponent(abs1(zhan1_t))*alog2-ai_znupi*(nfv(2)-1)>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					if(exponent(abs1(zhan2_t))*alog2-ai_znupi*(nfv(3)+1)>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					za = zhan1_t*pow(zex, (nfv(2)-1)) - zhan2_t*pow(zex, (nfv(3)+1));
					zans = Complex(za.im,-za.re)/2;
				}
				else 
				{
					cyi = cylin_inte(znua, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(ai_zz>=0)
					{
						a1 = -ai_znupi*(2+nfv(3));
						if(exponent(abs1(zhan2_t)*2)*alog2+a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						za = zhan1_t*pow(zex, nfv(2)) + (zex*zex+2)*zhan2_t*pow(zex, nfv(3));
						zans = Complex(-za.im,za.re)/2;
					} 
					else 
					{
						a1 = ai_znupi*(2-nfv(2));
						if(exponent(abs1(zhan1_t))*alog2+a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						za = (2+(1/zex)*(1/zex))*zhan1_t*pow(zex, nfv(2)) + zhan2_t*pow(zex, nfv(3));
						zans = Complex(za.im,-za.re)/2;
					}
				}
			}
	} 
	return zans; 
}

/* Hankel function H_n^(1), complex order znu, complex argument zz; 
   status code info is set upon return:
    0: normal completion 
   10: unreliable output: potential underflow/overflow, insufficient precision, 
       theoretically indefinite result (e.g. at origin)
   20: output out of range */
Complex hankel_H1(const Complex& znu, const Complex& zz, int& info)
{
	Complex zarg1, zarg2, zlogbes1, zlogbes2, zbes1, zbes2, zbes1_t, zhan1_t, zhan2_t, zpart1, zpart2, zsum1, zsum2, za, z1, zex;
	double a1;
	int nregion;
	Ivector nfv(4);

	bes1_series b1s;
	bes2_series b2s;
	cylin_inte  cyi;

	Complex zans = CC0; 
	nregion = num_region(znu,zz);
	if(nregion==0)
	{
		info = 20;
		return zans;
	}
	switch(nregion)
	{
		case 1: 
			b1s = bes1_series(znu, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znu,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			b1s = bes1_series(znua, zz); b1s.exec(zsum2, zlogbes2, info); // CALL bes1_series(znua,zz,zsum2,zlogbes2,info)
			if(info>1) return zans;
			if(ai_znu>=0)
			{ 
				zarg1 = zlogbes1;
				zarg2 = zlogbes2 + znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zpart1 = -zsum1*exp(zarg1);
				zpart2 = zsum2*exp(zarg2);
				zex = exp(znupi_i);
				zans = 2*(zpart1+zpart2)/(zex*zex-1);
			}
			else 
			{
				zarg1 = zlogbes1 - 2*znupi_i;
				zarg2 = zlogbes2 - znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zpart1 = -zsum1*exp(zarg1);
				zpart2 = zsum2*exp(zarg2);
				za = exp(-znupi_i);
				zans = 2*(zpart1+zpart2)/(1-za*za);
				if(abs1(zans)<tiny1*1E4)
				{
					info = 10;
					return zans;
				}
			}
			break;
		case 2: 
			if(re_znu>=0)
			{ 
				b1s = bes1_series(znu, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znu,zz,zsum1,zlogbes1,info)
				if(info>1) return zans;
				if(zlogbes1.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zbes1 = zsum1*exp(zlogbes1);
				b2s = bes2_series(znu, zz); b2s.exec(zbes2, info); // CALL bes2_series(znu,zz,zbes2,info)
				if(info>1) return zans;
				zans = zbes1 + Complex(-zbes2.im,zbes2.re);
				return zans;
			} 
			b1s = bes1_series(znua, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znua,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			zarg1 = zlogbes1 - znupi_i;
			if(zarg1.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			b2s = bes2_series(znua, zz); b2s.exec(zbes2, info); // CALL bes2_series(znua,zz,zbes2,info)
			if(info>1) return zans;
			zex = exp(znupi_i);
			za = zbes2/zex;
			zans = exp(zarg1)*zsum1 + Complex(-za.im,za.re);
			break;
		case 3: 
			if(ai_znu<-ai_znu_m)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zex = exp(znupi_i);
			if(re_znu>=0)
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znu, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					zans = zhan1_t*pow(zex, nfv(2));
					return zans;
				}
				if(ai_znu>ai_znu_m)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				cyi = cylin_inte(znu, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
				if(info>1) return zans;
				if(ai_zz>=0)
				{
					a1 = exponent(abs1(zhan2_t))*alog2 - ai_znupi*(nfv(3)-1);
					if(a1>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					zans = -zhan2_t*pow(zex, (nfv(3)-1));
				}
				else 
				{
					if(exponent(abs1(zbes1_t)*2)*alog2-ai_znupi*(nfv(1)-1)>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					if(exponent(abs1(zhan1_t))*alog2-ai_znupi*(nfv(2)+1)>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					zans = 2*zbes1_t*pow(zex, (nfv(1)-1)) + zhan1_t*pow(zex, (nfv(2)+1));
				}
			} 
			else 
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znua, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					a1 = exponent(abs1(zhan1_t))*alog2 - ai_znupi*(nfv(2)-1);
					if(a1>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					zans = zhan1_t*pow(zex, (nfv(2)-1));
				}
				else 
				{
					cyi = cylin_inte(znua, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(ai_zz>=0)
					{
						zans = -zhan2_t*pow(zex, nfv(3));
					}
					else 
					{
						a1 = ai_znupi*(2-nfv(2));
						if(exponent(abs1(zhan1_t))*alog2+a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(nfv(2)-2<0)
						{
							z1 = pow((1/zex), (2-nfv(2)));
						}
						else
						{
							z1 = pow(zex, (nfv(2)-2));
						}
						zans = 2*zbes1_t*pow(zex, nfv(1)) + zhan1_t*z1;
					}
				}
			}
	} 
	return zans; 
}


/* Hankel function H_n^(2), complex order znu, complex argument zz; 
   status code info is set upon return:
    0: normal completion 
   10: unreliable output: potential underflow/overflow, insufficient precision, 
       theoretically indefinite result (e.g. at origin)
   20: output out of range */
Complex hankel_H2(const Complex& znu, const Complex& zz, int& info)
{
	Complex zarg1, zarg2, zlogbes1, zlogbes2, zbes1, zbes2, zbes1_t, zhan1_t, zhan2_t, zpart1, zpart2, zsum1, zsum2, za, zb, zex;
	double a1;
	int nregion;
	Ivector nfv(4);

	bes1_series b1s;
	bes2_series b2s;
	cylin_inte  cyi;

	Complex zans = CC0; 
	nregion = num_region(znu,zz);
	if(nregion==0)
	{
		info = 20;
		return zans;
	}
	switch(nregion)
	{
		case 1: 
			b1s = bes1_series(znu, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znu,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			b1s = bes1_series(-znu, zz); b1s.exec(zsum2, zlogbes2, info); // CALL bes1_series(-znu,zz,zsum2,zlogbes2,info)
			if(info>1) return zans;
			if(ai_znu>=0)
			{ 
				zarg1 = zlogbes1 + 2*znupi_i;
				zarg2 = zlogbes2 + znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zpart1 = zsum1*exp(zarg1);
				zpart2 = -zsum2*exp(zarg2);
				zex = exp(znupi_i);
				zans = 2*(zpart1+zpart2)/(zex*zex-1);
				if(abs1(zans)<tiny1*1E4)
				{
					info = 10;
					return zans;
				}
			}
			else 
			{
				zarg1 = zlogbes1;
				zarg2 = zlogbes2 - znupi_i;
				if(zarg1.re>alog_huge || zarg2.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zpart1 = zsum1*exp(zarg1);
				zpart2 = -zsum2*exp(zarg2);
				za = exp(-znupi_i);
				zans = 2*(zpart1+zpart2)/(1-za*za);
			}
			break;
		case 2: 
			if(re_znu>=0)
			{ 
				b1s = bes1_series(znu, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znu,zz,zsum1,zlogbes1,info)
				if(info>1) return zans;
				if(zlogbes1.re>alog_huge)
				{
					zans = huge1;
					info = 10;
					return zans;
				}
				zbes1 = zsum1*exp(zlogbes1);
				b2s = bes2_series(znu, zz); b2s.exec(zbes2, info); // CALL bes2_series(znu,zz,zbes2,info)
				if(info>1) return zans;
				zans = zbes1 + Complex(zbes2.im,-zbes2.re);
				return zans;
			} 
			b1s = bes1_series(znua, zz); b1s.exec(zsum1, zlogbes1, info); // CALL bes1_series(znua,zz,zsum1,zlogbes1,info)
			if(info>1) return zans;
			zarg1 = zlogbes1 + znupi_i;
			if(zarg1.re>alog_huge)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			b2s = bes2_series(znua, zz); b2s.exec(zbes2, info); // CALL bes2_series(znua,zz,zbes2,info)
			if(info>1) return zans;
			zex = exp(znupi_i);
			za = zex*zbes2;
			zans = exp(zarg1)*zsum1 + Complex(za.im,-za.re);
			break;
		case 3: 
			if(ai_znu<-ai_znu_m)
			{
				zans = huge1;
				info = 10;
				return zans;
			}
			zex = exp(znupi_i);
			if(re_znu>=0)
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znu, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					zans = zhan2_t*pow(zex, nfv(3));
				}
				else 
				{
					cyi = cylin_inte(znu, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znu,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					if(ai_zz>=0)
					{
						if(exponent(abs1(2*zbes1_t))*alog2-ai_znupi*(nfv(1)+1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(exponent(abs1(zhan2_t))*alog2-ai_znupi*(nfv(3)-1)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(nfv(3)-1>=0)
						{
							zb = pow(zex, (nfv(3)-1));
						}
						else
						{
							if(ai_znu>ai_znu_m)
							{
								info = 10;
								return zans;
							}
							zb = pow(exp(-znupi_i), (1-nfv(3)));
						}
						zans = 2*zbes1_t*pow(zex, (nfv(1)+1)) + zhan2_t*zb;
					}
					else 
					{
						a1 = exponent(abs1(zhan1_t))*alog2 - ai_znupi;
						if(a1>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = -zhan1_t*pow(zex, (nfv(2)+1));
						if(abs1(zans)<5*tiny1) info = 10;
					}
				}
			}
			else 
			{
				if(re_zz>=0)
				{ 
					cyi = cylin_inte(znua, zz); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zz,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					a1 = exponent(abs1(zhan2_t))*alog2 - ai_znupi*(nfv(3)+1);
					if(a1>alog_huge)
					{
						zans = huge1;
						info = 10;
						return zans;
					}
					zans = zhan2_t*pow(zex, (nfv(3)+1));
					if(abs1(zans)<10*tiny1) info = 10;
				}
				else 
				{
					cyi = cylin_inte(znua, zza); cyi.exec(zbes1_t, zhan1_t, zhan2_t, nfv, info); // CALL cylin_inte(znua,zza,zbes1_t,zhan1_t,zhan2_t,nfv,info)
					if(info>1) return zans;
					for(int e=0; e<=nfv.nel-1; ++e) nfv(e) = -nfv(e); 
					if(ai_zz>=0)
					{
						if(exponent(abs1(zhan2_t))*alog2-ai_znupi*(nfv(3)+2)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						if(-ai_znupi*(nfv(3)+2)>alog_huge)
						{
							zans = huge1;
							info = 10;
							return zans;
						}
						zans = 2*zbes1_t*pow(zex, nfv(1)) + zhan2_t*pow(zex, (nfv(3)+2));
					}
					else 
					{
						zans = -zhan1_t*pow(zex, nfv(2));
					}
				}
			}
	} 
	return zans; 
}

/* 
 * & derivatives of these functions with respect to the argument 
 */

Complex d_bessel_J(const Complex& znu, const Complex& zz, int& info)
{
	int i1, i2;
	Complex d = (bessel_J(znu-1, zz, i1)-bessel_J(znu+1, zz, i2))*0.5;
	info = max(i1, i2);
	return d;
}

Complex d_bessel_Y(const Complex& znu, const Complex& zz, int& info)
{
	int i1, i2;
	Complex d = (bessel_Y(znu-1, zz, i1)-bessel_Y(znu+1, zz, i2))*0.5;
	info = max(i1, i2);
	return d;
}

Complex d_hankel_H1(const Complex& znu, const Complex& zz, int& info)
{
	int i1, i2;
	Complex d = (hankel_H1(znu-1, zz, i1)-hankel_H1(znu+1, zz, i2))*0.5;
	info = max(i1, i2);
	return d;
}

Complex d_hankel_H2(const Complex& znu, const Complex& zz, int& info)
{
	int i1, i2;
	Complex d = (hankel_H2(znu-1, zz, i1)-hankel_H2(znu+1, zz, i2))*0.5;
	info = max(i1, i2);
	return d;
}

/* ---------------------------------------------------------------------- 
                                    %%%
   ---------------------------------------------------------------------- */

/*
 * Computation of complex order Bessel and Hankel functions
 * 
 * Circurs - Circular optical microresonators simulation tools
 * Kirankumar R. Hiremath (k.r.hiremath@ieee.org)
 * University of Twente, Department of Applied Mathematics 
 * P.O. Box 217, 7500AE Enschede, The Netherlands
 * (2005)
 * 
 * - modified -
 */

/*
  KODE = 1 => without scaling
  KODE = 2 => with scaling

  Error codes:
  IERR =  0 => :-) Success
  IERR =  1 => inout error
  IERR =  2 => overflow. no computation. Re(\zeta) too large for KODE = 1
  IERR =  3 => |z| too large. ans may wrong.
  IERR =  4 => |z| too large. no computation.
  IERR =  5 => no computation, algorithm termination condition not met
  IERR = 11 => situation beyond scope of routines
  IERR = 12 => division by zero

  NZ: Underflow indicator. 0: Normal return, 1: underflow

*/

/* zbsubs.f -- translated by f2c (version 20100827).  */

#define abs(x) ((x) >= 0 ? (x) : -(x))
#define dabs(x) (double)abs(x)
#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (double)min(a,b)
#define dmax(a,b) (double)max(a,b)

/* handle error messages */
int seteru_(const char* messg, int nerr, int iopt)
{
	if(iopt >= 1)
	{ 
		fprintf(stderr, "%s [%d] ro: %d\n", messg, nerr, iopt);
		exit(1);
	}
	return 0;
}
int xerror(const char* messg)
{
	fprintf(stderr, "%s\n", messg);
	exit(1);
}

/* -----------------------------------------------------------------
   ----------------------------------------------------------------- */

int pow_ii(int *ap, int *bp)
{
	int pow, x, n;
	unsigned long u;

	x = *ap;
	n = *bp;

	if(n <= 0) {
		if(n == 0 || x == 1)
			return 1;
		if(x != -1)
			return x == 0 ? 1/x : 0;
		n = -n;
		}
	u = n;
	for(pow = 1; ; )
		{
		if(u & 01)
			pow *= x;
		if(u >>= 1)
			x *= x;
		else
			break;
		}
	return(pow);
}

double pow_dd(double *ap, double *bp)
{
	return(pow(*ap, *bp));
}

double d_mod(double *x, double *y)
{
	double quotient;
	if( (quotient = *x / *y) >= 0)
		quotient = floor(quotient);
	else
		quotient = -floor(-quotient);
	return(*x - (*y) * quotient );
}

double d_sign(double *a, double *b)
{
	double x;
	x = (*a >= 0 ? *a : - *a);
	return( *b >= 0 ? x : -x);
}

double r_sign(float *a, float *b)
{
	double x;
	x = (*a >= 0 ? *a : - *a);
	return( *b >= 0 ? x : -x);
}


/* -----------------------------------------------------------------
   ----------------------------------------------------------------- */

/* machcon.f -- translated by f2c (version 20100827).  */

/* Table of constant values */

static int c__0 = 0;
static int c__1 = 1;
static int c__2 = 2;
static int c__3 = 3;
static int c__4 = 4;
static int c__5 = 5;
static int c__6 = 6;
// static int c__7 = 7;
// static int c__8 = 8;
static int c__9 = 9;
static int c__10 = 10;
static int c__11 = 11;
// static int c__12 = 12;
// static int c__13 = 13;
static int c__14 = 14;
static int c__15 = 15;
static int c__16 = 16;
static int c__42 = 42;
static double c_b182 = 2.;
static double c_b183 = 1.;
static double c_b86 = .5;
static double c_b87 = 0.;


/* >>>  MACHCON.FOR:  Machine constants */
int i1mach_(int *i__)
{
	static int rvl[16] = { 5, 6, 0, 0, 32, 4, 2, 31, 2147483647, 2, 24, -125, 127, 53, -1021, 1023 };
	return rvl[*i__-1];
}
/*
int i1mach_(int *i__)
{
    // Initialized data

    static struct {
	int e_1[16];
	} equiv_0 = { 5, 6, 0, 0, 32, 4, 2, 31, 2147483647, 2, 24, -125, 127, 
		53, -1021, 1023 };

    // System generated locals
    int ret_val;

    // Local variables
#define imach ((int *)&equiv_0)
#define output ((int *)&equiv_0 + 3)

    if(*i__ < 1 || *i__ > 16) {
	xerror("I1MACH -- I OUT OF BOUNDS");
    }
    ret_val = imach[*i__ - 1];
    return ret_val;
} // i1mach_ 

#undef output
#undef imach
*/


double r1mach_(int *i__)
{
	static double rvl[5] = { 1.1799999e-38, 3.4e+38, 5.95e-08, 1.19e-07, 0.30103001 };
	return rvl[*i__-1];
}
/*
double r1mach_(int *i__)
{
    // Initialized data 

    static struct {
	int e_1[5];
	int fill_2[1];
	} equiv_4 = { 8420761, 2139081118, 863997169, 872385777, 1050288283 };


    // System generated locals
    float ret_val;

    // Local variables
#define log10 ((int *)&equiv_4 + 4)
#define large ((int *)&equiv_4 + 1)
#define rmach ((float *)&equiv_4)
#define small ((int *)&equiv_4)
#define diver ((int *)&equiv_4 + 3)
#define right ((int *)&equiv_4 + 2)

    if(*i__ < 1 || *i__ > 5) {
	xerror("R1MACH -- I OUT OF BOUNDS");
    }

    ret_val = rmach[*i__ - 1];
    return ret_val;
} // r1mach_ 

#undef right
#undef diver
#undef small
#undef rmach
#undef large
#undef log10
*/


double d1mach_(int *i__)
{
	static double rvl[5] = { 2.23e-308, 1.79e+308, 1.11e-16, 2.22e-16, 0.3010299956639812 };
	return rvl[*i__-1];
}
/*
double d1mach_(int *i__)
{
    // Initialized data

    static struct {
	int e_1[10];
	double fill_2[1];
	double e_3;
	} equiv_4 = { 2002288515, 1050897, 1487780761, 2146426097, 
		-1209488034, 1017118298, -1209488034, 1018166874, 1352628735, 
		1070810131, {0}, 0. };


    // System generated locals
    double ret_val;

    // Local variables
#define log10 ((int *)&equiv_4 + 8)
#define dmach ((double *)&equiv_4)
#define large ((int *)&equiv_4 + 2)
#define small ((int *)&equiv_4)
#define diver ((int *)&equiv_4 + 6)
#define right ((int *)&equiv_4 + 4)

    if(*i__ < 1 || *i__ > 5) {
	xerror("D1MACH -- I OUT OF BOUNDS");
    }

    ret_val = dmach[*i__ - 1];
    return ret_val;

} // d1mach_

#undef right
#undef diver
#undef small
#undef large
#undef dmach
#undef log10
*/

/* -----------------------------------------------------------------
   ----------------------------------------------------------------- */

/* dgamma.f -- translated by f2c (version 20100827).  */
double dgamma_(double *x)
{
/*
fprintf(stderr, "DG: i1mach( 1) = %d\n", i1mach_(&c__1));
fprintf(stderr, "DG: i1mach( 2) = %d\n", i1mach_(&c__2));
fprintf(stderr, "DG: i1mach( 3) = %d\n", i1mach_(&c__3));
fprintf(stderr, "DG: i1mach( 4) = %d\n", i1mach_(&c__4));
fprintf(stderr, "DG: i1mach( 5) = %d\n", i1mach_(&c__5));
fprintf(stderr, "DG: i1mach( 6) = %d\n", i1mach_(&c__6));
fprintf(stderr, "DG: i1mach( 7) = %d\n", i1mach_(&c__7));
fprintf(stderr, "DG: i1mach( 8) = %d\n", i1mach_(&c__8));
fprintf(stderr, "DG: i1mach( 9) = %d\n", i1mach_(&c__9));
fprintf(stderr, "DG: i1mach(10) = %d\n", i1mach_(&c__10));
fprintf(stderr, "DG: i1mach(11) = %d\n", i1mach_(&c__11));
fprintf(stderr, "DG: i1mach(12) = %d\n", i1mach_(&c__12));
fprintf(stderr, "DG: i1mach(13) = %d\n", i1mach_(&c__13));
fprintf(stderr, "DG: i1mach(14) = %d\n", i1mach_(&c__14));
fprintf(stderr, "DG: i1mach(15) = %d\n", i1mach_(&c__15));
fprintf(stderr, "DG: i1mach(16) = %d\n", i1mach_(&c__16));

fprintf(stderr, "DG: r1mach(1) = %.16g\n", r1mach_(&c__1));
fprintf(stderr, "DG: r1mach(2) = %.16g\n", r1mach_(&c__2));
fprintf(stderr, "DG: r1mach(3) = %.16g\n", r1mach_(&c__3));
fprintf(stderr, "DG: r1mach(4) = %.16g\n", r1mach_(&c__4));
fprintf(stderr, "DG: r1mach(5) = %.16g\n", r1mach_(&c__5));

fprintf(stderr, "DG: d1mach(1) = %.16g\n", d1mach_(&c__1));
fprintf(stderr, "DG: d1mach(2) = %.16g\n", d1mach_(&c__2));
fprintf(stderr, "DG: d1mach(3) = %.16g\n", d1mach_(&c__3));
fprintf(stderr, "DG: d1mach(4) = %.16g\n", d1mach_(&c__4));
fprintf(stderr, "DG: d1mach(5) = %.16g\n", d1mach_(&c__5));
*/
    /* Initialized data */

    static double gamcs[42] = { .008571195590989331421920062399942,
	    .004415381324841006757191315771652,
	    .05685043681599363378632664588789,
	    -.004219835396418560501012500186624,
	    .001326808181212460220584006796352,
	    -1.893024529798880432523947023886e-4,
	    3.606925327441245256578082217225e-5,
	    -6.056761904460864218485548290365e-6,
	    1.055829546302283344731823509093e-6,
	    -1.811967365542384048291855891166e-7,
	    3.117724964715322277790254593169e-8,
	    -5.354219639019687140874081024347e-9,
	    9.19327551985958894688778682594e-10,
	    -1.577941280288339761767423273953e-10,
	    2.707980622934954543266540433089e-11,
	    -4.646818653825730144081661058933e-12,
	    7.973350192007419656460767175359e-13,
	    -1.368078209830916025799499172309e-13,
	    2.347319486563800657233471771688e-14,
	    -4.027432614949066932766570534699e-15,
	    6.910051747372100912138336975257e-16,
	    -1.185584500221992907052387126192e-16,
	    2.034148542496373955201026051932e-17,
	    -3.490054341717405849274012949108e-18,
	    5.987993856485305567135051066026e-19,
	    -1.027378057872228074490069778431e-19,
	    1.762702816060529824942759660748e-20,
	    -3.024320653735306260958772112042e-21,
	    5.188914660218397839717833550506e-22,
	    -8.902770842456576692449251601066e-23,
	    1.527474068493342602274596891306e-23,
	    -2.620731256187362900257328332799e-24,
	    4.496464047830538670331046570666e-25,
	    -7.714712731336877911703901525333e-26,
	    1.323635453126044036486572714666e-26,
	    -2.270999412942928816702313813333e-27,
	    3.896418998003991449320816639999e-28,
	    -6.685198115125953327792127999999e-29,
	    1.146998663140024384347613866666e-29,
	    -1.967938586345134677295103999999e-30,
	    3.376448816585338090334890666666e-31,
	    -5.793070335782135784625493333333e-32 };
    static double pi = 3.1415926535897932384626433832795;
    static double sq2pil = .91893853320467274178032973640562;
    static int ngam = 0;
    static double xmin = 0.;
    static double xmax = 0.;
    static double xsml = 0.;
    static double dxrel = 0.;

    /* System generated locals */
    int i__1;
    float r__1;
    double ret_val, d__1, d__2, d__3, d__4, d__5;

    /* Local variables */
    static int i__, n;
    static double y;
    extern double dlog_(double *), dsin_(double *), dint_(
	    double *), dexp_(double *), d1mach_(int *), dsqrt_(
	    double *);
    extern /* Subroutine */ int d9gaml_(double *, double *);
    extern double d9lgmc_(double *), dcsevl_(double *, double 
	    *, int *);
    extern int initds_(double *, int *, float *);
    static double sinpiy;

/* jan 1984 edition.  w. fullerton, c3, los alamos scientific lab. */
/* jan 1994 wpp@ips.id.ethz.ch, ehg@research.att.com   declare xsml */

/* series for gam        on the interval  0.          to  1.00000e+00 */
/*                                        with weighted error   5.79e-32 */
/*                                         log weighted error  31.24 */
/*                               significant figures required  30.00 */
/*                                    decimal places required  32.05 */

/* sq2pil is 0.5*alog(2*pi) = alog(sqrt(2*pi)) */

    if(ngam != 0) {
	goto L10;
    }
    r__1 = (float) d1mach_(&c__3) * .1f;
    ngam = initds_(gamcs, &c__42, &r__1);

    d9gaml_(&xmin, &xmax);
/* Computing MAX */
    d__4 = d1mach_(&c__1);
    d__5 = d1mach_(&c__2);
    d__2 = dlog_(&d__4), d__3 = -dlog_(&d__5);
    d__1 = max(d__2,d__3) + .01;
    xsml = dexp_(&d__1);
    d__1 = d1mach_(&c__4);
    dxrel = dsqrt_(&d__1);

L10:
    y = abs(*x);
    if(y > 10.) {
	goto L50;
    }

/* compute gamma(x) for -xbnd .le. x .le. xbnd.  reduce interval and find */
/* gamma(1+y) for 0.0 .le. y .lt. 1.0 first of all. */

    n = (int) (*x);
    if(*x < 0.) {
	--n;
    }
    y = *x - (double) ((float) n);
    --n;
    d__1 = y * 2. - 1.;
    ret_val = dcsevl_(&d__1, gamcs, &ngam) + .9375;
    if(n == 0) {
	return ret_val;
    }

    if(n > 0) {
	goto L30;
    }

/* compute gamma(x) for x .lt. 1.0 */

    n = -n;
    if(*x == 0.) {
	seteru_("dgamma: x is 0", 4, 2);
    }
    if(*x < 0. && *x + (double) ((float) (n - 2)) == 0.) {
	seteru_("dgamma: x is a negative int", 4, 2);
    }
    d__2 = *x - .5;
    if(*x < -.5 && (d__1 = (*x - dint_(&d__2)) / *x, abs(d__1)) < dxrel) {
	seteru_("dgamma: answer lt half precision because x too near negative int", 1, 1);
    }
    if(y < xsml) {
	seteru_("dgamma: x is so close to 0.0 that the result overflows", 5, 2);
    }

    i__1 = n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ret_val /= *x + (double) ((float) (i__ - 1));
/* L20: */
    }
    return ret_val;

/* gamma(x) for x .ge. 2.0 and x .le. 10.0 */

L30:
    i__1 = n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ret_val = (y + (double) ((float) i__)) * ret_val;
/* L40: */
    }
    return ret_val;

/* gamma(x) for dabs(x) .gt. 10.0.  recall y = dabs(x). */

L50:
    if(*x > xmax) {
	seteru_("dgamma  x so big gamma overflows", 3, 2);
    }

    ret_val = 0.;
    if(*x < xmin) {
	seteru_("dgamma  x so small gamma underflows", 2, 0);
    }
    if(*x < xmin) {
	return ret_val;
    }

    d__1 = (y - .5) * dlog_(&y) - y + sq2pil + d9lgmc_(&y);
    ret_val = dexp_(&d__1);
    if(*x > 0.) {
	return ret_val;
    }

    d__2 = *x - .5;
    if((d__1 = (*x - dint_(&d__2)) / *x, abs(d__1)) < dxrel) {
	seteru_("dgamma  answer lt half precision, x too near negative int", 1, 1);
    }

    d__1 = pi * y;
    sinpiy = dsin_(&d__1);
    if(sinpiy == 0.) {
	seteru_("dgamma  x is a negative int", 4, 2);
    }

    ret_val = -pi / (y * sinpiy * ret_val);

    return ret_val;
} /* dgamma_ */

/* ==================================================================== */
int initds_(double *dos, int *nos, float *eta)
{
    /* System generated locals */
    int ret_val, i__1;
    float r__1;

    /* Local variables */
    static int i__, ii;
    static float err;

/* june 1977 edition.   w. fullerton, c3, los alamos scientific lab. */

/* initialize the double precision orthogonal series dos so that initds */
/* is the number of terms needed to insure the error is no larger than */
/* eta.  ordinarily eta will be chosen to be one-tenth machine precision. */

/*             input arguments -- */
/* dos    dble prec array of nos coefficients in an orthogonal series. */
/* nos    number of coefficients in dos. */
/* eta    requested accuracy of series. */


    /* Parameter adjustments */
    --dos;

    /* Function Body */
    if(*nos < 1) {
	seteru_("initds  number of coefficients lt 1", 2, 2);
    }

    err = 0.f;
    i__1 = *nos;
    for (ii = 1; ii <= i__1; ++ii) {
	i__ = *nos + 1 - ii;
	err += (r__1 = (float) dos[i__], dabs(r__1));
	if(err > *eta) {
	    goto L20;
	}
/* L10: */
    }

L20:
    if(i__ == *nos) {
	seteru_("initds  eta may be too small", 1, 2);
    }
    ret_val = i__;

    return ret_val;
} /* initds_ */


/* =========================================================== */
/* Subroutine */ int d9gaml_(double *xmin, double *xmax)
{
    /* System generated locals */
    double d__1, d__2;

    /* Local variables */
    static int i__;
    static double xln;
    extern double dlog_(double *);
    static double xold;
    extern double d1mach_(int *);
    static double alnbig, alnsml;

/* june 1977 edition.   w. fullerton, c3, los alamos scientific lab. */

/* calculate the minimum and maximum legal bounds for x in gamma(x). */
/* xmin and xmax are not the only bounds, but they are the only non- */
/* trivial ones to calculate. */

/*             output arguments -- */
/* xmin   dble prec minimum legal value of x in gamma(x).  any smaller */
/*        value of x might result in underflow. */
/* xmax   dble prec maximum legal value of x in gamma(x).  any larger */
/*        value of x might cause overflow. */


    d__1 = d1mach_(&c__1);
    alnsml = dlog_(&d__1);
    *xmin = -alnsml;
    for (i__ = 1; i__ <= 10; ++i__) {
	xold = *xmin;
	xln = dlog_(xmin);
	*xmin -= *xmin * ((*xmin + .5) * xln - *xmin - .2258 + alnsml) / (*
		xmin * xln + .5);
	if((d__1 = *xmin - xold, abs(d__1)) < .005) {
	    goto L20;
	}
/* L10: */
    }
    seteru_("d9gaml  unable to find xmin", 1, 2);

L20:
    *xmin = -(*xmin) + .01;

    d__1 = d1mach_(&c__2);
    alnbig = dlog_(&d__1);
    *xmax = alnbig;
    for (i__ = 1; i__ <= 10; ++i__) {
	xold = *xmax;
	xln = dlog_(xmax);
	*xmax -= *xmax * ((*xmax - .5) * xln - *xmax + .9189 - alnbig) / (*
		xmax * xln - .5);
	if((d__1 = *xmax - xold, abs(d__1)) < .005) {
	    goto L40;
	}
/* L30: */
    }
    seteru_("d9gaml  unable to find xmax", 2, 2);

L40:
    *xmax += -.01;
/* Computing MAX */
    d__1 = *xmin, d__2 = -(*xmax) + 1.;
    *xmin = max(d__1,d__2);

    return 0;
} /* d9gaml_ */

/* ================================================================== */
double dlog_(double *x)
{
    /* Initialized data */

    static double alncs[11] = { 1.3347199877973881561689386047187,
	    6.9375628328411286281372438354225e-4,
	    4.2934039020450834506559210803662e-7,
	    2.8933847795432594580466440387587e-10,
	    2.0512517530340580901741813447726e-13,
	    1.5039717055497386574615153319999e-16,
	    1.1294540695636464284521613333333e-19,
	    8.6355788671171868881946666666666e-23,
	    6.6952990534350370613333333333333e-26,
	    5.2491557448151466666666666666666e-29,
	    4.1530540680362666666666666666666e-32 };
    static double center[4] = { 1.,1.25,1.5,1.75 };
    static double alncen[5] = { 0.,.22314355131420975576629509030983,
	    .40546510810816438197801311546434,
	    .55961578793542268627088850052682,
	    .69314718055994530941723212145817 };
    static double aln2 = .06814718055994530941723212145818;
    static int nterms = 0;

    /* System generated locals */
    float r__1;
    double ret_val, d__1;

    /* Local variables */
    static int n;
    static double t, y, t2, xn;
    extern double d1mach_(int *);
    extern /* Subroutine */ int d9upak_(double *, double *, int *)
	    ;
    extern double dcsevl_(double *, double *, int *);
    extern int initds_(double *, int *, float *);
    static int ntrval;

/* june 1977 edition.   w. fullerton, c3, los alamos scientific lab. */

/* series for aln        on the interval  0.          to  3.46021e-03 */
/*                                        with weighted error   4.15e-32 */
/*                                         log weighted error  31.38 */
/*                               significant figures required  31.21 */
/*                                    decimal places required  31.90 */




/* aln2 = alog(2.0) - 0.625 */

    if(nterms == 0) {
	r__1 = 28.9f * (float) d1mach_(&c__3);
	nterms = initds_(alncs, &c__11, &r__1);
    }

    if(*x <= 0.) {
	seteru_("dlog    x is zero or negative", 1, 2);
    }

    d9upak_(x, &y, &n);

    xn = (double) (n - 1);
    y *= 2.;
    ntrval = (int) (y * 4. - 2.5);

    if(ntrval == 5) {
	t = (y - 1. - 1.) / (y + 2.);
    }
    if(ntrval < 5) {
	t = (y - center[ntrval - 1]) / (y + center[ntrval - 1]);
    }
    t2 = t * t;
    d__1 = t2 * 578. - 1.;
    ret_val = xn * .625 + (aln2 * xn + alncen[ntrval - 1] + t * 2. + t * t2 * 
	    dcsevl_(&d__1, alncs, &nterms));

    return ret_val;
} /* dlog_ */

/* ====================================================================== */
double dexp_(double *x)
{
    /* Initialized data */

    static double expcs[14] = { .0866569493314985712733404647266231,
	    9.38494869299839561896336579701203e-4,
	    6.77603970998168264074353014653601e-6,
	    3.6693120039380592780189125068761e-8,
	    1.58959053617461844641928517821508e-10,
	    5.73859878630206601252990815262106e-13,
	    1.77574448591421511802306980226e-15,
	    4.80799166842372422675950244533333e-18,
	    1.1571637688182857280926e-20,
	    2.50650610255497719932458666666666e-23,4.9357170814049582848e-26,
	    8.9092957274063424e-29,1.48448062907997866666666666666666e-31,
	    2.29678916630186666666666666666666e-34 };
    static double twon16[17] = { 0.,.044273782427413840321966478739929,
	    .090507732665257659207010655760707,
	    .13878863475669165370383028384151,
	    .18920711500272106671749997056047,
	    .24185781207348404859367746872659,
	    .29683955465100966593375411779245,
	    .3542555469368927282980147401407,
	    .41421356237309504880168872420969,
	    .47682614593949931138690748037404,
	    .54221082540794082361229186209073,
	    .6104903319492543081795206673574,
	    .68179283050742908606225095246642,
	    .75625216037329948311216061937531,
	    .83400808640934246348708318958828,
	    .91520656139714729387261127029583,1. };
    static double aln216 = .083120654223414517758794896030274;
    static int nterms = 0;
    static double xmin = 0.;
    static double xmax = 0.;

    /* System generated locals */
    float r__1;
    double ret_val, d__1;

    /* Local variables */
    static double f;
    static int n;
    static double y;
    static int n16, ndx;
    extern double dlog_(double *), dint_(double *);
    static double xint;
    extern double d9pak_(double *, int *), d1mach_(int *), 
	    dcsevl_(double *, double *, int *);
    extern int initds_(double *, int *, float *);

/* may 1980 edition.   w. fullerton, c3, los alamos scientific lab. */

/* series for exp        on the interval -1.00000e+00 to  1.00000e+00 */
/*                                        with weighted error   2.30e-34 */
/*                                         log weighted error  33.64 */
/*                               significant figures required  32.28 */
/*                                    decimal places required  34.21 */


/* twon16(i) is 2.0**((i-1)/16) - 1.0 */

/* aln216 is 16.0/alog(2.) - 23.0 */

    if(nterms != 0) {
	goto L10;
    }
    r__1 = (float) d1mach_(&c__3) * .1f;
    nterms = initds_(expcs, &c__14, &r__1);
    d__1 = d1mach_(&c__1);
    xmin = dlog_(&d__1) + .01;
    d__1 = d1mach_(&c__2);
    xmax = dlog_(&d__1) - .001;

L10:
    if(*x < xmin) {
	goto L20;
    }
    if(*x > xmax) {
	seteru_("dexp    x so big dexp overflows", 2, 2);
    }

    xint = dint_(x);
    y = *x - xint;

    y = y * 23. + *x * aln216;
    n = (int) y;
    f = y - (double) ((float) n);
    n = (int) (xint * 23. + (double) ((float) n));
    n16 = n / 16;
    if(n < 0) {
	--n16;
    }
    ndx = n - (n16 << 4) + 1;

    ret_val = twon16[ndx - 1] + f * (twon16[ndx - 1] + 1.) * dcsevl_(&f, 
	    expcs, &nterms) + 1.;

    ret_val = d9pak_(&ret_val, &n16);
    return ret_val;

L20:
    seteru_("dexp    x so small dexp underflows", 1, 0);
    ret_val = 0.;
    return ret_val;

} /* dexp_ */

/* ============================================================ */
double dsqrt_(double *x)
{
    /* Initialized data */

    static double sqrt2[3] = { .70710678118654752440084436210485,1.,
	    1.4142135623730950488016887242097 };
    static int niter = 0;

    /* System generated locals */
    int i__1;
    float r__1, r__2;
    double ret_val, d__1;

    /* Local variables */
    static int n;
    static double y;
    static float z__;
    extern double alog_(float *);
    static int irem, iter;
    extern double d9pak_(double *, int *), d1mach_(int *);
    static int ixpnt;
    extern /* Subroutine */ int d9upak_(double *, double *, int *);

/* june 1977 edition.   w. fullerton, c3, los alamos scientific lab. */


    if(niter == 0) {
	r__2 = .1f * (float) d1mach_(&c__3);
	r__1 = -.104f * alog_(&r__2);
	niter = 1.443f * alog_(&r__1) + 1.f;
    }

    if(*x <= 0.) {
	goto L20;
    }

    d9upak_(x, &y, &n);
    ixpnt = n / 2;
    irem = n - (ixpnt << 1) + 2;

/* the approximation below has accuracy of 4.16 digits. */
    z__ = y;
    ret_val = z__ * (z__ * (z__ * .141067f - .516888f) + 1.114292f) + 
	    .261599f;

    i__1 = niter;
    for (iter = 1; iter <= i__1; ++iter) {
	ret_val += (y - ret_val * ret_val) * .5 / ret_val;
/* L10: */
    }

    d__1 = sqrt2[irem - 1] * ret_val;
    ret_val = d9pak_(&d__1, &ixpnt);
    return ret_val;

L20:
    if(*x < 0.) {
	seteru_("dsqrt   x is negative", 1, 1);
    }
    ret_val = 0.;
    return ret_val;

} /* dsqrt_ */

/* ======================================================== */
double dint_(double *x)
{
    /* Initialized data */

    static int npart = 0;
    static double scale = 0.;
    static double xbig = 0.;
    static double xmax = 0.;

    /* System generated locals */
    int i__1;
    float r__1, r__2;
    double ret_val, d__1;

    /* Local variables */
    static int i__;
    extern double dlog_(double *);
    static double part, xscl;
    static int ibase, ipart;
    extern double d1mach_(int *);
    extern int i1mach_(int *);
    extern double r1mach_(int *);

/* december 1983 edition. w. fullerton, c3, los alamos scientific lab. */

/* dint is the double precision equivalent of aint.  this portable */
/* version is quite efficient when the argument is reasonably small (a */
/* common case), and so no faster machine-dependent version is needed. */


    if(npart != 0) {
	goto L10;
    }
    ibase = i1mach_(&c__10);
    xmax = 1. / d1mach_(&c__4);
/* Computing MIN */
    r__1 = (float) i1mach_(&c__9), r__2 = 1.f / r1mach_(&c__4);
    xbig = dmin(r__1,r__2);
    d__1 = (double) ((float) ibase);
    i__1 = (int) (dlog_(&xbig) / dlog_(&d__1) - .5);
    scale = (double) pow_ii(&ibase, &i__1);
    npart = (int) (dlog_(&xmax) / dlog_(&scale) + 1.);

L10:
    if(*x < -xbig || *x > xbig) {
	goto L20;
    }

    ret_val = (double) ((int) ((float) (*x)));
    return ret_val;

L20:
    xscl = abs(*x);
    if(xscl > xmax) {
	goto L50;
    }

    i__1 = npart;
    for (i__ = 1; i__ <= i__1; ++i__) {
	xscl /= scale;
/* L30: */
    }

    ret_val = 0.;
    i__1 = npart;
    for (i__ = 1; i__ <= i__1; ++i__) {
	xscl *= scale;
	ipart = (int) xscl;
	part = (double) ipart;
	xscl -= part;
	ret_val = ret_val * scale + part;
/* L40: */
    }

    if(*x < 0.) {
	ret_val = -ret_val;
    }
    return ret_val;

L50:
    seteru_("dint    dabs(x) may be too big to be represented as an exact int", 1, 1);
    ret_val = *x;
    return ret_val;

} /* dint_ */

/* ============================================================= */
double dsin_(double *x)
{
    /* Initialized data */

    static double sincs[15] = { -.374991154955873175839919279977323464,
	    -.181603155237250201863830316158004754,
	    .005804709274598633559427341722857921,
	    -8.6954311779340757113212316353178e-5,
	    7.5437014808885148100683992703e-7,
	    -4.267129665055961107126829906e-9,1.6980422945488168181824792e-11,
	    -5.0120578889961870929524e-14,1.14101026680010675628e-16,
	    -2.06437504424783134e-19,3.03969595918706e-22,-3.71357734157e-25,
	    3.82486123e-28,-3.36623e-31,2.56e-34 };
    static double pihi = 3.140625;
    static double pilo = 9.6765358979323846264338327950288e-4;
    static double pirec = .31830988618379067153776752674503;
    static double pi2rec = .63661977236758134307553505349006;
    static int ntsn = 0;
    static double xsml = 0.;
    static double xwarn = 0.;
    static double xmax = 0.;

    /* System generated locals */
    float r__1;
    double ret_val, d__1, d__2;

    /* Local variables */
    static double f, y;
    static int n2;
    static double xn, sgn;
    extern double dint_(double *), d1mach_(int *), dsqrt_(
	    double *), dcsevl_(double *, double *, int *);
    extern int initds_(double *, int *, float *);

/* august 1980 edition.  w. fullerton, los alamos scientific lab. */

/* this routine is based on the algorithm of cody and waite in */
/* argonne tm-321, software manual working note number 1 */


/* series for sin    on the interval  0.00000e+00 to  2.46740e+00 */
/*                                        with weighted error   2.56e-34 */
/*                                         log weighted error  33.59 */
/*                               significant figures required  33.01 */
/*                                    decimal places required  34.18 */


/* pihi + pilo = pi.  pihi is exactly representable on all machines */
/* with at least 8 bits of precision.  whether it is exactly */
/* represented depends on the compiler.  this routine is more */
/* accurate if it is exactly represented. */

    if(ntsn != 0) {
	goto L10;
    }
    r__1 = (float) d1mach_(&c__3) * .1f;
    ntsn = initds_(sincs, &c__15, &r__1);

    d__1 = d1mach_(&c__3) * 2.;
    xsml = dsqrt_(&d__1);
    xmax = 1. / d1mach_(&c__4);
    xwarn = dsqrt_(&xmax);

L10:
    y = abs(*x);
    if(y > xmax) {
	seteru_("dsin    no precision because abs(x) is big", 2, 2);
    }
    if(y > xwarn) {
	seteru_("dsin    answer lt half precision because abs(x) is big", 1, 1);
    }

    ret_val = *x;
    if(y < xsml) {
	return ret_val;
    }

    d__1 = y * pirec + .5;
    xn = dint_(&d__1);
    n2 = (int) (d_mod(&xn, &c_b182) + .5);
    sgn = *x;
    if(n2 != 0) {
	sgn = -sgn;
    }
    f = y - xn * pihi - xn * pilo;

/* Computing 2nd power */
    d__2 = f * pi2rec;
    d__1 = d__2 * d__2 * 2. - 1.;
    ret_val = f + f * dcsevl_(&d__1, sincs, &ntsn);
    if(sgn < 0.) {
	ret_val = -ret_val;
    }
    if(abs(ret_val) > 1.) {
	ret_val = d_sign(&c_b183, &ret_val);
    }

    return ret_val;
} /* dsin_ */

/* ==================================================================== */
double dcsevl_(double *x, double *a, int *n)
{
    /* System generated locals */
    int i__1;
    double ret_val;

    /* Local variables */
    static int i__;
    static double b0, b1, b2;
    static int ni;
    static double twox;


/* evaluate the n-term chebyshev series a at x.  adapted from */
/* r. broucke, algorithm 446, c.a.c.m., 16, 254 (1973). */

/*             input arguments -- */
/* x      dble prec value at which the series is to be evaluated. */
/* a      dble prec array of n terms of a chebyshev series.  in eval- */
/*        uating a, only half the first coef is summed. */
/* n      number of terms in array a. */


    /* Parameter adjustments */
    --a;

    /* Function Body */
    if(*n < 1) {
	seteru_("dcsevl  number of terms le 0", 2, 2);
    }
    if(*n > 1000) {
	seteru_("dcsevl  number of terms gt 1000", 3, 2);
    }
    if(*x < -1.1 || *x > 1.1) {
	seteru_("dcsevl  x outside (-1,+1)", 1, 1);
    }

    twox = *x * 2.;
    b1 = 0.;
    b0 = 0.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	b2 = b1;
	b1 = b0;
	ni = *n - i__ + 1;
	b0 = twox * b1 - b2 + a[ni];
/* L10: */
    }

    ret_val = (b0 - b2) * .5;

    return ret_val;
} /* dcsevl_ */

/* ============================================================= */
/* Subroutine */ int d9upak_(double *x, double *y, int *n)
{
    /* Local variables */
    static double absx;

/* august 1980 portable edition.  w. fullerton, los alamos scientific lab */

/* unpack floating point number x so that x = y * 2.0**n, where */
/* 0.5 .le. abs(y) .lt. 1.0 . */


    absx = abs(*x);
    *n = 0;
    *y = 0.;
    if(*x == 0.) {
	return 0;
    }

L10:
    if(absx >= .5) {
	goto L20;
    }
    --(*n);
    absx *= 2.;
    goto L10;

L20:
    if(absx < 1.) {
	goto L30;
    }
    ++(*n);
    absx *= .5;
    goto L20;

L30:
    *y = d_sign(&absx, x);
    return 0;

} /* d9upak_ */

/* ============================================================ */
double d9lgmc_(double *x)
{
    /* Initialized data */

    static double algmcs[15] = { .1666389480451863247205729650822,
	    -1.384948176067563840732986059135e-5,
	    9.810825646924729426157171547487e-9,
	    -1.809129475572494194263306266719e-11,
	    6.221098041892605227126015543416e-14,
	    -3.399615005417721944303330599666e-16,
	    2.683181998482698748957538846666e-18,
	    -2.868042435334643284144622399999e-20,
	    3.962837061046434803679306666666e-22,
	    -6.831888753985766870111999999999e-24,
	    1.429227355942498147573333333333e-25,
	    -3.547598158101070547199999999999e-27,1.025680058010470912e-28,
	    -3.401102254316748799999999999999e-30,
	    1.276642195630062933333333333333e-31 };
    static int nalgm = 0;
    static double xbig = 0.;
    static double xmax = 0.;

    /* System generated locals */
    float r__1;
    double ret_val, d__1, d__2, d__3, d__4, d__5;

    /* Local variables */
    extern double dlog_(double *), dexp_(double *), d1mach_(
	    int *), dsqrt_(double *), dcsevl_(double *, 
	    double *, int *);
    extern int initds_(double *, int *, float *);

/* august 1977 edition.  w. fullerton, c3, los alamos scientific lab. */

/* compute the log gamma correction factor for x .ge. 10. so that */
/* dlog (dgamma(x)) = dlog(dsqrt(2*pi)) + (x-.5)*dlog(x) - x + d9lgmc(x) */


/* series for algm       on the interval  0.          to  1.00000e-02 */
/*                                        with weighted error   1.28e-31 */
/*                                         log weighted error  30.89 */
/*                               significant figures required  29.81 */
/*                                    decimal places required  31.48 */



    if(nalgm != 0) {
	goto L10;
    }
    r__1 = (float) d1mach_(&c__3);
    nalgm = initds_(algmcs, &c__15, &r__1);
    d__1 = d1mach_(&c__3);
    xbig = 1. / dsqrt_(&d__1);
/* Computing MIN */
    d__4 = d1mach_(&c__2) / 12.;
    d__5 = d1mach_(&c__1) * 12.;
    d__2 = dlog_(&d__4), d__3 = -dlog_(&d__5);
    d__1 = min(d__2,d__3);
    xmax = dexp_(&d__1);

L10:
    if(*x < 10.) {
	seteru_("d9lgmc  x must be ge 10", 1, 2);
    }
    if(*x >= xmax) {
	goto L20;
    }

    ret_val = 1. / (*x * 12.);
    if(*x < xbig) {
/* Computing 2nd power */
	d__2 = 10. / *x;
	d__1 = d__2 * d__2 * 2. - 1.;
	ret_val = dcsevl_(&d__1, algmcs, &nalgm) / *x;
    }
    return ret_val;

L20:
    ret_val = 0.;
    seteru_("d9lgmc  x so big d9lgmc underflows", 2, 0);
    return ret_val;

} /* d9lgmc_ */

/* ==================================================================== */
double d9pak_(double *y, int *n)
{
    /* Initialized data */

    static int nmin = 0;
    static int nmax = 0;
    static double aln210 = 3.321928094887362347870319429489;

    /* System generated locals */
    double ret_val;

    /* Local variables */
    static int ny, nsum;
    static double aln2b;
    extern double d1mach_(int *);
    extern int i1mach_(int *);
    extern /* Subroutine */ int d9upak_(double *, double *, int *);

/* december 1979 edition. w. fullerton, c3, los alamos scientific lab. */

/* pack a base 2 exponent into floating point number x.  this routine is */
/* almost the inverse of d9upak.  it is not exactly the inverse, because */
/* dabs(x) need not be between 0.5 and 1.0.  if both d9pak and 2.d0**n */
/* were known to be in range we could compute */
/*                d9pak = x * 2.0d0**n */


    if(nmin != 0) {
	goto L10;
    }
    aln2b = 1.;
    if(i1mach_(&c__10) != 2) {
	aln2b = d1mach_(&c__5) * aln210;
    }
    nmin = (int) (aln2b * (double) ((float) i1mach_(&c__15)));
    nmax = (int) (aln2b * (double) ((float) i1mach_(&c__16)));

L10:
    d9upak_(y, &ret_val, &ny);

    nsum = *n + ny;
    if(nsum < nmin) {
	goto L40;
    }
    if(nsum > nmax) {
	seteru_("d9pak   packed number overflows", 1, 2);
    }

    if(nsum == 0) {
	return ret_val;
    }
    if(nsum > 0) {
	goto L30;
    }

L20:
    ret_val *= .5;
    ++nsum;
    if(nsum != 0) {
	goto L20;
    }
    return ret_val;

L30:
    ret_val *= 2.;
    --nsum;
    if(nsum != 0) {
	goto L30;
    }
    return ret_val;

L40:
    seteru_("d9pak   packed number underflows", 1, 0);
    ret_val = 0.;
    return ret_val;

} /* d9pak_ */

/* ================================================================ */
double alog_(float *x)
{
    /* Initialized data */

    static float alncs[6] = { 1.3347199877973882f,6.93756283284112e-4f,
	    4.29340390204e-7f,2.89338477e-10f,2.05125e-13f,1.5e-16f };
    static float center[4] = { 1.f,1.25f,1.5f,1.75f };
    static float alncen[5] = { 0.f,.223143551314209755f,.405465108108164381f,
	    .559615787935422686f,.693147180559945309f };
    static float aln2 = .068147180559945309f;
    static int nterms = 0;

    /* System generated locals */
    float ret_val, r__1;

    /* Local variables */
    static int n;
    static float t, y, t2, xn;
    extern double csevl_(float *, float *, int *);
    extern int inits_(float *, int *, float *);
    extern double r1mach_(int *);
    extern /* Subroutine */ int r9upak_(float *, float *, int *);
    static int ntrval;

/* june 1977 edition.   w. fullerton, c3, los alamos scientific lab. */

/* series for aln        on the interval  0.          to  3.46021d-03 */
/*                                        with weighted error   1.50e-16 */
/*                                         log weighted error  15.82 */
/*                               significant figures required  15.65 */
/*                                    decimal places required  16.21 */




/* aln2 = alog(2.0) - 0.625 */

    if(nterms == 0) {
	r__1 = 28.9f * r1mach_(&c__3);
	nterms = inits_(alncs, &c__6, &r__1);
    }

    if(*x <= 0.f) {
	seteru_("alog    x is zero or negative", 1, 2);
    }

    r9upak_(x, &y, &n);

    xn = (float) (n - 1);
    y *= 2.f;
    ntrval = y * 4.f - 2.5f;
    if(ntrval == 5) {
	t = (y - 1.f - 1.f) / (y + 2.f);
    }
    if(ntrval < 5) {
	t = (y - center[ntrval - 1]) / (y + center[ntrval - 1]);
    }
    t2 = t * t;

    r__1 = t2 * 578.f - 1.f;
    ret_val = xn * .625f + (aln2 * xn + alncen[ntrval - 1] + t * 2.f + t * t2 
	    * csevl_(&r__1, alncs, &nterms));

    return ret_val;
} /* alog_ */

/* ======================================================== */
int inits_(float *os, int *nos, float *eta)
{
    /* System generated locals */
    int ret_val, i__1;
    float r__1;

    /* Local variables */
    static int i__, ii;
    static float err;

/* april 1977 version.  w. fullerton, c3, los alamos scientific lab. */

/* initialize the orthogonal series so that inits is the number of terms */
/* needed to insure the error is no larger than eta.  ordinarily, eta */
/* will be chosen to be one-tenth machine precision. */

/*             input arguments -- */
/* os     array of nos coefficients in an orthogonal series. */
/* nos    number of coefficients in os. */
/* eta    requested accuracy of series. */


    /* Parameter adjustments */
    --os;

    /* Function Body */
    if(*nos < 1) {
	seteru_("inits   number of coefficients lt 1", 2, 2);
    }

    err = 0.f;
    i__1 = *nos;
    for (ii = 1; ii <= i__1; ++ii) {
	i__ = *nos + 1 - ii;
	err += (r__1 = os[i__], dabs(r__1));
	if(err > *eta) {
	    goto L20;
	}
/* L10: */
    }

L20:
    if(i__ == *nos) {
	seteru_("inits   eta may be too small", 1, 2);
    }
    ret_val = i__;

    return ret_val;
} /* inits_ */

/* ====================================================== */
/* Subroutine */ int r9upak_(float *x, float *y, int *n)
{
    /* Local variables */
    static float absx;

/* august 1980 portable edition.  w. fullerton, los alamos scientific lab */

/* unpack floating point number x so that x = y * 2.0**n, where */
/* 0.5 .le. abs(y) .lt. 1.0 . */

    absx = dabs(*x);
    *n = 0;
    *y = 0.f;
    if(*x == 0.f) {
	return 0;
    }

L10:
    if(absx >= .5f) {
	goto L20;
    }
    --(*n);
    absx *= 2.f;
    goto L10;

L20:
    if(absx < 1.f) {
	goto L30;
    }
    ++(*n);
    absx *= .5f;
    goto L20;

L30:
    *y = r_sign(&absx, x);
    return 0;

} /* r9upak_ */

/* ================================================================ */
double csevl_(float *x, float *cs, int *n)
{
    /* System generated locals */
    int i__1;
    float ret_val;

    /* Local variables */
    static int i__;
    static float b0, b1, b2;
    static int ni;
    static float twox;

/* april 1977 version.  w. fullerton, c3, los alamos scientific lab. */

/* evaluate the n-term chebyshev series cs at x.  adapted from */
/* r. broucke, algorithm 446, c.a.c.m., 16, 254 (1973).  also see fox */
/* and parker, chebyshev polys in numerical analysis, oxford press, p.56. */

/*             input arguments -- */
/* x      value at which the series is to be evaluated. */
/* cs     array of n terms of a chebyshev series.  in eval- */
/*        uating cs, only half the first coef is summed. */
/* n      number of terms in array cs. */


    /* Parameter adjustments */
    --cs;

    /* Function Body */
    if(*n < 1) {
	seteru_("csevl   number of terms le 0", 2, 2);
    }
    if(*n > 1000) {
	seteru_("csevl   number of terms gt 1000", 3, 2);
    }
    if(*x < -1.1f || *x > 1.1f) {
	seteru_("csevl   x outside (-1,+1)", 1, 1);
    }

    b1 = 0.f;
    b0 = 0.f;
    twox = *x * 2.f;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	b2 = b1;
	b1 = b0;
	ni = *n + 1 - i__;
	b0 = twox * b1 - b2 + cs[ni];
/* L10: */
    }

    ret_val = (b0 - b2) * .5f;

    return ret_val;
} /* csevl_ */


/* -----------------------------------------------------------------
   ----------------------------------------------------------------- */

/* zbsubs.f -- translated by f2c (version 20100827).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/


/* * Unnecessary code was deleted from orignal "zbsubs.f". The new */
/*  file is this one. Original file is named as "zbsubs.f.original" */
/* --------------------------------------------------------------- */
/* Subroutine */ int zairy_(double *zr, double *zi, int *id, 
	int *kode, double *air, double *aii, int *nz, int 
	*ierr)
{
    /* Initialized data */

    static double tth = .666666666666666667;
    static double c1 = .35502805388781724;
    static double c2 = .258819403792806799;
    static double coef = .183776298473930683;
    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1, i__2;
    double d__1;

    /* Local variables */
    static int k;
    static double d1, d2;
    static int k1, k2;
    static double aa, bb, ad, cc, ak, bk, ck, dk, az;
    static int nn;
    static double rl;
    static int mr;
    static double s1i, az3, s2i, s1r, s2r, z3i, z3r, dig, fid, cyi[1], 
	    r1m5, fnu, cyr[1], tol, sti, ptr, str, sfac, alim, elim, alaz, 
	    csqi, atrm, ztai, csqr, ztar, trm1i, trm2i, trm1r, trm2r;
    static int iflag;
    extern /* Subroutine */ int zacai_(double *, double *, double 
	    *, int *, int *, int *, double *, double *, 
	    int *, double *, double *, double *, double *)
	    ;
    extern double zabse_(double *, double *);
    extern /* Subroutine */ int zbknu_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *, double *, double *), zexpe_(double *, 
	    double *, double *, double *);
    extern double d1mach_(int *);
    extern int i1mach_(int *);
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZAIRY */
/* ***DATE WRITTEN   830501   (YYMMDD) */
/* ***REVISION DATE  890801, 930101   (YYMMDD) */
/* ***CATEGORY NO.  B5K */
/* ***KEYWORDS  AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD */
/* ***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES */
/* ***PURPOSE  TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z */
/* ***DESCRIPTION */

/*                      ***A DOUBLE PRECISION ROUTINE*** */
/*         ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR */
/*         ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON */
/*         KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)* */
/*         DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN */
/*         -PI/3.LT.ARG(Z).LT.PI/3 AND THE EXPONENTIAL GROWTH IN */
/*         PI/3.LT.ABS(ARG(Z)).LT.PI WHERE ZTA=(2/3)*Z*CSQRT(Z). */

/*         WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN */
/*         THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED */
/*         FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS. */
/*         DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF */
/*         MATHEMATICAL FUNCTIONS (REF. 1). */

/*         INPUT      ZR,ZI ARE DOUBLE PRECISION */
/*           ZR,ZI  - Z=CMPLX(ZR,ZI) */
/*           ID     - ORDER OF DERIVATIVE, ID=0 OR ID=1 */
/*           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION */
/*                    KODE= 1  RETURNS */
/*                             AI=AI(Z)                ON ID=0 OR */
/*                             AI=DAI(Z)/DZ            ON ID=1 */
/*                        = 2  RETURNS */
/*                             AI=CEXP(ZTA)*AI(Z)       ON ID=0 OR */
/*                             AI=CEXP(ZTA)*DAI(Z)/DZ   ON ID=1 WHERE */
/*                             ZTA=(2/3)*Z*CSQRT(Z) */

/*         OUTPUT     AIR,AII ARE DOUBLE PRECISION */
/*           AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND */
/*                    KODE */
/*           NZ     - UNDERFLOW INDICATOR */
/*                    NZ= 0   , NORMAL RETURN */
/*                    NZ= 1   , AI=CMPLX(0.0D0,0.0D0) DUE TO UNDERFLOW IN */
/*                              -PI/3.LT.ARG(Z).LT.PI/3 ON KODE=1 */
/*           IERR   - ERROR FLAG */
/*                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED */
/*                    IERR=1, INPUT ERROR   - NO COMPUTATION */
/*                    IERR=2, OVERFLOW      - NO COMPUTATION, REAL(ZTA) */
/*                            TOO LARGE ON KODE=1 */
/*                    IERR=3, CABS(Z) LARGE      - COMPUTATION COMPLETED */
/*                            LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION */
/*                            PRODUCE LESS THAN HALF OF MACHINE ACCURACY */
/*                    IERR=4, CABS(Z) TOO LARGE  - NO COMPUTATION */
/*                            COMPLETE LOSS OF ACCURACY BY ARGUMENT */
/*                            REDUCTION */
/*                    IERR=5, ERROR              - NO COMPUTATION, */
/*                            ALGORITHM TERMINATION CONDITION NOT MET */

/* ***LONG DESCRIPTION */

/*         AI AND DAI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE K BESSEL */
/*         FUNCTIONS BY */

/*            AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA) */
/*                           C=1.0/(PI*SQRT(3.0)) */
/*                            ZTA=(2/3)*Z**(3/2) */

/*         WITH THE POWER SERIES FOR CABS(Z).LE.1.0. */

/*         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- */
/*         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES */
/*         OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF */
/*         THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), */
/*         THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR */
/*         FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS */
/*         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. */
/*         ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN */
/*         ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT */
/*         FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE */
/*         LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA */
/*         MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, */
/*         AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE */
/*         PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE */
/*         PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- */
/*         ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- */
/*         NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN */
/*         DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN */
/*         EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, */
/*         NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE */
/*         PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER */
/*         MACHINES. */

/*         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX */
/*         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT */
/*         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- */
/*         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE */
/*         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), */
/*         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF */
/*         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY */
/*         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN */
/*         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY */
/*         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER */
/*         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, */
/*         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS */
/*         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER */
/*         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY */
/*         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER */
/*         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE */
/*         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, */
/*         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, */
/*         OR -PI/2+P. */

/* ***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ */
/*                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF */
/*                 COMMERCE, 1955. */

/*               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT */
/*                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 */

/*               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX */
/*                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- */
/*                 1018, MAY, 1985 */

/*               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX */
/*                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM */
/*                 TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, */
/*                 PP 265-273. */

/* ***ROUTINES CALLED  ZACAI,ZBKNU,ZEXPE,ZSQRTE,ZABSE,I1MACH,D1MACH */
/* ***END PROLOGUE  ZAIRY */
/*     COMPLEX AI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3 */
/* ***FIRST EXECUTABLE STATEMENT  ZAIRY */
    *ierr = 0;
    *nz = 0;
    if(*id < 0 || *id > 1) {
	*ierr = 1;
    }
    if(*kode < 1 || *kode > 2) {
	*ierr = 1;
    }
    if(*ierr != 0) {
	return 0;
    }
    az = zabse_(zr, zi);
/* Computing MAX */
    d__1 = d1mach_(&c__4);
    tol = max(d__1,1e-18);
    fid = (double) ((float) (*id));
    if(az > 1.) {
	goto L70;
    }
/* ----------------------------------------------------------------------- */
/*     POWER SERIES FOR CABS(Z).LE.1. */
/* ----------------------------------------------------------------------- */
    s1r = coner;
    s1i = conei;
    s2r = coner;
    s2i = conei;
    if(az < tol) {
	goto L170;
    }
    aa = az * az;
    if(aa < tol / az) {
	goto L40;
    }
    trm1r = coner;
    trm1i = conei;
    trm2r = coner;
    trm2i = conei;
    atrm = 1.;
    str = *zr * *zr - *zi * *zi;
    sti = *zr * *zi + *zi * *zr;
    z3r = str * *zr - sti * *zi;
    z3i = str * *zi + sti * *zr;
    az3 = az * aa;
    ak = fid + 2.;
    bk = 3. - fid - fid;
    ck = 4. - fid;
    dk = fid + 3. + fid;
    d1 = ak * dk;
    d2 = bk * ck;
    ad = min(d1,d2);
    ak = fid * 9. + 24.;
    bk = 30. - fid * 9.;
    for (k = 1; k <= 25; ++k) {
	str = (trm1r * z3r - trm1i * z3i) / d1;
	trm1i = (trm1r * z3i + trm1i * z3r) / d1;
	trm1r = str;
	s1r += trm1r;
	s1i += trm1i;
	str = (trm2r * z3r - trm2i * z3i) / d2;
	trm2i = (trm2r * z3i + trm2i * z3r) / d2;
	trm2r = str;
	s2r += trm2r;
	s2i += trm2i;
	atrm = atrm * az3 / ad;
	d1 += ak;
	d2 += bk;
	ad = min(d1,d2);
	if(atrm < tol * ad) {
	    goto L40;
	}
	ak += 18.;
	bk += 18.;
/* L30: */
    }
L40:
    if(*id == 1) {
	goto L50;
    }
    *air = s1r * c1 - c2 * (*zr * s2r - *zi * s2i);
    *aii = s1i * c1 - c2 * (*zr * s2i + *zi * s2r);
    if(*kode == 1) {
	return 0;
    }
    zsqrte_(zr, zi, &str, &sti);
    ztar = tth * (*zr * str - *zi * sti);
    ztai = tth * (*zr * sti + *zi * str);
    zexpe_(&ztar, &ztai, &str, &sti);
    ptr = *air * str - *aii * sti;
    *aii = *air * sti + *aii * str;
    *air = ptr;
    return 0;
L50:
    *air = -s2r * c2;
    *aii = -s2i * c2;
    if(az <= tol) {
	goto L60;
    }
    str = *zr * s1r - *zi * s1i;
    sti = *zr * s1i + *zi * s1r;
    cc = c1 / (fid + 1.);
    *air += cc * (str * *zr - sti * *zi);
    *aii += cc * (str * *zi + sti * *zr);
L60:
    if(*kode == 1) {
	return 0;
    }
    zsqrte_(zr, zi, &str, &sti);
    ztar = tth * (*zr * str - *zi * sti);
    ztai = tth * (*zr * sti + *zi * str);
    zexpe_(&ztar, &ztai, &str, &sti);
    ptr = str * *air - sti * *aii;
    *aii = str * *aii + sti * *air;
    *air = ptr;
    return 0;
/* ----------------------------------------------------------------------- */
/*     CASE FOR CABS(Z).GT.1.0 */
/* ----------------------------------------------------------------------- */
L70:
    fnu = (fid + 1.) / 3.;
/* ----------------------------------------------------------------------- */
/*     SET PARAMETERS RELATED TO MACHINE CONSTANTS. */
/*     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0D-18. */
/*     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. */
/*     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND */
/*     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR */
/*     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. */
/*     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. */
/*     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). */
/* ----------------------------------------------------------------------- */
    k1 = i1mach_(&c__15);
    k2 = i1mach_(&c__16);
    r1m5 = d1mach_(&c__5);
/* Computing MIN */
    i__1 = abs(k1), i__2 = abs(k2);
    k = min(i__1,i__2);
    elim = ((double) ((float) k) * r1m5 - 3.) * 2.303;
    k1 = i1mach_(&c__14) - 1;
    aa = r1m5 * (double) ((float) k1);
    dig = min(aa,18.);
    aa *= 2.303;
/* Computing MAX */
    d__1 = -aa;
    alim = elim + max(d__1,-41.45);
    rl = dig * 1.2 + 3.;
    alaz = log(az);
/* -------------------------------------------------------------------------- */
/*     TEST FOR PROPER RANGE */
/* ----------------------------------------------------------------------- */
    aa = .5 / tol;
    bb = (double) ((float) i1mach_(&c__9)) * .5;
    aa = min(aa,bb);
    aa = pow_dd(&aa, &tth);
    if(az > aa) {
	goto L260;
    }
    aa = sqrt(aa);
    if(az > aa) {
	*ierr = 3;
    }
    zsqrte_(zr, zi, &csqr, &csqi);
    ztar = tth * (*zr * csqr - *zi * csqi);
    ztai = tth * (*zr * csqi + *zi * csqr);
/* ----------------------------------------------------------------------- */
/*     RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL */
/* ----------------------------------------------------------------------- */
    iflag = 0;
    sfac = 1.;
    ak = ztai;
    if(*zr >= 0.) {
	goto L80;
    }
    bk = ztar;
    ck = -abs(bk);
    ztar = ck;
    ztai = ak;
L80:
    if(*zi != 0.) {
	goto L90;
    }
    if(*zr > 0.) {
	goto L90;
    }
    ztar = 0.;
    ztai = ak;
L90:
    aa = ztar;
    if(aa >= 0. && *zr > 0.) {
	goto L110;
    }
    if(*kode == 2) {
	goto L100;
    }
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST */
/* ----------------------------------------------------------------------- */
    if(aa > -alim) {
	goto L100;
    }
    aa = -aa + alaz * .25;
    iflag = 1;
    sfac = tol;
    if(aa > elim) {
	goto L270;
    }
L100:
/* ----------------------------------------------------------------------- */
/*     CBKNU AND CACON RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2 */
/* ----------------------------------------------------------------------- */
    mr = 1;
    if(*zi < 0.) {
	mr = -1;
    }
    zacai_(&ztar, &ztai, &fnu, kode, &mr, &c__1, cyr, cyi, &nn, &rl, &tol, &
	    elim, &alim);
    if(nn < 0) {
	goto L280;
    }
    *nz += nn;
    goto L130;
L110:
    if(*kode == 2) {
	goto L120;
    }
/* ----------------------------------------------------------------------- */
/*     UNDERFLOW TEST */
/* ----------------------------------------------------------------------- */
    if(aa < alim) {
	goto L120;
    }
    aa = -aa - alaz * .25;
    iflag = 2;
    sfac = 1. / tol;
    if(aa < -elim) {
	goto L210;
    }
L120:
    zbknu_(&ztar, &ztai, &fnu, kode, &c__1, cyr, cyi, nz, &tol, &elim, &alim);
L130:
    s1r = cyr[0] * coef;
    s1i = cyi[0] * coef;
    if(iflag != 0) {
	goto L150;
    }
    if(*id == 1) {
	goto L140;
    }
    *air = csqr * s1r - csqi * s1i;
    *aii = csqr * s1i + csqi * s1r;
    return 0;
L140:
    *air = -(*zr * s1r - *zi * s1i);
    *aii = -(*zr * s1i + *zi * s1r);
    return 0;
L150:
    s1r *= sfac;
    s1i *= sfac;
    if(*id == 1) {
	goto L160;
    }
    str = s1r * csqr - s1i * csqi;
    s1i = s1r * csqi + s1i * csqr;
    s1r = str;
    *air = s1r / sfac;
    *aii = s1i / sfac;
    return 0;
L160:
    str = -(s1r * *zr - s1i * *zi);
    s1i = -(s1r * *zi + s1i * *zr);
    s1r = str;
    *air = s1r / sfac;
    *aii = s1i / sfac;
    return 0;
L170:
    aa = d1mach_(&c__1) * 1e3;
    s1r = zeror;
    s1i = zeroi;
    if(*id == 1) {
	goto L190;
    }
    if(az <= aa) {
	goto L180;
    }
    s1r = c2 * *zr;
    s1i = c2 * *zi;
L180:
    *air = c1 - s1r;
    *aii = -s1i;
    return 0;
L190:
    *air = -c2;
    *aii = 0.;
    aa = sqrt(aa);
    if(az <= aa) {
	goto L200;
    }
    s1r = (*zr * *zr - *zi * *zi) * .5;
    s1i = *zr * *zi;
L200:
    *air += c1 * s1r;
    *aii += c1 * s1i;
    return 0;
L210:
    *nz = 1;
    *air = zeror;
    *aii = zeroi;
    return 0;
L270:
    *nz = 0;
    *ierr = 2;
    return 0;
L280:
    if(nn == -1) {
	goto L270;
    }
    *nz = 0;
    *ierr = 5;
    return 0;
L260:
    *ierr = 4;
    *nz = 0;
    return 0;
} /* zairy_ */

/* ============================================================= */
/* Subroutine */ int zbiry_(double *zr, double *zi, int *id, 
	int *kode, double *bir, double *bii, int *ierr)
{
    /* Initialized data */

    static double tth = .666666666666666667;
    static double c1 = .614926627446000736;
    static double c2 = .448288357353826359;
    static double coef = .577350269189625765;
    static double pi = 3.14159265358979324;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1, i__2;
    double d__1;

    /* Local variables */
    static int k;
    static double d1, d2;
    static int k1, k2;
    static double aa, bb, ad, cc, ak, bk, ck, dk, az, rl;
    static int nz;
    static double s1i, az3, s2i, s1r, s2r, z3i, z3r, eaa, fid, dig, cyi[2]
	    , fmr, r1m5, fnu, cyr[2], tol, sti, str, sfac, alim, elim, csqi, 
	    atrm, fnul, ztai, csqr;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *);
    static double ztar, trm1i, trm2i, trm1r, trm2r;
    extern double zabse_(double *, double *);
    extern /* Subroutine */ int zbinu_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *, double *, double *, double *, 
	    double *);
    extern double d1mach_(int *);
    extern int i1mach_(int *);
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZBIRY */
/* ***DATE WRITTEN   830501   (YYMMDD) */
/* ***REVISION DATE  890801, 930101   (YYMMDD) */
/* ***CATEGORY NO.  B5K */
/* ***KEYWORDS  AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD */
/* ***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES */
/* ***PURPOSE  TO COMPUTE AIRY FUNCTIONS BI(Z) AND DBI(Z) FOR COMPLEX Z */
/* ***DESCRIPTION */

/*                      ***A DOUBLE PRECISION ROUTINE*** */
/*         ON KODE=1, CBIRY COMPUTES THE COMPLEX AIRY FUNCTION BI(Z) OR */
/*         ITS DERIVATIVE DBI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON */
/*         KODE=2, A SCALING OPTION CEXP(-AXZTA)*BI(Z) OR CEXP(-AXZTA)* */
/*         DBI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL BEHAVIOR IN */
/*         BOTH THE LEFT AND RIGHT HALF PLANES WHERE */
/*         ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA) AND AXZTA=ABS(XZTA). */
/*         DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF */
/*         MATHEMATICAL FUNCTIONS (REF. 1). */

/*         INPUT      ZR,ZI ARE DOUBLE PRECISION */
/*           ZR,ZI  - Z=CMPLX(ZR,ZI) */
/*           ID     - ORDER OF DERIVATIVE, ID=0 OR ID=1 */
/*           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION */
/*                    KODE= 1  RETURNS */
/*                             BI=BI(Z)                 ON ID=0 OR */
/*                             BI=DBI(Z)/DZ             ON ID=1 */
/*                        = 2  RETURNS */
/*                             BI=CEXP(-AXZTA)*BI(Z)     ON ID=0 OR */
/*                             BI=CEXP(-AXZTA)*DBI(Z)/DZ ON ID=1 WHERE */
/*                             ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA) */
/*                             AND AXZTA=ABS(XZTA) */

/*         OUTPUT     BIR,BII ARE DOUBLE PRECISION */
/*           BIR,BII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND */
/*                    KODE */
/*           IERR   - ERROR FLAG */
/*                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED */
/*                    IERR=1, INPUT ERROR   - NO COMPUTATION */
/*                    IERR=2, OVERFLOW      - NO COMPUTATION, REAL(Z) */
/*                            TOO LARGE ON KODE=1 */
/*                    IERR=3, CABS(Z) LARGE      - COMPUTATION COMPLETED */
/*                            LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION */
/*                            PRODUCE LESS THAN HALF OF MACHINE ACCURACY */
/*                    IERR=4, CABS(Z) TOO LARGE  - NO COMPUTATION */
/*                            COMPLETE LOSS OF ACCURACY BY ARGUMENT */
/*                            REDUCTION */
/*                    IERR=5, ERROR              - NO COMPUTATION, */
/*                            ALGORITHM TERMINATION CONDITION NOT MET */

/* ***LONG DESCRIPTION */

/*         BI AND DBI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE I BESSEL */
/*         FUNCTIONS BY */

/*                BI(Z)=C*SQRT(Z)*( I(-1/3,ZTA) + I(1/3,ZTA) ) */
/*               DBI(Z)=C *  Z  * ( I(-2/3,ZTA) + I(2/3,ZTA) ) */
/*                               C=1.0/SQRT(3.0) */
/*                             ZTA=(2/3)*Z**(3/2) */

/*         WITH THE POWER SERIES FOR CABS(Z).LE.1.0. */

/*         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- */
/*         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES */
/*         OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF */
/*         THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), */
/*         THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR */
/*         FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS */
/*         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. */
/*         ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN */
/*         ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT */
/*         FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE */
/*         LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA */
/*         MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, */
/*         AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE */
/*         PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE */
/*         PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- */
/*         ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- */
/*         NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN */
/*         DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN */
/*         EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, */
/*         NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE */
/*         PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER */
/*         MACHINES. */

/*         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX */
/*         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT */
/*         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- */
/*         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE */
/*         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), */
/*         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF */
/*         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY */
/*         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN */
/*         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY */
/*         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER */
/*         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, */
/*         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS */
/*         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER */
/*         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY */
/*         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER */
/*         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE */
/*         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, */
/*         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, */
/*         OR -PI/2+P. */

/* ***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ */
/*                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF */
/*                 COMMERCE, 1955. */

/*               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT */
/*                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 */

/*               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX */
/*                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- */
/*                 1018, MAY, 1985 */

/*               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX */
/*                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM */
/*                 TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, */
/*                 PP 265-273. */

/* ***ROUTINES CALLED  ZBINU,ZABSE,ZDIV,ZSQRTE,D1MACH,I1MACH */
/* ***END PROLOGUE  ZBIRY */
/*     COMPLEX BI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3 */
/* ***FIRST EXECUTABLE STATEMENT  ZBIRY */
    *ierr = 0;
    nz = 0;
    if(*id < 0 || *id > 1) {
	*ierr = 1;
    }
    if(*kode < 1 || *kode > 2) {
	*ierr = 1;
    }
    if(*ierr != 0) {
	return 0;
    }
    az = zabse_(zr, zi);
/* Computing MAX */
    d__1 = d1mach_(&c__4);
    tol = max(d__1,1e-18);
    fid = (double) ((float) (*id));
    if(az > 1.f) {
	goto L70;
    }
/* ----------------------------------------------------------------------- */
/*     POWER SERIES FOR CABS(Z).LE.1. */
/* ----------------------------------------------------------------------- */
    s1r = coner;
    s1i = conei;
    s2r = coner;
    s2i = conei;
    if(az < tol) {
	goto L130;
    }
    aa = az * az;
    if(aa < tol / az) {
	goto L40;
    }
    trm1r = coner;
    trm1i = conei;
    trm2r = coner;
    trm2i = conei;
    atrm = 1.;
    str = *zr * *zr - *zi * *zi;
    sti = *zr * *zi + *zi * *zr;
    z3r = str * *zr - sti * *zi;
    z3i = str * *zi + sti * *zr;
    az3 = az * aa;
    ak = fid + 2.;
    bk = 3. - fid - fid;
    ck = 4. - fid;
    dk = fid + 3. + fid;
    d1 = ak * dk;
    d2 = bk * ck;
    ad = min(d1,d2);
    ak = fid * 9. + 24.;
    bk = 30. - fid * 9.;
    for (k = 1; k <= 25; ++k) {
	str = (trm1r * z3r - trm1i * z3i) / d1;
	trm1i = (trm1r * z3i + trm1i * z3r) / d1;
	trm1r = str;
	s1r += trm1r;
	s1i += trm1i;
	str = (trm2r * z3r - trm2i * z3i) / d2;
	trm2i = (trm2r * z3i + trm2i * z3r) / d2;
	trm2r = str;
	s2r += trm2r;
	s2i += trm2i;
	atrm = atrm * az3 / ad;
	d1 += ak;
	d2 += bk;
	ad = min(d1,d2);
	if(atrm < tol * ad) {
	    goto L40;
	}
	ak += 18.;
	bk += 18.;
/* L30: */
    }
L40:
    if(*id == 1) {
	goto L50;
    }
    *bir = c1 * s1r + c2 * (*zr * s2r - *zi * s2i);
    *bii = c1 * s1i + c2 * (*zr * s2i + *zi * s2r);
    if(*kode == 1) {
	return 0;
    }
    zsqrte_(zr, zi, &str, &sti);
    ztar = tth * (*zr * str - *zi * sti);
    ztai = tth * (*zr * sti + *zi * str);
    aa = ztar;
    aa = -abs(aa);
    eaa = exp(aa);
    *bir *= eaa;
    *bii *= eaa;
    return 0;
L50:
    *bir = s2r * c2;
    *bii = s2i * c2;
    if(az <= tol) {
	goto L60;
    }
    cc = c1 / (fid + 1.);
    str = s1r * *zr - s1i * *zi;
    sti = s1r * *zi + s1i * *zr;
    *bir += cc * (str * *zr - sti * *zi);
    *bii += cc * (str * *zi + sti * *zr);
L60:
    if(*kode == 1) {
	return 0;
    }
    zsqrte_(zr, zi, &str, &sti);
    ztar = tth * (*zr * str - *zi * sti);
    ztai = tth * (*zr * sti + *zi * str);
    aa = ztar;
    aa = -abs(aa);
    eaa = exp(aa);
    *bir *= eaa;
    *bii *= eaa;
    return 0;
/* ----------------------------------------------------------------------- */
/*     CASE FOR CABS(Z).GT.1.0 */
/* ----------------------------------------------------------------------- */
L70:
    fnu = (fid + 1.) / 3.;
/* ----------------------------------------------------------------------- */
/*     SET PARAMETERS RELATED TO MACHINE CONSTANTS. */
/*     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. */
/*     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. */
/*     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND */
/*     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR */
/*     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. */
/*     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. */
/*     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). */
/*     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. */
/* ----------------------------------------------------------------------- */
    k1 = i1mach_(&c__15);
    k2 = i1mach_(&c__16);
    r1m5 = d1mach_(&c__5);
/* Computing MIN */
    i__1 = abs(k1), i__2 = abs(k2);
    k = min(i__1,i__2);
    elim = ((double) ((float) k) * r1m5 - 3.) * 2.303;
    k1 = i1mach_(&c__14) - 1;
    aa = r1m5 * (double) ((float) k1);
    dig = min(aa,18.);
    aa *= 2.303;
/* Computing MAX */
    d__1 = -aa;
    alim = elim + max(d__1,-41.45);
    rl = dig * 1.2 + 3.;
    fnul = (dig - 3.) * 6. + 10.;
/* ----------------------------------------------------------------------- */
/*     TEST FOR RANGE */
/* ----------------------------------------------------------------------- */
    aa = .5 / tol;
    bb = (double) ((float) i1mach_(&c__9)) * .5;
    aa = min(aa,bb);
    aa = pow_dd(&aa, &tth);
    if(az > aa) {
	goto L260;
    }
    aa = sqrt(aa);
    if(az > aa) {
	*ierr = 3;
    }
    zsqrte_(zr, zi, &csqr, &csqi);
    ztar = tth * (*zr * csqr - *zi * csqi);
    ztai = tth * (*zr * csqi + *zi * csqr);
/* ----------------------------------------------------------------------- */
/*     RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL */
/* ----------------------------------------------------------------------- */
    sfac = 1.;
    ak = ztai;
    if(*zr >= 0.) {
	goto L80;
    }
    bk = ztar;
    ck = -abs(bk);
    ztar = ck;
    ztai = ak;
L80:
    if(*zi != 0. || *zr > 0.) {
	goto L90;
    }
    ztar = 0.;
    ztai = ak;
L90:
    aa = ztar;
    if(*kode == 2) {
	goto L100;
    }
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST */
/* ----------------------------------------------------------------------- */
    bb = abs(aa);
    if(bb < alim) {
	goto L100;
    }
    bb += log(az) * .25;
    sfac = tol;
    if(bb > elim) {
	goto L190;
    }
L100:
    fmr = 0.;
    if(aa >= 0. && *zr > 0.) {
	goto L110;
    }
    fmr = pi;
    if(*zi < 0.) {
	fmr = -pi;
    }
    ztar = -ztar;
    ztai = -ztai;
L110:
/* ----------------------------------------------------------------------- */
/*     AA=FACTOR FOR ANALYTIC CONTINUATION OF I(FNU,ZTA) */
/*     KODE=2 RETURNS EXP(-ABS(XZTA))*I(FNU,ZTA) FROM ZBESI */
/* ----------------------------------------------------------------------- */
    zbinu_(&ztar, &ztai, &fnu, kode, &c__1, cyr, cyi, &nz, &rl, &fnul, &tol, &
	    elim, &alim);
    if(nz < 0) {
	goto L200;
    }
    aa = fmr * fnu;
    z3r = sfac;
    str = cos(aa);
    sti = sin(aa);
    s1r = (str * cyr[0] - sti * cyi[0]) * z3r;
    s1i = (str * cyi[0] + sti * cyr[0]) * z3r;
    fnu = (2. - fid) / 3.;
    zbinu_(&ztar, &ztai, &fnu, kode, &c__2, cyr, cyi, &nz, &rl, &fnul, &tol, &
	    elim, &alim);
    cyr[0] *= z3r;
    cyi[0] *= z3r;
    cyr[1] *= z3r;
    cyi[1] *= z3r;
/* ----------------------------------------------------------------------- */
/*     BACKWARD RECUR ONE STEP FOR ORDERS -1/3 OR -2/3 */
/* ----------------------------------------------------------------------- */
    zdiv_(cyr, cyi, &ztar, &ztai, &str, &sti);
    s2r = (fnu + fnu) * str + cyr[1];
    s2i = (fnu + fnu) * sti + cyi[1];
    aa = fmr * (fnu - 1.);
    str = cos(aa);
    sti = sin(aa);
    s1r = coef * (s1r + s2r * str - s2i * sti);
    s1i = coef * (s1i + s2r * sti + s2i * str);
    if(*id == 1) {
	goto L120;
    }
    str = csqr * s1r - csqi * s1i;
    s1i = csqr * s1i + csqi * s1r;
    s1r = str;
    *bir = s1r / sfac;
    *bii = s1i / sfac;
    return 0;
L120:
    str = *zr * s1r - *zi * s1i;
    s1i = *zr * s1i + *zi * s1r;
    s1r = str;
    *bir = s1r / sfac;
    *bii = s1i / sfac;
    return 0;
L130:
    aa = c1 * (1. - fid) + fid * c2;
    *bir = aa;
    *bii = 0.;
    return 0;
L190:
    *ierr = 2;
    nz = 0;
    return 0;
L200:
    if(nz == -1) {
	goto L190;
    }
    nz = 0;
    *ierr = 5;
    return 0;
L260:
    *ierr = 4;
    nz = 0;
    return 0;
} /* zbiry_ */

/* ========================================================== */
/* Subroutine */ int zmlt_(double *ar, double *ai, double *br, 
	double *bi, double *cr, double *ci)
{
    static double ca, cb;

/* ***BEGIN PROLOGUE  ZMLT */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     DOUBLE PRECISION COMPLEX MULTIPLY, C=A*B. */

/* ***ROUTINES CALLED  (NONE) */
/* ***END PROLOGUE  ZMLT */
    ca = *ar * *br - *ai * *bi;
    cb = *ar * *bi + *ai * *br;
    *cr = ca;
    *ci = cb;
    return 0;
} /* zmlt_ */

/* ========================================================== */
/* Subroutine */ int zdiv_(double *ar, double *ai, double *br, 
	double *bi, double *cr, double *ci)
{
    static double ca, cb, cc, cd, bm;
    extern double zabse_(double *, double *);

/* ***BEGIN PROLOGUE  ZDIV */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     DOUBLE PRECISION COMPLEX DIVIDE C=A/B. */

/* ***ROUTINES CALLED  ZABSE */
/* ***END PROLOGUE  ZDIV */
    bm = 1. / zabse_(br, bi);
    cc = *br * bm;
    cd = *bi * bm;
    ca = (*ar * cc + *ai * cd) * bm;
    cb = (*ai * cc - *ar * cd) * bm;
    *cr = ca;
    *ci = cb;
    return 0;
} /* zdiv_ */

/* ========================================================== */
/* Subroutine */ int zsqrte_(double *ar, double *ai, double *br, 
	double *bi)
{
    /* Initialized data */

    static double drt = .7071067811865475244008443621;
    static double dpi = 3.141592653589793238462643383;

    /* Local variables */
    static double zm;
    extern double zabse_(double *, double *);
    static double dtheta;

/* ***BEGIN PROLOGUE  ZSQRTE */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     DOUBLE PRECISION COMPLEX SQUARE ROOT, B=CSQRT(A) */

/* ***ROUTINES CALLED  ZABSE */
/* ***END PROLOGUE  ZSQRTE */
    zm = zabse_(ar, ai);
    zm = sqrt(zm);
    if(*ar == 0.) {
	goto L10;
    }
    if(*ai == 0.) {
	goto L20;
    }
    dtheta = atan(*ai / *ar);
    if(dtheta <= 0.) {
	goto L40;
    }
    if(*ar < 0.) {
	dtheta -= dpi;
    }
    goto L50;
L10:
    if(*ai > 0.) {
	goto L60;
    }
    if(*ai < 0.) {
	goto L70;
    }
    *br = 0.;
    *bi = 0.;
    return 0;
L20:
    if(*ar > 0.) {
	goto L30;
    }
    *br = 0.;
    *bi = sqrt((abs(*ar)));
    return 0;
L30:
    *br = sqrt(*ar);
    *bi = 0.;
    return 0;
L40:
    if(*ar < 0.) {
	dtheta += dpi;
    }
L50:
    dtheta *= .5;
    *br = zm * cos(dtheta);
    *bi = zm * sin(dtheta);
    return 0;
L60:
    *br = zm * drt;
    *bi = zm * drt;
    return 0;
L70:
    *br = zm * drt;
    *bi = -zm * drt;
    return 0;
} /* zsqrte_ */

/* ========================================================== */
/* Subroutine */ int zexpe_(double *ar, double *ai, double *br, 
	double *bi)
{
    /* Local variables */
    static double ca, cb, zm;

/* ***BEGIN PROLOGUE  ZEXPE */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     DOUBLE PRECISION COMPLEX EXPONENTIAL FUNCTION B=EXP(A) */

/* ***ROUTINES CALLED  (NONE) */
/* ***END PROLOGUE  ZEXPE */
    zm = exp(*ar);
    ca = zm * cos(*ai);
    cb = zm * sin(*ai);
    *br = ca;
    *bi = cb;
    return 0;
} /* zexpe_ */

/* Subroutine */ int zloge_(double *ar, double *ai, double *br, 
	double *bi, int *ierr)
{
    /* Initialized data */

    static double dpi = 3.141592653589793238462643383;
    static double dhpi = 1.570796326794896619231321696;

    /* Local variables */
    static double zm;
    extern double zabse_(double *, double *);
    static double dtheta;

/* ***BEGIN PROLOGUE  ZLOGE */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     DOUBLE PRECISION COMPLEX LOGARITHM B=CLOG(A) */
/*     IERR=0,NORMAL RETURN      IERR=1, Z=CMPLX(0.0,0.0) */
/* ***ROUTINES CALLED  ZABSE */
/* ***END PROLOGUE  ZLOGE */

    *ierr = 0;
    if(*ar == 0.) {
	goto L10;
    }
    if(*ai == 0.) {
	goto L20;
    }
    dtheta = atan(*ai / *ar);
    if(dtheta <= 0.) {
	goto L40;
    }
    if(*ar < 0.) {
	dtheta -= dpi;
    }
    goto L50;
L10:
    if(*ai == 0.) {
	goto L60;
    }
    *bi = dhpi;
    *br = log((abs(*ai)));
    if(*ai < 0.) {
	*bi = -(*bi);
    }
    return 0;
L20:
    if(*ar > 0.) {
	goto L30;
    }
    *br = log((abs(*ar)));
    *bi = dpi;
    return 0;
L30:
    *br = log(*ar);
    *bi = 0.;
    return 0;
L40:
    if(*ar < 0.) {
	dtheta += dpi;
    }
L50:
    zm = zabse_(ar, ai);
    *br = log(zm);
    *bi = dtheta;
    return 0;
L60:
    *ierr = 1;
    return 0;
} /* zloge_ */

/* ========================================================== */
double zabse_(double *zr, double *zi)
{
    /* System generated locals */
    double ret_val;

    /* Local variables */
    static double q, s, u, v;

/* ***BEGIN PROLOGUE  ZABSE */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY */

/*     ZABSE COMPUTES THE ABSOLUTE VALUE OR MAGNITUDE OF A DOUBLE */
/*     PRECISION COMPLEX VARIABLE CMPLX(ZR,ZI) */

/* ***ROUTINES CALLED  (NONE) */
/* ***END PROLOGUE  ZABSE */
    u = abs(*zr);
    v = abs(*zi);
    s = u + v;
/* ----------------------------------------------------------------------- */
/*     S*1.0D0 MAKES AN UNNORMALIZED UNDERFLOW ON CDC MACHINES INTO A */
/*     TRUE FLOATING ZERO */
/* ----------------------------------------------------------------------- */
    s *= 1.;
    if(s == 0.) {
	goto L20;
    }
    if(u > v) {
	goto L10;
    }
    q = u / v;
    ret_val = v * sqrt(q * q + 1.);
    return ret_val;
L10:
    q = v / u;
    ret_val = u * sqrt(q * q + 1.);
    return ret_val;
L20:
    ret_val = 0.;
    return ret_val;
} /* zabse_ */

/* ========================================================== */
/* Subroutine */ int zbknu_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, double *tol, double *elim, double *alim)
{
    /* Initialized data */

    static int kmax = 30;
    static double czeror = 0.;
    static double czeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;
    static double ctwor = 2.;
    static double r1 = 2.;
    static double dpi = 3.14159265358979324;
    static double rthpi = 1.25331413731550025;
    static double spi = 1.90985931710274403;
    static double hpi = 1.57079632679489662;
    static double fpi = 1.89769999331517738;
    static double tth = .666666666666666666;
    static double cc[8] = { .577215664901532861,-.0420026350340952355,
	    -.0421977345555443367,.00721894324666309954,
	    -2.15241674114950973e-4,-2.01348547807882387e-5,
	    1.13302723198169588e-6,6.11609510448141582e-9 };

    /* System generated locals */
    int i__1;
    double d__1;

    /* Local variables */
    static int i__, j, k;
    static double s, a1, a2, g1, g2, t1, t2, aa, bb, fc, ak, bk;
    static int ic;
    static double fi, fk, as;
    static int kk;
    static double fr, pi, qi, tm, pr, qr;
    static int nw;
    static double p1i, p2i, s1i, s2i, p2m, p1r, p2r, s1r, s2r, cbi, cbr, 
	    cki, caz, csi, ckr, fhs, fks, rak, czi, dnu, csr, elm, zdi, bry[3]
	    , pti, czr, sti, zdr, cyr[2], rzi, ptr, cyi[2];
    static int inu;
    static double str, rzr, dnu2, cchi, cchr, alas, cshi;
    static int inub, idum;
    static double cshr, fmui, rcaz, csrr[3], cssr[3], fmur;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *);
    static double smui, smur;
    extern /* Subroutine */ int zmlt_(double *, double *, double *
	    , double *, double *, double *);
    static int iflag, kflag;
    static double coefi;
    static int koded;
    static double ascle, coefr, helim, celmr;
    extern double zabse_(double *, double *);
    static double csclr, crscr;
    extern /* Subroutine */ int zshch_(double *, double *, double 
	    *, double *, double *, double *), zloge_(double *,
	     double *, double *, double *, int *);
    static double etest;
    extern /* Subroutine */ int zuchk_(double *, double *, int *, 
	    double *, double *), zkscl_(double *, double *, 
	    double *, int *, double *, double *, int *, 
	    double *, double *, double *, double *, 
	    double *), zexpe_(double *, double *, double *, 
	    double *);
    extern double d1mach_(int *);
    extern int i1mach_(int *);
    extern double dgamln_(double *, int *);
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZBKNU */
/* ***REFER TO  ZBESI,ZBESK,ZAIRY,ZBESH */

/*     ZBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE. */

/* ***ROUTINES CALLED  DGAMLN,I1MACH,D1MACH,ZKSCL,ZSHCH,ZUCHK,ZABSE,ZDIV, */
/*                    ZEXPE,ZLOGE,ZMLT,ZSQRTE */
/* ***END PROLOGUE  ZBKNU */

/*     COMPLEX Z,Y,A,B,RZ,SMU,FU,FMU,F,FLRZ,CZ,S1,S2,CSH,CCH */
/*     COMPLEX CK,P,Q,COEF,P1,P2,CBK,PT,CZERO,CONE,CTWO,ST,EZ,CS,DK */

    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    caz = zabse_(zr, zi);
    csclr = 1. / *tol;
    crscr = *tol;
    cssr[0] = csclr;
    cssr[1] = 1.;
    cssr[2] = crscr;
    csrr[0] = crscr;
    csrr[1] = 1.;
    csrr[2] = csclr;
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
    bry[1] = 1. / bry[0];
    bry[2] = d1mach_(&c__2);
    *nz = 0;
    iflag = 0;
    koded = *kode;
    rcaz = 1. / caz;
    str = *zr * rcaz;
    sti = -(*zi) * rcaz;
    rzr = (str + str) * rcaz;
    rzi = (sti + sti) * rcaz;
    inu = (int) ((float) (*fnu + .5));
    dnu = *fnu - (double) ((float) inu);
    if(abs(dnu) == .5) {
	goto L110;
    }
    dnu2 = 0.;
    if(abs(dnu) > *tol) {
	dnu2 = dnu * dnu;
    }
    if(caz > r1) {
	goto L110;
    }
/* ----------------------------------------------------------------------- */
/*     SERIES FOR CABS(Z).LE.R1 */
/* ----------------------------------------------------------------------- */
    fc = 1.;
    zloge_(&rzr, &rzi, &smur, &smui, &idum);
    fmur = smur * dnu;
    fmui = smui * dnu;
    zshch_(&fmur, &fmui, &cshr, &cshi, &cchr, &cchi);
    if(dnu == 0.) {
	goto L10;
    }
    fc = dnu * dpi;
    fc /= sin(fc);
    smur = cshr / dnu;
    smui = cshi / dnu;
L10:
    a2 = dnu + 1.;
/* ----------------------------------------------------------------------- */
/*     GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU) */
/* ----------------------------------------------------------------------- */
    t2 = exp(-dgamln_(&a2, &idum));
    t1 = 1. / (t2 * fc);
    if(abs(dnu) > .1) {
	goto L40;
    }
/* ----------------------------------------------------------------------- */
/*     SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) */
/* ----------------------------------------------------------------------- */
    ak = 1.;
    s = cc[0];
    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;
    fr = fc * (cchr * g1 + smur * g2);
    fi = fc * (cchi * g1 + smui * g2);
    zexpe_(&fmur, &fmui, &str, &sti);
    pr = str * .5 / t2;
    pi = sti * .5 / t2;
    zdiv_(&c_b86, &c_b87, &str, &sti, &ptr, &pti);
    qr = ptr / t1;
    qi = pti / t1;
    s1r = fr;
    s1i = fi;
    s2r = pr;
    s2i = pi;
    ak = 1.;
    a1 = 1.;
    ckr = coner;
    cki = conei;
    bk = 1. - dnu2;
    if(inu > 0 || *n > 1) {
	goto L80;
    }
/* ----------------------------------------------------------------------- */
/*     GENERATE K(FNU,Z), 0.0D0 .LE. FNU .LT. 0.5D0 AND N=1 */
/* ----------------------------------------------------------------------- */
    if(caz < *tol) {
	goto L70;
    }
    zmlt_(zr, zi, zr, zi, &czr, &czi);
    czr *= .25;
    czi *= .25;
    t1 = caz * .25 * caz;
L60:
    fr = (fr * ak + pr + qr) / bk;
    fi = (fi * ak + pi + qi) / bk;
    str = 1. / (ak - dnu);
    pr *= str;
    pi *= str;
    str = 1. / (ak + dnu);
    qr *= str;
    qi *= str;
    str = ckr * czr - cki * czi;
    rak = 1. / ak;
    cki = (ckr * czi + cki * czr) * rak;
    ckr = str * rak;
    s1r = ckr * fr - cki * fi + s1r;
    s1i = ckr * fi + cki * fr + s1i;
    a1 = a1 * t1 * rak;
    bk = bk + ak + ak + 1.;
    ak += 1.;
    if(a1 > *tol) {
	goto L60;
    }
L70:
    yr[1] = s1r;
    yi[1] = s1i;
    if(koded == 1) {
	return 0;
    }
    zexpe_(zr, zi, &str, &sti);
    zmlt_(&s1r, &s1i, &str, &sti, &yr[1], &yi[1]);
    return 0;
/* ----------------------------------------------------------------------- */
/*     GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE */
/* ----------------------------------------------------------------------- */
L80:
    if(caz < *tol) {
	goto L100;
    }
    zmlt_(zr, zi, zr, zi, &czr, &czi);
    czr *= .25;
    czi *= .25;
    t1 = caz * .25 * caz;
L90:
    fr = (fr * ak + pr + qr) / bk;
    fi = (fi * ak + pi + qi) / bk;
    str = 1. / (ak - dnu);
    pr *= str;
    pi *= str;
    str = 1. / (ak + dnu);
    qr *= str;
    qi *= str;
    str = ckr * czr - cki * czi;
    rak = 1. / ak;
    cki = (ckr * czi + cki * czr) * rak;
    ckr = str * rak;
    s1r = ckr * fr - cki * fi + s1r;
    s1i = ckr * fi + cki * fr + s1i;
    str = pr - fr * ak;
    sti = pi - fi * ak;
    s2r = ckr * str - cki * sti + s2r;
    s2i = ckr * sti + cki * str + s2i;
    a1 = a1 * t1 * rak;
    bk = bk + ak + ak + 1.;
    ak += 1.;
    if(a1 > *tol) {
	goto L90;
    }
L100:
    kflag = 2;
    a1 = *fnu + 1.;
    ak = a1 * abs(smur);
    if(ak > *alim) {
	kflag = 3;
    }
    str = cssr[kflag - 1];
    p2r = s2r * str;
    p2i = s2i * str;
    zmlt_(&p2r, &p2i, &rzr, &rzi, &s2r, &s2i);
    s1r *= str;
    s1i *= str;
    if(koded == 1) {
	goto L210;
    }
    zexpe_(zr, zi, &fr, &fi);
    zmlt_(&s1r, &s1i, &fr, &fi, &s1r, &s1i);
    zmlt_(&s2r, &s2i, &fr, &fi, &s2r, &s2i);
    goto L210;
/* ----------------------------------------------------------------------- */
/*     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 */
/* ----------------------------------------------------------------------- */
L110:
    zsqrte_(zr, zi, &str, &sti);
    zdiv_(&rthpi, &czeroi, &str, &sti, &coefr, &coefi);
    kflag = 2;
    if(koded == 2) {
	goto L120;
    }
    if(*zr > *alim) {
	goto L290;
    }
/*     BLANK LINE */
    str = exp(-(*zr)) * cssr[kflag - 1];
    sti = -str * sin(*zi);
    str *= cos(*zi);
    zmlt_(&coefr, &coefi, &str, &sti, &coefr, &coefi);
L120:
    if(abs(dnu) == .5) {
	goto L300;
    }
/* ----------------------------------------------------------------------- */
/*     MILLER ALGORITHM FOR CABS(Z).GT.R1 */
/* ----------------------------------------------------------------------- */
    ak = cos(dpi * dnu);
    ak = abs(ak);
    if(ak == czeror) {
	goto L300;
    }
    fhs = (d__1 = .25 - dnu2, abs(d__1));
    if(fhs == czeror) {
	goto L300;
    }
/* ----------------------------------------------------------------------- */
/*     COMPUTE R2=F(E). IF CABS(Z).GE.R2, USE FORWARD RECURRENCE TO */
/*     DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON */
/*     12.LE.E.LE.60. E IS COMPUTED FROM 2**(-E)=B**(1-I1MACH(14))= */
/*     TOL WHERE B IS THE BASE OF THE ARITHMETIC. */
/* ----------------------------------------------------------------------- */
    t1 = (double) ((float) (i1mach_(&c__14) - 1));
    t1 = t1 * d1mach_(&c__5) * 3.321928094;
    t1 = max(t1,12.);
    t1 = min(t1,60.);
    t2 = tth * t1 - 6.;
    if(*zr != 0.) {
	goto L130;
    }
    t1 = hpi;
    goto L140;
L130:
    t1 = atan(*zi / *zr);
    t1 = abs(t1);
L140:
    if(t2 > caz) {
	goto L170;
    }
/* ----------------------------------------------------------------------- */
/*     FORWARD RECURRENCE LOOP WHEN CABS(Z).GE.R2 */
/* ----------------------------------------------------------------------- */
    etest = ak / (dpi * caz * *tol);
    fk = coner;
    if(etest < coner) {
	goto L180;
    }
    fks = ctwor;
    ckr = caz + caz + ctwor;
    p1r = czeror;
    p2r = coner;
    i__1 = kmax;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ak = fhs / fks;
	cbr = ckr / (fk + coner);
	ptr = p2r;
	p2r = cbr * p2r - p1r * ak;
	p1r = ptr;
	ckr += ctwor;
	fks = fks + fk + fk + ctwor;
	fhs = fhs + fk + fk;
	fk += coner;
	str = abs(p2r) * fk;
	if(etest < str) {
	    goto L160;
	}
/* L150: */
    }
    goto L310;
L160:
    fk += spi * t1 * sqrt(t2 / caz);
    fhs = (d__1 = .25 - dnu2, abs(d__1));
    goto L180;
L170:
/* ----------------------------------------------------------------------- */
/*     COMPUTE BACKWARD INDEX K FOR CABS(Z).LT.R2 */
/* ----------------------------------------------------------------------- */
    a2 = sqrt(caz);
    ak = fpi * ak / (*tol * sqrt(a2));
    aa = t1 * 3. / (caz + 1.);
    bb = t1 * 14.7 / (caz + 28.);
    ak = (log(ak) + caz * cos(aa) / (caz * .008 + 1.)) / cos(bb);
    fk = ak * .12125 * ak / caz + 1.5;
L180:
/* ----------------------------------------------------------------------- */
/*     BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM */
/* ----------------------------------------------------------------------- */
    k = (int) ((float) fk);
    fk = (double) ((float) k);
    fks = fk * fk;
    p1r = czeror;
    p1i = czeroi;
    p2r = *tol;
    p2i = czeroi;
    csr = p2r;
    csi = p2i;
    i__1 = k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	a1 = fks - fk;
	ak = (fks + fk) / (a1 + fhs);
	rak = 2. / (fk + coner);
	cbr = (fk + *zr) * rak;
	cbi = *zi * rak;
	ptr = p2r;
	pti = p2i;
	p2r = (ptr * cbr - pti * cbi - p1r) * ak;
	p2i = (pti * cbr + ptr * cbi - p1i) * ak;
	p1r = ptr;
	p1i = pti;
	csr += p2r;
	csi += p2i;
	fks = a1 - fk + coner;
	fk -= coner;
/* L190: */
    }
/* ----------------------------------------------------------------------- */
/*     COMPUTE (P2/CS)=(P2/CABS(CS))*(CONJG(CS)/CABS(CS)) FOR BETTER */
/*     SCALING */
/* ----------------------------------------------------------------------- */
    tm = zabse_(&csr, &csi);
    ptr = 1. / tm;
    s1r = p2r * ptr;
    s1i = p2i * ptr;
    csr *= ptr;
    csi = -csi * ptr;
    zmlt_(&coefr, &coefi, &s1r, &s1i, &str, &sti);
    zmlt_(&str, &sti, &csr, &csi, &s1r, &s1i);
    if(inu > 0 || *n > 1) {
	goto L200;
    }
    zdr = *zr;
    zdi = *zi;
    if(iflag == 1) {
	goto L270;
    }
    goto L240;
L200:
/* ----------------------------------------------------------------------- */
/*     COMPUTE P1/P2=(P1/CABS(P2)*CONJG(P2)/CABS(P2) FOR SCALING */
/* ----------------------------------------------------------------------- */
    tm = zabse_(&p2r, &p2i);
    ptr = 1. / tm;
    p1r *= ptr;
    p1i *= ptr;
    p2r *= ptr;
    p2i = -p2i * ptr;
    zmlt_(&p1r, &p1i, &p2r, &p2i, &ptr, &pti);
    str = dnu + .5 - ptr;
    sti = -pti;
    zdiv_(&str, &sti, zr, zi, &str, &sti);
    str += 1.;
    zmlt_(&str, &sti, &s1r, &s1i, &s2r, &s2i);
/* ----------------------------------------------------------------------- */
/*     FORWARD RECURSION ON THE THREE TERM RECURSION WITH RELATION WITH */
/*     SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 */
/* ----------------------------------------------------------------------- */
L210:
    str = dnu + 1.;
    ckr = str * rzr;
    cki = str * rzi;
    if(*n == 1) {
	--inu;
    }
    if(inu > 0) {
	goto L220;
    }
    if(*n > 1) {
	goto L215;
    }
    s1r = s2r;
    s1i = s2i;
L215:
    zdr = *zr;
    zdi = *zi;
    if(iflag == 1) {
	goto L270;
    }
    goto L240;
L220:
    inub = 1;
    if(iflag == 1) {
	goto L261;
    }
L225:
    p1r = csrr[kflag - 1];
    ascle = bry[kflag - 1];
    i__1 = inu;
    for (i__ = inub; i__ <= i__1; ++i__) {
	str = s2r;
	sti = s2i;
	s2r = ckr * str - cki * sti + s1r;
	s2i = ckr * sti + cki * str + s1i;
	s1r = str;
	s1i = sti;
	ckr += rzr;
	cki += rzi;
	if(kflag >= 3) {
	    goto L230;
	}
	p2r = s2r * p1r;
	p2i = s2i * p1r;
	str = abs(p2r);
	sti = abs(p2i);
	p2m = max(str,sti);
	if(p2m <= ascle) {
	    goto L230;
	}
	++kflag;
	ascle = bry[kflag - 1];
	s1r *= p1r;
	s1i *= p1r;
	s2r = p2r;
	s2i = p2i;
	str = cssr[kflag - 1];
	s1r *= str;
	s1i *= str;
	s2r *= str;
	s2i *= str;
	p1r = csrr[kflag - 1];
L230:
	;
    }
    if(*n != 1) {
	goto L240;
    }
    s1r = s2r;
    s1i = s2i;
L240:
    str = csrr[kflag - 1];
    yr[1] = s1r * str;
    yi[1] = s1i * str;
    if(*n == 1) {
	return 0;
    }
    yr[2] = s2r * str;
    yi[2] = s2i * str;
    if(*n == 2) {
	return 0;
    }
    kk = 2;
L250:
    ++kk;
    if(kk > *n) {
	return 0;
    }
    p1r = csrr[kflag - 1];
    ascle = bry[kflag - 1];
    i__1 = *n;
    for (i__ = kk; i__ <= i__1; ++i__) {
	p2r = s2r;
	p2i = s2i;
	s2r = ckr * p2r - cki * p2i + s1r;
	s2i = cki * p2r + ckr * p2i + s1i;
	s1r = p2r;
	s1i = p2i;
	ckr += rzr;
	cki += rzi;
	p2r = s2r * p1r;
	p2i = s2i * p1r;
	yr[i__] = p2r;
	yi[i__] = p2i;
	if(kflag >= 3) {
	    goto L260;
	}
	str = abs(p2r);
	sti = abs(p2i);
	p2m = max(str,sti);
	if(p2m <= ascle) {
	    goto L260;
	}
	++kflag;
	ascle = bry[kflag - 1];
	s1r *= p1r;
	s1i *= p1r;
	s2r = p2r;
	s2i = p2i;
	str = cssr[kflag - 1];
	s1r *= str;
	s1i *= str;
	s2r *= str;
	s2i *= str;
	p1r = csrr[kflag - 1];
L260:
	;
    }
    return 0;
/* ----------------------------------------------------------------------- */
/*     IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW */
/* ----------------------------------------------------------------------- */
L261:
    helim = *elim * .5;
    elm = exp(-(*elim));
    celmr = elm;
    ascle = bry[0];
    zdr = *zr;
    zdi = *zi;
    ic = -1;
    j = 2;
    i__1 = inu;
    for (i__ = 1; i__ <= i__1; ++i__) {
	str = s2r;
	sti = s2i;
	s2r = str * ckr - sti * cki + s1r;
	s2i = sti * ckr + str * cki + s1i;
	s1r = str;
	s1i = sti;
	ckr += rzr;
	cki += rzi;
	as = zabse_(&s2r, &s2i);
	alas = log(as);
	p2r = -zdr + alas;
	if(p2r < -(*elim)) {
	    goto L263;
	}
	zloge_(&s2r, &s2i, &str, &sti, &idum);
	p2r = -zdr + str;
	p2i = -zdi + sti;
	p2m = exp(p2r) / *tol;
	p1r = p2m * cos(p2i);
	p1i = p2m * sin(p2i);
	zuchk_(&p1r, &p1i, &nw, &ascle, tol);
	if(nw != 0) {
	    goto L263;
	}
	j = 3 - j;
	cyr[j - 1] = p1r;
	cyi[j - 1] = p1i;
	if(ic == i__ - 1) {
	    goto L264;
	}
	ic = i__;
	goto L262;
L263:
	if(alas < helim) {
	    goto L262;
	}
	zdr -= *elim;
	s1r *= celmr;
	s1i *= celmr;
	s2r *= celmr;
	s2i *= celmr;
L262:
	;
    }
    if(*n != 1) {
	goto L270;
    }
    s1r = s2r;
    s1i = s2i;
    goto L270;
L264:
    kflag = 1;
    inub = i__ + 1;
    s2r = cyr[j - 1];
    s2i = cyi[j - 1];
    j = 3 - j;
    s1r = cyr[j - 1];
    s1i = cyi[j - 1];
    if(inub <= inu) {
	goto L225;
    }
    if(*n != 1) {
	goto L240;
    }
    s1r = s2r;
    s1i = s2i;
    goto L240;
L270:
    yr[1] = s1r;
    yi[1] = s1i;
    if(*n == 1) {
	goto L280;
    }
    yr[2] = s2r;
    yi[2] = s2i;
L280:
    ascle = bry[0];
    zkscl_(&zdr, &zdi, fnu, n, &yr[1], &yi[1], nz, &rzr, &rzi, &ascle, tol, 
	    elim);
    inu = *n - *nz;
    if(inu <= 0) {
	return 0;
    }
    kk = *nz + 1;
    s1r = yr[kk];
    s1i = yi[kk];
    yr[kk] = s1r * csrr[0];
    yi[kk] = s1i * csrr[0];
    if(inu == 1) {
	return 0;
    }
    kk = *nz + 2;
    s2r = yr[kk];
    s2i = yi[kk];
    yr[kk] = s2r * csrr[0];
    yi[kk] = s2i * csrr[0];
    if(inu == 2) {
	return 0;
    }
    t2 = *fnu + (double) ((float) (kk - 1));
    ckr = t2 * rzr;
    cki = t2 * rzi;
    kflag = 1;
    goto L250;
L290:
/* ----------------------------------------------------------------------- */
/*     SCALE BY DEXP(Z), IFLAG = 1 CASES */
/* ----------------------------------------------------------------------- */
    koded = 2;
    iflag = 1;
    kflag = 2;
    goto L120;
/* ----------------------------------------------------------------------- */
/*     FNU=HALF ODD INTEGER CASE, DNU=-0.5 */
/* ----------------------------------------------------------------------- */
L300:
    s1r = coefr;
    s1i = coefi;
    s2r = coefr;
    s2i = coefi;
    goto L210;


L310:
    *nz = -2;
    return 0;
} /* zbknu_ */

/* ========================================================== */
/* Subroutine */ int zkscl_(double *zrr, double *zri, double *fnu,
	 int *n, double *yr, double *yi, int *nz, double *
	rzr, double *rzi, double *ascle, double *tol, double *
	elim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, ic;
    static double as, fn;
    static int kk, nn, nw;
    static double s1i, s2i, s1r, s2r, acs, cki, elm, csi, ckr, cyi[2], 
	    zdi, csr, cyr[2], zdr, str, alas;
    static int idum;
    static double helim, celmr;
    extern double zabse_(double *, double *);
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *), zuchk_(double *, double *, 
	    int *, double *, double *);

/* ***BEGIN PROLOGUE  ZKSCL */
/* ***REFER TO  ZBESK */

/*     SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE */
/*     ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN */
/*     RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. */

/* ***ROUTINES CALLED  ZUCHK,ZABSE,ZLOGE */
/* ***END PROLOGUE  ZKSCL */
/*     COMPLEX CK,CS,CY,CZERO,RZ,S1,S2,Y,ZR,ZD,CELM */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    *nz = 0;
    ic = 0;
    nn = min(2,*n);
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	s1r = yr[i__];
	s1i = yi[i__];
	cyr[i__ - 1] = s1r;
	cyi[i__ - 1] = s1i;
	as = zabse_(&s1r, &s1i);
	acs = -(*zrr) + log(as);
	++(*nz);
	yr[i__] = zeror;
	yi[i__] = zeroi;
	if(acs < -(*elim)) {
	    goto L10;
	}
	zloge_(&s1r, &s1i, &csr, &csi, &idum);
	csr -= *zrr;
	csi -= *zri;
	str = exp(csr) / *tol;
	csr = str * cos(csi);
	csi = str * sin(csi);
	zuchk_(&csr, &csi, &nw, ascle, tol);
	if(nw != 0) {
	    goto L10;
	}
	yr[i__] = csr;
	yi[i__] = csi;
	ic = i__;
	--(*nz);
L10:
	;
    }
    if(*n == 1) {
	return 0;
    }
    if(ic > 1) {
	goto L20;
    }
    yr[1] = zeror;
    yi[1] = zeroi;
    *nz = 2;
L20:
    if(*n == 2) {
	return 0;
    }
    if(*nz == 0) {
	return 0;
    }
    fn = *fnu + 1.;
    ckr = fn * *rzr;
    cki = fn * *rzi;
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    helim = *elim * .5;
    elm = exp(-(*elim));
    celmr = elm;
    zdr = *zrr;
    zdi = *zri;

/*     FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF */
/*     S2 GETS LARGER THAN EXP(ELIM/2) */

    i__1 = *n;
    for (i__ = 3; i__ <= i__1; ++i__) {
	kk = i__;
	csr = s2r;
	csi = s2i;
	s2r = ckr * csr - cki * csi + s1r;
	s2i = cki * csr + ckr * csi + s1i;
	s1r = csr;
	s1i = csi;
	ckr += *rzr;
	cki += *rzi;
	as = zabse_(&s2r, &s2i);
	alas = log(as);
	acs = -zdr + alas;
	++(*nz);
	yr[i__] = zeror;
	yi[i__] = zeroi;
	if(acs < -(*elim)) {
	    goto L25;
	}
	zloge_(&s2r, &s2i, &csr, &csi, &idum);
	csr -= zdr;
	csi -= zdi;
	str = exp(csr) / *tol;
	csr = str * cos(csi);
	csi = str * sin(csi);
	zuchk_(&csr, &csi, &nw, ascle, tol);
	if(nw != 0) {
	    goto L25;
	}
	yr[i__] = csr;
	yi[i__] = csi;
	--(*nz);
	if(ic == kk - 1) {
	    goto L40;
	}
	ic = kk;
	goto L30;
L25:
	if(alas < helim) {
	    goto L30;
	}
	zdr -= *elim;
	s1r *= celmr;
	s1i *= celmr;
	s2r *= celmr;
	s2i *= celmr;
L30:
	;
    }
    *nz = *n;
    if(ic == *n) {
	*nz = *n - 1;
    }
    goto L45;
L40:
    *nz = kk - 2;
L45:
    i__1 = *nz;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L50: */
    }
    return 0;
} /* zkscl_ */

/* ========================================================== */
/* Subroutine */ int zshch_(double *zr, double *zi, double *cshr, 
	double *cshi, double *cchr, double *cchi)
{
    /* Local variables */
    static double ch, cn, sh, sn;

/* ***BEGIN PROLOGUE  ZSHCH */
/* ***REFER TO  ZBESK,ZBESH */

/*     ZSHCH COMPUTES THE COMPLEX HYPERBOLIC FUNCTIONS CSH=SINH(X+I*Y) */
/*     AND CCH=COSH(X+I*Y), WHERE I**2=-1. */

/* ***ROUTINES CALLED  (NONE) */
/* ***END PROLOGUE  ZSHCH */

    sh = sinh(*zr);
    ch = cosh(*zr);
    sn = sin(*zi);
    cn = cos(*zi);
    *cshr = sh * cn;
    *cshi = ch * sn;
    *cchr = ch * cn;
    *cchi = sh * sn;
    return 0;
} /* zshch_ */

/* ========================================================== */
/* Subroutine */ int zrati_(double *zr, double *zi, double *fnu, 
	int *n, double *cyr, double *cyi, double *tol)
{
    /* Initialized data */

    static double czeror = 0.;
    static double czeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;
    static double rt2 = 1.41421356237309505;

    /* System generated locals */
    int i__1;
    double d__1;

    /* Local variables */
    static int i__, k;
    static double ak;
    static int id, kk;
    static double az, ap1, ap2, p1i, p2i, t1i, p1r, p2r, t1r, arg, rak, 
	    rho;
    static int inu;
    static double pti, tti, rzi, ptr, ttr, rzr, rap1, flam, dfnu, fdnu;
    static int magz, idnu;
    static double fnup;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *);
    static double test, test1, amagz;
    extern double zabse_(double *, double *);
    static int itime;
    static double cdfnui, cdfnur;

/* ***BEGIN PROLOGUE  ZRATI */
/* ***REFER TO  ZBESI,ZBESK,ZBESH */

/*     ZRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD */
/*     RECURRENCE.  THE STARTING INDEX IS DETERMINED BY FORWARD */
/*     RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B, */
/*     MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973, */
/*     BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER, */
/*     BY D. J. SOOKNE. */

/* ***ROUTINES CALLED  ZABSE,ZDIV */
/* ***END PROLOGUE  ZRATI */
/*     COMPLEX Z,CY(1),CONE,CZERO,P1,P2,T1,RZ,PT,CDFNU */
    /* Parameter adjustments */
    --cyi;
    --cyr;

    /* Function Body */
    az = zabse_(zr, zi);
    inu = (int) ((float) (*fnu));
    idnu = inu + *n - 1;
    magz = (int) ((float) az);
    amagz = (double) ((float) (magz + 1));
    fdnu = (double) ((float) idnu);
    fnup = max(amagz,fdnu);
    id = idnu - magz - 1;
    itime = 1;
    k = 1;
    ptr = 1. / az;
    rzr = ptr * (*zr + *zr) * ptr;
    rzi = -ptr * (*zi + *zi) * ptr;
    t1r = rzr * fnup;
    t1i = rzi * fnup;
    p2r = -t1r;
    p2i = -t1i;
    p1r = coner;
    p1i = conei;
    t1r += rzr;
    t1i += rzi;
    if(id > 0) {
	id = 0;
    }
    ap2 = zabse_(&p2r, &p2i);
    ap1 = zabse_(&p1r, &p1i);
/* ----------------------------------------------------------------------- */
/*     THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNU */
/*     GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT */
/*     P2 VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR */
/*     PREMATURELY. */
/* ----------------------------------------------------------------------- */
    arg = (ap2 + ap2) / (ap1 * *tol);
    test1 = sqrt(arg);
    test = test1;
    rap1 = 1. / ap1;
    p1r *= rap1;
    p1i *= rap1;
    p2r *= rap1;
    p2i *= rap1;
    ap2 *= rap1;
L10:
    ++k;
    ap1 = ap2;
    ptr = p2r;
    pti = p2i;
    p2r = p1r - (t1r * ptr - t1i * pti);
    p2i = p1i - (t1r * pti + t1i * ptr);
    p1r = ptr;
    p1i = pti;
    t1r += rzr;
    t1i += rzi;
    ap2 = zabse_(&p2r, &p2i);
    if(ap1 <= test) {
	goto L10;
    }
    if(itime == 2) {
	goto L20;
    }
    ak = zabse_(&t1r, &t1i) * .5;
    flam = ak + sqrt(ak * ak - 1.);
/* Computing MIN */
    d__1 = ap2 / ap1;
    rho = min(d__1,flam);
    test = test1 * sqrt(rho / (rho * rho - 1.));
    itime = 2;
    goto L10;
L20:
    kk = k + 1 - id;
    ak = (double) ((float) kk);
    t1r = ak;
    t1i = czeroi;
    dfnu = *fnu + (double) ((float) (*n - 1));
    p1r = 1. / ap2;
    p1i = czeroi;
    p2r = czeror;
    p2i = czeroi;
    i__1 = kk;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ptr = p1r;
	pti = p1i;
	rap1 = dfnu + t1r;
	ttr = rzr * rap1;
	tti = rzi * rap1;
	p1r = ptr * ttr - pti * tti + p2r;
	p1i = ptr * tti + pti * ttr + p2i;
	p2r = ptr;
	p2i = pti;
	t1r -= coner;
/* L30: */
    }
    if(p1r != czeror || p1i != czeroi) {
	goto L40;
    }
    p1r = *tol;
    p1i = *tol;
L40:
    zdiv_(&p2r, &p2i, &p1r, &p1i, &cyr[*n], &cyi[*n]);
    if(*n == 1) {
	return 0;
    }
    k = *n - 1;
    ak = (double) ((float) k);
    t1r = ak;
    t1i = czeroi;
    cdfnur = *fnu * rzr;
    cdfnui = *fnu * rzi;
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ptr = cdfnur + (t1r * rzr - t1i * rzi) + cyr[k + 1];
	pti = cdfnui + (t1r * rzi + t1i * rzr) + cyi[k + 1];
	ak = zabse_(&ptr, &pti);
	if(ak != czeror) {
	    goto L50;
	}
	ptr = *tol;
	pti = *tol;
	ak = *tol * rt2;
L50:
	rak = coner / ak;
	cyr[k] = rak * ptr * rak;
	cyi[k] = -rak * pti * rak;
	t1r -= coner;
	--k;
/* L60: */
    }
    return 0;
} /* zrati_ */

/* ========================================================== */
/* Subroutine */ int zs1s2_(double *zrr, double *zri, double *s1r,
	 double *s1i, double *s2r, double *s2i, int *nz, 
	double *ascle, double *alim, int *iuf)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;

    /* Local variables */
    static double aa, c1i, as1, as2, c1r, aln, s1di, s1dr;
    static int idum;
    extern double zabse_(double *, double *);
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *), zexpe_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZS1S2 */
/* ***REFER TO  ZBESK,ZAIRY */

/*     ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE */
/*     ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- */
/*     TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. */
/*     ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF */
/*     MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER */
/*     OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE */
/*     PRECISION ABOVE THE UNDERFLOW LIMIT. */

/* ***ROUTINES CALLED  ZABSE,ZEXPE,ZLOGE */
/* ***END PROLOGUE  ZS1S2 */
/*     COMPLEX CZERO,C1,S1,S1D,S2,ZR */
    *nz = 0;
    as1 = zabse_(s1r, s1i);
    as2 = zabse_(s2r, s2i);
    if(*s1r == 0. && *s1i == 0.) {
	goto L10;
    }
    if(as1 == 0.) {
	goto L10;
    }
    aln = -(*zrr) - *zrr + log(as1);
    s1dr = *s1r;
    s1di = *s1i;
    *s1r = zeror;
    *s1i = zeroi;
    as1 = zeror;
    if(aln < -(*alim)) {
	goto L10;
    }
    zloge_(&s1dr, &s1di, &c1r, &c1i, &idum);
    c1r = c1r - *zrr - *zrr;
    c1i = c1i - *zri - *zri;
    zexpe_(&c1r, &c1i, s1r, s1i);
    as1 = zabse_(s1r, s1i);
    ++(*iuf);
L10:
    aa = max(as1,as2);
    if(aa > *ascle) {
	return 0;
    }
    *s1r = zeror;
    *s1i = zeroi;
    *s2r = zeror;
    *s2i = zeroi;
    *nz = 1;
    *iuf = 0;
    return 0;
} /* zs1s2_ */

/* ========================================================== */
/* Subroutine */ int zbunk_(double *zr, double *zi, double *fnu, 
	int *kode, int *mr, int *n, double *yr, double *
	yi, int *nz, double *tol, double *elim, double *alim)
{
    static double ax, ay;
    extern /* Subroutine */ int zunk1_(double *, double *, double 
	    *, int *, int *, int *, double *, double *, 
	    int *, double *, double *, double *), zunk2_(
	    double *, double *, double *, int *, int *, 
	    int *, double *, double *, int *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZBUNK */
/* ***REFER TO  ZBESK,ZBESH */

/*     ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL. */
/*     ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z) */
/*     IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2 */

/* ***ROUTINES CALLED  ZUNK1,ZUNK2 */
/* ***END PROLOGUE  ZBUNK */
/*     COMPLEX Y,Z */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    *nz = 0;
    ax = abs(*zr) * 1.7321;
    ay = abs(*zi);
    if(ay > ax) {
	goto L10;
    }
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR K(FNU,Z) FOR LARGE FNU APPLIED IN */
/*     -PI/3.LE.ARG(Z).LE.PI/3 */
/* ----------------------------------------------------------------------- */
    zunk1_(zr, zi, fnu, kode, mr, n, &yr[1], &yi[1], nz, tol, elim, alim);
    goto L20;
L10:
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR H(2,FNU,Z*EXP(M*HPI)) FOR LARGE FNU */
/*     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I */
/*     AND HPI=PI/2 */
/* ----------------------------------------------------------------------- */
    zunk2_(zr, zi, fnu, kode, mr, n, &yr[1], &yi[1], nz, tol, elim, alim);
L20:
    return 0;
} /* zbunk_ */

/* ========================================================== */
/* Subroutine */ int zmlri_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, double *tol)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1, i__2;
    double d__1, d__2, d__3;

    /* Local variables */
    static int i__, k, m;
    static double ak, bk, ap, at;
    static int kk, km;
    static double az, p1i, p2i, p1r, p2r, ack, cki, fnf, fkk, ckr;
    static int iaz;
    static double rho;
    static int inu;
    static double pti, raz, sti, rzi, ptr, str, tst, rzr, rho2, flam, 
	    fkap, scle, tfnf;
    static int idum, ifnu;
    static double sumi, sumr;
    extern /* Subroutine */ int zmlt_(double *, double *, double *
	    , double *, double *, double *);
    extern double zabse_(double *, double *);
    static int itime;
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *), zexpe_(double *, double *, 
	    double *, double *);
    extern double d1mach_(int *), dgamln_(double *, int *);
    static double cnormi, cnormr;

/* ***BEGIN PROLOGUE  ZMLRI */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE */
/*     MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. */

/* ***ROUTINES CALLED  DGAMLN,D1MACH,ZABSE,ZEXPE,ZLOGE,ZMLT */
/* ***END PROLOGUE  ZMLRI */
/*     COMPLEX CK,CNORM,CONE,CTWO,CZERO,PT,P1,P2,RZ,SUM,Y,Z */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    scle = d1mach_(&c__1) / *tol;
    *nz = 0;
    az = zabse_(zr, zi);
    iaz = (int) ((float) az);
    ifnu = (int) ((float) (*fnu));
    inu = ifnu + *n - 1;
    at = (double) ((float) iaz) + 1.;
    raz = 1. / az;
    str = *zr * raz;
    sti = -(*zi) * raz;
    ckr = str * at * raz;
    cki = sti * at * raz;
    rzr = (str + str) * raz;
    rzi = (sti + sti) * raz;
    p1r = zeror;
    p1i = zeroi;
    p2r = coner;
    p2i = conei;
    ack = (at + 1.) * raz;
    rho = ack + sqrt(ack * ack - 1.);
    rho2 = rho * rho;
    tst = (rho2 + rho2) / ((rho2 - 1.) * (rho - 1.));
    tst /= *tol;
/* ----------------------------------------------------------------------- */
/*     COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES */
/* ----------------------------------------------------------------------- */
    ak = at;
    for (i__ = 1; i__ <= 80; ++i__) {
	ptr = p2r;
	pti = p2i;
	p2r = p1r - (ckr * ptr - cki * pti);
	p2i = p1i - (cki * ptr + ckr * pti);
	p1r = ptr;
	p1i = pti;
	ckr += rzr;
	cki += rzi;
	ap = zabse_(&p2r, &p2i);
	if(ap > tst * ak * ak) {
	    goto L20;
	}
	ak += 1.;
/* L10: */
    }
    goto L110;
L20:
    ++i__;
    k = 0;
    if(inu < iaz) {
	goto L40;
    }
/* ----------------------------------------------------------------------- */
/*     COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS */
/* ----------------------------------------------------------------------- */
    p1r = zeror;
    p1i = zeroi;
    p2r = coner;
    p2i = conei;
    at = (double) ((float) inu) + 1.;
    str = *zr * raz;
    sti = -(*zi) * raz;
    ckr = str * at * raz;
    cki = sti * at * raz;
    ack = at * raz;
    tst = sqrt(ack / *tol);
    itime = 1;
    for (k = 1; k <= 80; ++k) {
	ptr = p2r;
	pti = p2i;
	p2r = p1r - (ckr * ptr - cki * pti);
	p2i = p1i - (ckr * pti + cki * ptr);
	p1r = ptr;
	p1i = pti;
	ckr += rzr;
	cki += rzi;
	ap = zabse_(&p2r, &p2i);
	if(ap < tst) {
	    goto L30;
	}
	if(itime == 2) {
	    goto L40;
	}
	ack = zabse_(&ckr, &cki);
	flam = ack + sqrt(ack * ack - 1.);
	fkap = ap / zabse_(&p1r, &p1i);
	rho = min(flam,fkap);
	tst *= sqrt(rho / (rho * rho - 1.));
	itime = 2;
L30:
	;
    }
    goto L110;
L40:
/* ----------------------------------------------------------------------- */
/*     BACKWARD RECURRENCE AND SUM NORMALIZING RELATION */
/* ----------------------------------------------------------------------- */
    ++k;
/* Computing MAX */
    i__1 = i__ + iaz, i__2 = k + inu;
    kk = max(i__1,i__2);
    fkk = (double) ((float) kk);
    p1r = zeror;
    p1i = zeroi;
/* ----------------------------------------------------------------------- */
/*     SCALE P2 AND SUM BY SCLE */
/* ----------------------------------------------------------------------- */
    p2r = scle;
    p2i = zeroi;
    fnf = *fnu - (double) ((float) ifnu);
    tfnf = fnf + fnf;
    d__1 = fkk + tfnf + 1.;
    d__2 = fkk + 1.;
    d__3 = tfnf + 1.;
    bk = dgamln_(&d__1, &idum) - dgamln_(&d__2, &idum) - dgamln_(&d__3, &idum)
	    ;
    bk = exp(bk);
    sumr = zeror;
    sumi = zeroi;
    km = kk - inu;
    i__1 = km;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ptr = p2r;
	pti = p2i;
	p2r = p1r + (fkk + fnf) * (rzr * ptr - rzi * pti);
	p2i = p1i + (fkk + fnf) * (rzi * ptr + rzr * pti);
	p1r = ptr;
	p1i = pti;
	ak = 1. - tfnf / (fkk + tfnf);
	ack = bk * ak;
	sumr += (ack + bk) * p1r;
	sumi += (ack + bk) * p1i;
	bk = ack;
	fkk += -1.;
/* L50: */
    }
    yr[*n] = p2r;
    yi[*n] = p2i;
    if(*n == 1) {
	goto L70;
    }
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ptr = p2r;
	pti = p2i;
	p2r = p1r + (fkk + fnf) * (rzr * ptr - rzi * pti);
	p2i = p1i + (fkk + fnf) * (rzi * ptr + rzr * pti);
	p1r = ptr;
	p1i = pti;
	ak = 1. - tfnf / (fkk + tfnf);
	ack = bk * ak;
	sumr += (ack + bk) * p1r;
	sumi += (ack + bk) * p1i;
	bk = ack;
	fkk += -1.;
	m = *n - i__ + 1;
	yr[m] = p2r;
	yi[m] = p2i;
/* L60: */
    }
L70:
    if(ifnu <= 0) {
	goto L90;
    }
    i__1 = ifnu;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ptr = p2r;
	pti = p2i;
	p2r = p1r + (fkk + fnf) * (rzr * ptr - rzi * pti);
	p2i = p1i + (fkk + fnf) * (rzr * pti + rzi * ptr);
	p1r = ptr;
	p1i = pti;
	ak = 1. - tfnf / (fkk + tfnf);
	ack = bk * ak;
	sumr += (ack + bk) * p1r;
	sumi += (ack + bk) * p1i;
	bk = ack;
	fkk += -1.;
/* L80: */
    }
L90:
    ptr = *zr;
    pti = *zi;
    if(*kode == 2) {
	ptr = zeror;
    }
    zloge_(&rzr, &rzi, &str, &sti, &idum);
    p1r = -fnf * str + ptr;
    p1i = -fnf * sti + pti;
    d__1 = fnf + 1.;
    ap = dgamln_(&d__1, &idum);
    ptr = p1r - ap;
    pti = p1i;
/* ----------------------------------------------------------------------- */
/*     THE DIVISION CEXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW */
/*     IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES */
/* ----------------------------------------------------------------------- */
    p2r += sumr;
    p2i += sumi;
    ap = zabse_(&p2r, &p2i);
    p1r = 1. / ap;
    zexpe_(&ptr, &pti, &str, &sti);
    ckr = str * p1r;
    cki = sti * p1r;
    ptr = p2r * p1r;
    pti = -p2i * p1r;
    zmlt_(&ckr, &cki, &ptr, &pti, &cnormr, &cnormi);
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	str = yr[i__] * cnormr - yi[i__] * cnormi;
	yi[i__] = yr[i__] * cnormi + yi[i__] * cnormr;
	yr[i__] = str;
/* L100: */
    }
    return 0;
L110:
    *nz = -2;
    return 0;
} /* zmlri_ */

/* ========================================================== */
/* Subroutine */ int zwrsk_(double *zrr, double *zri, double *fnu,
	 int *kode, int *n, double *yr, double *yi, int *
	nz, double *cwr, double *cwi, double *tol, double *
	elim, double *alim)
{
    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, nw;
    static double c1i, c2i, c1r, c2r, act, acw, cti, ctr, pti, sti, ptr, 
	    str, ract, ascle;
    extern double zabse_(double *, double *);
    static double csclr, cinui, cinur;
    extern /* Subroutine */ int zbknu_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *, double *, double *), zrati_(double *, 
	    double *, double *, int *, double *, double *,
	     double *);
    extern double d1mach_(int *);

/* ***BEGIN PROLOGUE  ZWRSK */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY */
/*     NORMALIZING THE I FUNCTION RATIOS FROM ZRATI BY THE WRONSKIAN */

/* ***ROUTINES CALLED  D1MACH,ZBKNU,ZRATI,ZABSE */
/* ***END PROLOGUE  ZWRSK */
/*     COMPLEX CINU,CSCL,CT,CW,C1,C2,RCT,ST,Y,ZR */
/* ----------------------------------------------------------------------- */
/*     I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS */
/*     Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE */
/*     WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU. */
/* ----------------------------------------------------------------------- */
    /* Parameter adjustments */
    --yi;
    --yr;
    --cwr;
    --cwi;

    /* Function Body */
    *nz = 0;
    zbknu_(zrr, zri, fnu, kode, &c__2, &cwr[1], &cwi[1], &nw, tol, elim, alim)
	    ;
    if(nw != 0) {
	goto L50;
    }
    zrati_(zrr, zri, fnu, n, &yr[1], &yi[1], tol);
/* ----------------------------------------------------------------------- */
/*     RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z), */
/*     R(FNU+J-1,Z)=Y(J),  J=1,...,N */
/* ----------------------------------------------------------------------- */
    cinur = 1.;
    cinui = 0.;
    if(*kode == 1) {
	goto L10;
    }
    cinur = cos(*zri);
    cinui = sin(*zri);
L10:
/* ----------------------------------------------------------------------- */
/*     ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH */
/*     THE UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE */
/*     SCALED TO PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT */
/*     THE RESULT IS ON SCALE. */
/* ----------------------------------------------------------------------- */
    acw = zabse_(&cwr[2], &cwi[2]);
    ascle = d1mach_(&c__1) * 1e3 / *tol;
    csclr = 1.;
    if(acw > ascle) {
	goto L20;
    }
    csclr = 1. / *tol;
    goto L30;
L20:
    ascle = 1. / ascle;
    if(acw < ascle) {
	goto L30;
    }
    csclr = *tol;
L30:
    c1r = cwr[1] * csclr;
    c1i = cwi[1] * csclr;
    c2r = cwr[2] * csclr;
    c2i = cwi[2] * csclr;
    str = yr[1];
    sti = yi[1];
/* ----------------------------------------------------------------------- */
/*     CINU=CINU*(CONJG(CT)/CABS(CT))*(1.0D0/CABS(CT) PREVENTS */
/*     UNDER- OR OVERFLOW PREMATURELY BY SQUARING CABS(CT) */
/* ----------------------------------------------------------------------- */
    ptr = str * c1r - sti * c1i;
    pti = str * c1i + sti * c1r;
    ptr += c2r;
    pti += c2i;
    ctr = *zrr * ptr - *zri * pti;
    cti = *zrr * pti + *zri * ptr;
    act = zabse_(&ctr, &cti);
    ract = 1. / act;
    ctr *= ract;
    cti = -cti * ract;
    ptr = cinur * ract;
    pti = cinui * ract;
    cinur = ptr * ctr - pti * cti;
    cinui = ptr * cti + pti * ctr;
    yr[1] = cinur * csclr;
    yi[1] = cinui * csclr;
    if(*n == 1) {
	return 0;
    }
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ptr = str * cinur - sti * cinui;
	cinui = str * cinui + sti * cinur;
	cinur = ptr;
	str = yr[i__];
	sti = yi[i__];
	yr[i__] = cinur * csclr;
	yi[i__] = cinui * csclr;
/* L40: */
    }
    return 0;
L50:
    *nz = -1;
    if(nw == -2) {
	*nz = -2;
    }
    return 0;
} /* zwrsk_ */

/* ========================================================== */
/* Subroutine */ int zseri_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, double *tol, double *elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, k, l, m;
    static double s, aa;
    static int ib;
    static double ak;
    static int il;
    static double az;
    static int nn;
    static double wi[2], rs, ss;
    static int nw;
    static double wr[2], s1i, s2i, s1r, s2r, cki, acz, arm, ckr, czi, hzi,
	     raz, czr, sti, hzr, rzi, str, rzr, ak1i, ak1r, rtr1, dfnu;
    static int idum;
    static double atol, fnup;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *), zmlt_(double *, 
	    double *, double *, double *, double *, 
	    double *);
    static int iflag;
    static double coefi, ascle, coefr;
    extern double zabse_(double *, double *);
    static double crscr;
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *), zuchk_(double *, double *, 
	    int *, double *, double *);
    extern double d1mach_(int *), dgamln_(double *, int *);

/* ***BEGIN PROLOGUE  ZSERI */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY */
/*     MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE */
/*     REGION CABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN. */
/*     NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO */
/*     DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE */
/*     CONDITION CABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE */
/*     COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). */

/* ***ROUTINES CALLED  DGAMLN,D1MACH,ZUCHK,ZABSE,ZDIV,ZLOGE,ZMLT */
/* ***END PROLOGUE  ZSERI */
/*     COMPLEX AK1,CK,COEF,CONE,CRSC,CSCL,CZ,CZERO,HZ,RZ,S1,S2,Y,Z */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    *nz = 0;
    az = zabse_(zr, zi);
    if(az == 0.) {
	goto L160;
    }
    arm = d1mach_(&c__1) * 1e3;
    rtr1 = sqrt(arm);
    crscr = 1.;
    iflag = 0;
    if(az < arm) {
	goto L150;
    }
    hzr = *zr * .5;
    hzi = *zi * .5;
    czr = zeror;
    czi = zeroi;
    if(az <= rtr1) {
	goto L10;
    }
    zmlt_(&hzr, &hzi, &hzr, &hzi, &czr, &czi);
L10:
    acz = zabse_(&czr, &czi);
    nn = *n;
    zloge_(&hzr, &hzi, &ckr, &cki, &idum);
L20:
    dfnu = *fnu + (double) ((float) (nn - 1));
    fnup = dfnu + 1.;
/* ----------------------------------------------------------------------- */
/*     UNDERFLOW TEST */
/* ----------------------------------------------------------------------- */
    ak1r = ckr * dfnu;
    ak1i = cki * dfnu;
    ak = dgamln_(&fnup, &idum);
    ak1r -= ak;
    if(*kode == 2) {
	ak1r -= *zr;
    }
    if(ak1r > -(*elim)) {
	goto L40;
    }
L30:
    ++(*nz);
    yr[nn] = zeror;
    yi[nn] = zeroi;
    if(acz > dfnu) {
	goto L190;
    }
    --nn;
    if(nn == 0) {
	return 0;
    }
    goto L20;
L40:
    if(ak1r > -(*alim)) {
	goto L50;
    }
    iflag = 1;
    ss = 1. / *tol;
    crscr = *tol;
    ascle = arm * ss;
L50:
    aa = exp(ak1r);
    if(iflag == 1) {
	aa *= ss;
    }
    coefr = aa * cos(ak1i);
    coefi = aa * sin(ak1i);
    atol = *tol * acz / fnup;
    il = min(2,nn);
    i__1 = il;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dfnu = *fnu + (double) ((float) (nn - i__));
	fnup = dfnu + 1.;
	s1r = coner;
	s1i = conei;
	if(acz < *tol * fnup) {
	    goto L70;
	}
	ak1r = coner;
	ak1i = conei;
	ak = fnup + 2.;
	s = fnup;
	aa = 2.;
L60:
	rs = 1. / s;
	str = ak1r * czr - ak1i * czi;
	sti = ak1r * czi + ak1i * czr;
	ak1r = str * rs;
	ak1i = sti * rs;
	s1r += ak1r;
	s1i += ak1i;
	s += ak;
	ak += 2.;
	aa = aa * acz * rs;
	if(aa > atol) {
	    goto L60;
	}
L70:
	s2r = s1r * coefr - s1i * coefi;
	s2i = s1r * coefi + s1i * coefr;
	wr[i__ - 1] = s2r;
	wi[i__ - 1] = s2i;
	if(iflag == 0) {
	    goto L80;
	}
	zuchk_(&s2r, &s2i, &nw, &ascle, tol);
	if(nw != 0) {
	    goto L30;
	}
L80:
	m = nn - i__ + 1;
	yr[m] = s2r * crscr;
	yi[m] = s2i * crscr;
	if(i__ == il) {
	    goto L90;
	}
	zdiv_(&coefr, &coefi, &hzr, &hzi, &str, &sti);
	coefr = str * dfnu;
	coefi = sti * dfnu;
L90:
	;
    }
    if(nn <= 2) {
	return 0;
    }
    k = nn - 2;
    ak = (double) ((float) k);
    raz = 1. / az;
    str = *zr * raz;
    sti = -(*zi) * raz;
    rzr = (str + str) * raz;
    rzi = (sti + sti) * raz;
    if(iflag == 1) {
	goto L120;
    }
    ib = 3;
L100:
    i__1 = nn;
    for (i__ = ib; i__ <= i__1; ++i__) {
	yr[k] = (ak + *fnu) * (rzr * yr[k + 1] - rzi * yi[k + 1]) + yr[k + 2];
	yi[k] = (ak + *fnu) * (rzr * yi[k + 1] + rzi * yr[k + 1]) + yi[k + 2];
	ak += -1.;
	--k;
/* L110: */
    }
    return 0;
/* ----------------------------------------------------------------------- */
/*     RECUR BACKWARD WITH SCALED VALUES */
/* ----------------------------------------------------------------------- */
L120:
/* ----------------------------------------------------------------------- */
/*     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE */
/*     UNDERFLOW LIMIT = ASCLE = D1MACH(1)*SS*1.0D+3 */
/* ----------------------------------------------------------------------- */
    s1r = wr[0];
    s1i = wi[0];
    s2r = wr[1];
    s2i = wi[1];
    i__1 = nn;
    for (l = 3; l <= i__1; ++l) {
	ckr = s2r;
	cki = s2i;
	s2r = s1r + (ak + *fnu) * (rzr * ckr - rzi * cki);
	s2i = s1i + (ak + *fnu) * (rzr * cki + rzi * ckr);
	s1r = ckr;
	s1i = cki;
	ckr = s2r * crscr;
	cki = s2i * crscr;
	yr[k] = ckr;
	yi[k] = cki;
	ak += -1.;
	--k;
	if(zabse_(&ckr, &cki) > ascle) {
	    goto L140;
	}
/* L130: */
    }
    return 0;
L140:
    ib = l + 1;
    if(ib > nn) {
	return 0;
    }
    goto L100;
L150:
    *nz = *n;
    if(*fnu == 0.) {
	--(*nz);
    }
L160:
    yr[1] = zeror;
    yi[1] = zeroi;
    if(*fnu != 0.) {
	goto L170;
    }
    yr[1] = coner;
    yi[1] = conei;
L170:
    if(*n == 1) {
	return 0;
    }
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L180: */
    }
    return 0;
/* ----------------------------------------------------------------------- */
/*     RETURN WITH NZ.LT.0 IF CABS(Z*Z/4).GT.FNU+N-NZ-1 COMPLETE */
/*     THE CALCULATION IN CBINU WITH N=N-IABS(NZ) */
/* ----------------------------------------------------------------------- */
L190:
    *nz = -(*nz);
    return 0;
} /* zseri_ */

/* ========================================================== */
/* Subroutine */ int zasyi_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, double *rl, double *tol, double *elim, double *
	alim)
{
    /* Initialized data */

    static double pi = 3.14159265358979324;
    static double rtpi = .159154943091895336;
    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1, i__2;
    double d__1, d__2;

    /* Local variables */
    static int i__, j, k, m;
    static double s, aa, bb;
    static int ib;
    static double ak, bk;
    static int il, jl;
    static double az;
    static int nn;
    static double p1i, s2i, p1r, s2r, cki, dki, fdn, arg, aez, arm, ckr, 
	    dkr, czi, ezi, sgn;
    static int inu;
    static double raz, czr, ezr, sqk, sti, rzi, tzi, str, rzr, tzr, ak1i, 
	    ak1r, cs1i, cs2i, cs1r, cs2r, dnu2, rtr1, dfnu, atol;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *), zmlt_(double *, 
	    double *, double *, double *, double *, 
	    double *);
    static int koded;
    extern double zabse_(double *, double *);
    extern /* Subroutine */ int zexpe_(double *, double *, double 
	    *, double *);
    extern double d1mach_(int *);
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZASYI */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY */
/*     MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE */
/*     REGION CABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN. */
/*     NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1. */

/* ***ROUTINES CALLED  D1MACH,ZABSE,ZDIV,ZEXPE,ZMLT,ZSQRTE */
/* ***END PROLOGUE  ZASYI */
/*     COMPLEX AK1,CK,CONE,CS1,CS2,CZ,CZERO,DK,EZ,P1,RZ,S2,Y,Z */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    *nz = 0;
    az = zabse_(zr, zi);
    arm = d1mach_(&c__1) * 1e3;
    rtr1 = sqrt(arm);
    il = min(2,*n);
    dfnu = *fnu + (double) ((float) (*n - il));
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST */
/* ----------------------------------------------------------------------- */
    raz = 1. / az;
    str = *zr * raz;
    sti = -(*zi) * raz;
    ak1r = rtpi * str * raz;
    ak1i = rtpi * sti * raz;
    zsqrte_(&ak1r, &ak1i, &ak1r, &ak1i);
    czr = *zr;
    czi = *zi;
    if(*kode != 2) {
	goto L10;
    }
    czr = zeror;
    czi = *zi;
L10:
    if(abs(czr) > *elim) {
	goto L100;
    }
    dnu2 = dfnu + dfnu;
    koded = 1;
    if(abs(czr) > *alim && *n > 2) {
	goto L20;
    }
    koded = 0;
    zexpe_(&czr, &czi, &str, &sti);
    zmlt_(&ak1r, &ak1i, &str, &sti, &ak1r, &ak1i);
L20:
    fdn = 0.;
    if(dnu2 > rtr1) {
	fdn = dnu2 * dnu2;
    }
    ezr = *zr * 8.;
    ezi = *zi * 8.;
/* ----------------------------------------------------------------------- */
/*     WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE RELATIVE TO THE */
/*     FIRST RECIPROCAL POWER SINCE THIS IS THE LEADING TERM OF THE */
/*     EXPANSION FOR THE IMAGINARY PART. */
/* ----------------------------------------------------------------------- */
    aez = az * 8.;
    s = *tol / aez;
    jl = (int) ((float) (*rl + *rl)) + 2;
    p1r = zeror;
    p1i = zeroi;
    if(*zi == 0.) {
	goto L30;
    }
/* ----------------------------------------------------------------------- */
/*     CALCULATE EXP(PI*(0.5+FNU+N-IL)*I) TO MINIMIZE LOSSES OF */
/*     SIGNIFICANCE WHEN FNU OR N IS LARGE */
/* ----------------------------------------------------------------------- */
    inu = (int) ((float) (*fnu));
    arg = (*fnu - (double) ((float) inu)) * pi;
    inu = inu + *n - il;
    ak = -sin(arg);
    bk = cos(arg);
    if(*zi < 0.) {
	bk = -bk;
    }
    p1r = ak;
    p1i = bk;
    if(inu % 2 == 0) {
	goto L30;
    }
    p1r = -p1r;
    p1i = -p1i;
L30:
    i__1 = il;
    for (k = 1; k <= i__1; ++k) {
	sqk = fdn - 1.;
	atol = s * abs(sqk);
	sgn = 1.;
	cs1r = coner;
	cs1i = conei;
	cs2r = coner;
	cs2i = conei;
	ckr = coner;
	cki = conei;
	ak = 0.;
	aa = 1.;
	bb = aez;
	dkr = ezr;
	dki = ezi;
	i__2 = jl;
	for (j = 1; j <= i__2; ++j) {
	    zdiv_(&ckr, &cki, &dkr, &dki, &str, &sti);
	    ckr = str * sqk;
	    cki = sti * sqk;
	    cs2r += ckr;
	    cs2i += cki;
	    sgn = -sgn;
	    cs1r += ckr * sgn;
	    cs1i += cki * sgn;
	    dkr += ezr;
	    dki += ezi;
	    aa = aa * abs(sqk) / bb;
	    bb += aez;
	    ak += 8.;
	    sqk -= ak;
	    if(aa <= atol) {
		goto L50;
	    }
/* L40: */
	}
	goto L110;
L50:
	s2r = cs1r;
	s2i = cs1i;
	if(*zr + *zr >= *elim) {
	    goto L60;
	}
	tzr = *zr + *zr;
	tzi = *zi + *zi;
	d__1 = -tzr;
	d__2 = -tzi;
	zexpe_(&d__1, &d__2, &str, &sti);
	zmlt_(&str, &sti, &p1r, &p1i, &str, &sti);
	zmlt_(&str, &sti, &cs2r, &cs2i, &str, &sti);
	s2r += str;
	s2i += sti;
L60:
	fdn = fdn + dfnu * 8. + 4.;
	p1r = -p1r;
	p1i = -p1i;
	m = *n - il + k;
	yr[m] = s2r * ak1r - s2i * ak1i;
	yi[m] = s2r * ak1i + s2i * ak1r;
/* L70: */
    }
    if(*n <= 2) {
	return 0;
    }
    nn = *n;
    k = nn - 2;
    ak = (double) ((float) k);
    str = *zr * raz;
    sti = -(*zi) * raz;
    rzr = (str + str) * raz;
    rzi = (sti + sti) * raz;
    ib = 3;
    i__1 = nn;
    for (i__ = ib; i__ <= i__1; ++i__) {
	yr[k] = (ak + *fnu) * (rzr * yr[k + 1] - rzi * yi[k + 1]) + yr[k + 2];
	yi[k] = (ak + *fnu) * (rzr * yi[k + 1] + rzi * yr[k + 1]) + yi[k + 2];
	ak += -1.;
	--k;
/* L80: */
    }
    if(koded == 0) {
	return 0;
    }
    zexpe_(&czr, &czi, &ckr, &cki);
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	str = yr[i__] * ckr - yi[i__] * cki;
	yi[i__] = yr[i__] * cki + yi[i__] * ckr;
	yr[i__] = str;
/* L90: */
    }
    return 0;
L100:
    *nz = -1;
    return 0;
L110:
    *nz = -2;
    return 0;
} /* zasyi_ */

/* ========================================================== */
/* Subroutine */ int zuoik_(double *zr, double *zi, double *fnu, 
	int *kode, int *ikflg, int *n, double *yr, double 
	*yi, int *nuf, double *tol, double *elim, double *
	alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double aic = 1.265512123484645396;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__;
    static double ax, ay;
    static int nn, nw;
    static double fnn, gnn, zbi, czi, gnu, zbr, czr, rcz, sti, zni, zri, 
	    str, znr, zrr, aarg, aphi, argi, phii, argr;
    static int idum;
    static double phir;
    static int init;
    static double sumi, sumr, ascle;
    extern double zabse_(double *, double *);
    static int iform;
    static double asumi, bsumi, cwrki[16];
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *), zuchk_(double *, double *, 
	    int *, double *, double *);
    static double asumr, bsumr, cwrkr[16];
    extern double d1mach_(int *);
    extern /* Subroutine */ int zunhj_(double *, double *, double 
	    *, int *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *), zunik_(double *, double *, 
	    double *, int *, int *, double *, int *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *);
    static double zeta1i, zeta2i, zeta1r, zeta2r;

/* ***BEGIN PROLOGUE  ZUOIK */
/* ***REFER TO  ZBESI,ZBESK,ZBESH */

/*     ZUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC */
/*     EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM */
/*     (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW */
/*     WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING */
/*     EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN */
/*     THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER */
/*     MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE */
/*     EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)= */
/*     EXP(-ELIM)/TOL */

/*     IKFLG=1 MEANS THE I SEQUENCE IS TESTED */
/*          =2 MEANS THE K SEQUENCE IS TESTED */
/*     NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE */
/*         =-1 MEANS AN OVERFLOW WOULD OCCUR */
/*     IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO */
/*             THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE */
/*     IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO */
/*     IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY */
/*             ANOTHER ROUTINE */

/* ***ROUTINES CALLED  ZUCHK,ZUNHJ,ZUNIK,D1MACH,ZABSE,ZLOGE */
/* ***END PROLOGUE  ZUOIK */
/*     COMPLEX ARG,ASUM,BSUM,CWRK,CZ,CZERO,PHI,SUM,Y,Z,ZB,ZETA1,ZETA2,ZN, */
/*    *ZR */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    *nuf = 0;
    nn = *n;
    zrr = *zr;
    zri = *zi;
    if(*zr >= 0.) {
	goto L10;
    }
    zrr = -(*zr);
    zri = -(*zi);
L10:
    zbr = zrr;
    zbi = zri;
    ax = abs(*zr) * 1.7321;
    ay = abs(*zi);
    iform = 1;
    if(ay > ax) {
	iform = 2;
    }
    gnu = max(*fnu,1.);
    if(*ikflg == 1) {
	goto L20;
    }
    fnn = (double) ((float) nn);
    gnn = *fnu + fnn - 1.;
    gnu = max(gnn,fnn);
L20:
/* ----------------------------------------------------------------------- */
/*     ONLY THE MAGNITUDE OF ARG AND PHI ARE NEEDED ALONG WITH THE */
/*     REAL PARTS OF ZETA1, ZETA2 AND ZB. NO ATTEMPT IS MADE TO GET */
/*     THE SIGN OF THE IMAGINARY PART CORRECT. */
/* ----------------------------------------------------------------------- */
    if(iform == 2) {
	goto L30;
    }
    init = 0;
    zunik_(&zrr, &zri, &gnu, ikflg, &c__1, tol, &init, &phir, &phii, &zeta1r, 
	    &zeta1i, &zeta2r, &zeta2i, &sumr, &sumi, cwrkr, cwrki);
    czr = -zeta1r + zeta2r;
    czi = -zeta1i + zeta2i;
    goto L50;
L30:
    znr = zri;
    zni = -zrr;
    if(*zi > 0.) {
	goto L40;
    }
    znr = -znr;
L40:
    zunhj_(&znr, &zni, &gnu, &c__1, tol, &phir, &phii, &argr, &argi, &zeta1r, 
	    &zeta1i, &zeta2r, &zeta2i, &asumr, &asumi, &bsumr, &bsumi);
    czr = -zeta1r + zeta2r;
    czi = -zeta1i + zeta2i;
    aarg = zabse_(&argr, &argi);
L50:
    if(*kode == 1) {
	goto L60;
    }
    czr -= zbr;
    czi -= zbi;
L60:
    if(*ikflg == 1) {
	goto L70;
    }
    czr = -czr;
    czi = -czi;
L70:
    aphi = zabse_(&phir, &phii);
    rcz = czr;
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST */
/* ----------------------------------------------------------------------- */
    if(rcz > *elim) {
	goto L210;
    }
    if(rcz < *alim) {
	goto L80;
    }
    rcz += log(aphi);
    if(iform == 2) {
	rcz = rcz - log(aarg) * .25 - aic;
    }
    if(rcz > *elim) {
	goto L210;
    }
    goto L130;
L80:
/* ----------------------------------------------------------------------- */
/*     UNDERFLOW TEST */
/* ----------------------------------------------------------------------- */
    if(rcz < -(*elim)) {
	goto L90;
    }
    if(rcz > -(*alim)) {
	goto L130;
    }
    rcz += log(aphi);
    if(iform == 2) {
	rcz = rcz - log(aarg) * .25 - aic;
    }
    if(rcz > -(*elim)) {
	goto L110;
    }
L90:
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L100: */
    }
    *nuf = nn;
    return 0;
L110:
    ascle = d1mach_(&c__1) * 1e3 / *tol;
    zloge_(&phir, &phii, &str, &sti, &idum);
    czr += str;
    czi += sti;
    if(iform == 1) {
	goto L120;
    }
    zloge_(&argr, &argi, &str, &sti, &idum);
    czr = czr - str * .25 - aic;
    czi -= sti * .25;
L120:
    ax = exp(rcz) / *tol;
    ay = czi;
    czr = ax * cos(ay);
    czi = ax * sin(ay);
    zuchk_(&czr, &czi, &nw, &ascle, tol);
    if(nw != 0) {
	goto L90;
    }
L130:
    if(*ikflg == 2) {
	return 0;
    }
    if(*n == 1) {
	return 0;
    }
/* ----------------------------------------------------------------------- */
/*     SET UNDERFLOWS ON I SEQUENCE */
/* ----------------------------------------------------------------------- */
L140:
    gnu = *fnu + (double) ((float) (nn - 1));
    if(iform == 2) {
	goto L150;
    }
    init = 0;
    zunik_(&zrr, &zri, &gnu, ikflg, &c__1, tol, &init, &phir, &phii, &zeta1r, 
	    &zeta1i, &zeta2r, &zeta2i, &sumr, &sumi, cwrkr, cwrki);
    czr = -zeta1r + zeta2r;
    czi = -zeta1i + zeta2i;
    goto L160;
L150:
    zunhj_(&znr, &zni, &gnu, &c__1, tol, &phir, &phii, &argr, &argi, &zeta1r, 
	    &zeta1i, &zeta2r, &zeta2i, &asumr, &asumi, &bsumr, &bsumi);
    czr = -zeta1r + zeta2r;
    czi = -zeta1i + zeta2i;
    aarg = zabse_(&argr, &argi);
L160:
    if(*kode == 1) {
	goto L170;
    }
    czr -= zbr;
    czi -= zbi;
L170:
    aphi = zabse_(&phir, &phii);
    rcz = czr;
    if(rcz < -(*elim)) {
	goto L180;
    }
    if(rcz > -(*alim)) {
	return 0;
    }
    rcz += log(aphi);
    if(iform == 2) {
	rcz = rcz - log(aarg) * .25 - aic;
    }
    if(rcz > -(*elim)) {
	goto L190;
    }
L180:
    yr[nn] = zeror;
    yi[nn] = zeroi;
    --nn;
    ++(*nuf);
    if(nn == 0) {
	return 0;
    }
    goto L140;
L190:
    ascle = d1mach_(&c__1) * 1e3 / *tol;
    zloge_(&phir, &phii, &str, &sti, &idum);
    czr += str;
    czi += sti;
    if(iform == 1) {
	goto L200;
    }
    zloge_(&argr, &argi, &str, &sti, &idum);
    czr = czr - str * .25 - aic;
    czi -= sti * .25;
L200:
    ax = exp(rcz) / *tol;
    ay = czi;
    czr = ax * cos(ay);
    czi = ax * sin(ay);
    zuchk_(&czr, &czi, &nw, &ascle, tol);
    if(nw != 0) {
	goto L180;
    }
    return 0;
L210:
    *nuf = -1;
    return 0;
} /* zuoik_ */

/* ========================================================== */
/* Subroutine */ int zacon_(double *zr, double *zi, double *fnu, 
	int *kode, int *mr, int *n, double *yr, double *
	yi, int *nz, double *rl, double *fnul, double *tol, 
	double *elim, double *alim)
{
    /* Initialized data */

    static double pi = 3.14159265358979324;
    static double zeror = 0.;
    static double coner = 1.;

    /* System generated locals */
    int i__1;


    /* Local variables */
    static int i__;
    static double fn;
    static int nn, nw;
    static double yy, c1i, c2i, c1m, as2, c1r, c2r, s1i, s2i, s1r, s2r, 
	    cki, arg, ckr, cpn;
    static int iuf;
    static double cyi[2], fmr, csr, azn, sgn;
    static int inu;
    static double bry[3], cyr[2], pti, spn, sti, zni, rzi, ptr, str, znr, 
	    rzr, sc1i, sc2i, sc1r, sc2r, cscl, cscr, csrr[3], cssr[3], razn;
    extern /* Subroutine */ int zs1s2_(double *, double *, double 
	    *, double *, double *, double *, int *, 
	    double *, double *, int *), zmlt_(double *, 
	    double *, double *, double *, double *, 
	    double *);
    static int kflag;
    static double ascle, bscle, csgni;
    extern double zabse_(double *, double *);
    static double csgnr, cspni, cspnr;
    extern /* Subroutine */ int zbinu_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *, double *, double *, double *, 
	    double *), zbknu_(double *, double *, double *, 
	    int *, int *, double *, double *, int *, 
	    double *, double *, double *);
    extern double d1mach_(int *);

/* ***BEGIN PROLOGUE  ZACON */
/* ***REFER TO  ZBESK,ZBESH */

/*     ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA */

/*         K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) */
/*                 MP=PI*MR*CMPLX(0.0,1.0) */

/*     TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT */
/*     HALF Z PLANE */

/* ***ROUTINES CALLED  ZBINU,ZBKNU,ZS1S2,D1MACH,ZABSE,ZMLT */
/* ***END PROLOGUE  ZACON */
/*     COMPLEX CK,CONE,CSCL,CSCR,CSGN,CSPN,CY,CZERO,C1,C2,RZ,SC1,SC2,ST, */
/*    *S1,S2,Y,Z,ZN */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    *nz = 0;
    znr = -(*zr);
    zni = -(*zi);
    nn = *n;
    zbinu_(&znr, &zni, fnu, kode, &nn, &yr[1], &yi[1], &nw, rl, fnul, tol, 
	    elim, alim);
    if(nw < 0) {
	goto L90;
    }
/* ----------------------------------------------------------------------- */
/*     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION */
/* ----------------------------------------------------------------------- */
    nn = min(2,*n);
    zbknu_(&znr, &zni, fnu, kode, &nn, cyr, cyi, &nw, tol, elim, alim);
    if(nw != 0) {
	goto L90;
    }
    s1r = cyr[0];
    s1i = cyi[0];
    fmr = (double) ((float) (*mr));
    sgn = -d_sign(&pi, &fmr);
    csgnr = zeror;
    csgni = sgn;
    if(*kode == 1) {
	goto L10;
    }
    yy = -zni;
    cpn = cos(yy);
    spn = sin(yy);
    zmlt_(&csgnr, &csgni, &cpn, &spn, &csgnr, &csgni);
L10:
/* ----------------------------------------------------------------------- */
/*     CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE */
/*     WHEN FNU IS LARGE */
/* ----------------------------------------------------------------------- */
    inu = (int) ((float) (*fnu));
    arg = (*fnu - (double) ((float) inu)) * sgn;
    cpn = cos(arg);
    spn = sin(arg);
    cspnr = cpn;
    cspni = spn;
    if(inu % 2 == 0) {
	goto L20;
    }
    cspnr = -cspnr;
    cspni = -cspni;
L20:
    iuf = 0;
    c1r = s1r;
    c1i = s1i;
    c2r = yr[1];
    c2i = yi[1];
    ascle = d1mach_(&c__1) * 1e3 / *tol;
    if(*kode == 1) {
	goto L30;
    }
    zs1s2_(&znr, &zni, &c1r, &c1i, &c2r, &c2i, &nw, &ascle, alim, &iuf);
    *nz += nw;
    sc1r = c1r;
    sc1i = c1i;
L30:
    zmlt_(&cspnr, &cspni, &c1r, &c1i, &str, &sti);
    zmlt_(&csgnr, &csgni, &c2r, &c2i, &ptr, &pti);
    yr[1] = str + ptr;
    yi[1] = sti + pti;
    if(*n == 1) {
	return 0;
    }
    cspnr = -cspnr;
    cspni = -cspni;
    s2r = cyr[1];
    s2i = cyi[1];
    c1r = s2r;
    c1i = s2i;
    c2r = yr[2];
    c2i = yi[2];
    if(*kode == 1) {
	goto L40;
    }
    zs1s2_(&znr, &zni, &c1r, &c1i, &c2r, &c2i, &nw, &ascle, alim, &iuf);
    *nz += nw;
    sc2r = c1r;
    sc2i = c1i;
L40:
    zmlt_(&cspnr, &cspni, &c1r, &c1i, &str, &sti);
    zmlt_(&csgnr, &csgni, &c2r, &c2i, &ptr, &pti);
    yr[2] = str + ptr;
    yi[2] = sti + pti;
    if(*n == 2) {
	return 0;
    }
    cspnr = -cspnr;
    cspni = -cspni;
    azn = zabse_(&znr, &zni);
    razn = 1. / azn;
    str = znr * razn;
    sti = -zni * razn;
    rzr = (str + str) * razn;
    rzi = (sti + sti) * razn;
    fn = *fnu + 1.;
    ckr = fn * rzr;
    cki = fn * rzi;
/* ----------------------------------------------------------------------- */
/*     SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS */
/* ----------------------------------------------------------------------- */
    cscl = 1. / *tol;
    cscr = *tol;
    cssr[0] = cscl;
    cssr[1] = coner;
    cssr[2] = cscr;
    csrr[0] = cscr;
    csrr[1] = coner;
    csrr[2] = cscl;
    bry[0] = ascle;
    bry[1] = 1. / ascle;
    bry[2] = d1mach_(&c__2);
    as2 = zabse_(&s2r, &s2i);
    kflag = 2;
    if(as2 > bry[0]) {
	goto L50;
    }
    kflag = 1;
    goto L60;
L50:
    if(as2 < bry[1]) {
	goto L60;
    }
    kflag = 3;
L60:
    bscle = bry[kflag - 1];
    s1r *= cssr[kflag - 1];
    s1i *= cssr[kflag - 1];
    s2r *= cssr[kflag - 1];
    s2i *= cssr[kflag - 1];
    csr = csrr[kflag - 1];
    i__1 = *n;
    for (i__ = 3; i__ <= i__1; ++i__) {
	str = s2r;
	sti = s2i;
	s2r = ckr * str - cki * sti + s1r;
	s2i = ckr * sti + cki * str + s1i;
	s1r = str;
	s1i = sti;
	c1r = s2r * csr;
	c1i = s2i * csr;
	str = c1r;
	sti = c1i;
	c2r = yr[i__];
	c2i = yi[i__];
	if(*kode == 1) {
	    goto L70;
	}
	if(iuf < 0) {
	    goto L70;
	}
	zs1s2_(&znr, &zni, &c1r, &c1i, &c2r, &c2i, &nw, &ascle, alim, &iuf);
	*nz += nw;
	sc1r = sc2r;
	sc1i = sc2i;
	sc2r = c1r;
	sc2i = c1i;
	if(iuf != 3) {
	    goto L70;
	}
	iuf = -4;
	s1r = sc1r * cssr[kflag - 1];
	s1i = sc1i * cssr[kflag - 1];
	s2r = sc2r * cssr[kflag - 1];
	s2i = sc2i * cssr[kflag - 1];
	str = sc2r;
	sti = sc2i;
L70:
	ptr = cspnr * c1r - cspni * c1i;
	pti = cspnr * c1i + cspni * c1r;
	yr[i__] = ptr + csgnr * c2r - csgni * c2i;
	yi[i__] = pti + csgnr * c2i + csgni * c2r;
	ckr += rzr;
	cki += rzi;
	cspnr = -cspnr;
	cspni = -cspni;
	if(kflag >= 3) {
	    goto L80;
	}
	ptr = abs(c1r);
	pti = abs(c1i);
	c1m = max(ptr,pti);
	if(c1m <= bscle) {
	    goto L80;
	}
	++kflag;
	bscle = bry[kflag - 1];
	s1r *= csr;
	s1i *= csr;
	s2r = str;
	s2i = sti;
	s1r *= cssr[kflag - 1];
	s1i *= cssr[kflag - 1];
	s2r *= cssr[kflag - 1];
	s2i *= cssr[kflag - 1];
	csr = csrr[kflag - 1];
L80:
	;
    }
    return 0;
L90:
    *nz = -1;
    if(nw == -2) {
	*nz = -2;
    }
    return 0;
} /* zacon_ */

/* ========================================================== */
/* Subroutine */ int zbinu_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *cyr, double *cyi, int *
	nz, double *rl, double *fnul, double *tol, double *
	elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__;
    static double az;
    static int nn, nw;
    static double cwi[2], cwr[2];
    static int nui, inw;
    static double dfnu;
    extern double zabse_(double *, double *);
    static int nlast;
    extern /* Subroutine */ int zbuni_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    int *, int *, double *, double *, double *, 
	    double *), zseri_(double *, double *, double *, 
	    int *, int *, double *, double *, int *, 
	    double *, double *, double *), zmlri_(double *, 
	    double *, double *, int *, int *, double *, 
	    double *, int *, double *), zasyi_(double *, 
	    double *, double *, int *, int *, double *, 
	    double *, int *, double *, double *, double *,
	     double *), zuoik_(double *, double *, double *, 
	    int *, int *, int *, double *, double *, 
	    int *, double *, double *, double *), zwrsk_(
	    double *, double *, double *, int *, int *, 
	    double *, double *, int *, double *, double *,
	     double *, double *, double *);

/* ***BEGIN PROLOGUE  ZBINU */
/* ***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY */

/*     ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE */

/* ***ROUTINES CALLED  ZABSE,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK */
/* ***END PROLOGUE  ZBINU */
    /* Parameter adjustments */
    --cyi;
    --cyr;

    /* Function Body */

    *nz = 0;
    az = zabse_(zr, zi);
    nn = *n;
    dfnu = *fnu + (double) ((float) (*n - 1));
    if(az <= 2.) {
	goto L10;
    }
    if(az * az * .25 > dfnu + 1.) {
	goto L20;
    }
L10:
/* ----------------------------------------------------------------------- */
/*     POWER SERIES */
/* ----------------------------------------------------------------------- */
    zseri_(zr, zi, fnu, kode, &nn, &cyr[1], &cyi[1], &nw, tol, elim, alim);
    inw = abs(nw);
    *nz += inw;
    nn -= inw;
    if(nn == 0) {
	return 0;
    }
    if(nw >= 0) {
	goto L120;
    }
    dfnu = *fnu + (double) ((float) (nn - 1));
L20:
    if(az < *rl) {
	goto L40;
    }
    if(dfnu <= 1.) {
	goto L30;
    }
    if(az + az < dfnu * dfnu) {
	goto L50;
    }
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR LARGE Z */
/* ----------------------------------------------------------------------- */
L30:
    zasyi_(zr, zi, fnu, kode, &nn, &cyr[1], &cyi[1], &nw, rl, tol, elim, alim)
	    ;
    if(nw < 0) {
	goto L130;
    }
    goto L120;
L40:
    if(dfnu <= 1.) {
	goto L70;
    }
L50:
/* ----------------------------------------------------------------------- */
/*     OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM */
/* ----------------------------------------------------------------------- */
    zuoik_(zr, zi, fnu, kode, &c__1, &nn, &cyr[1], &cyi[1], &nw, tol, elim, 
	    alim);
    if(nw < 0) {
	goto L130;
    }
    *nz += nw;
    nn -= nw;
    if(nn == 0) {
	return 0;
    }
    dfnu = *fnu + (double) ((float) (nn - 1));
    if(dfnu > *fnul) {
	goto L110;
    }
    if(az > *fnul) {
	goto L110;
    }
L60:
    if(az > *rl) {
	goto L80;
    }
L70:
/* ----------------------------------------------------------------------- */
/*     MILLER ALGORITHM NORMALIZED BY THE SERIES */
/* ----------------------------------------------------------------------- */
    zmlri_(zr, zi, fnu, kode, &nn, &cyr[1], &cyi[1], &nw, tol);
    if(nw < 0) {
	goto L130;
    }
    goto L120;
L80:
/* ----------------------------------------------------------------------- */
/*     MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN */
/* ----------------------------------------------------------------------- */
    zuoik_(zr, zi, fnu, kode, &c__2, &c__2, cwr, cwi, &nw, tol, elim, alim);
    if(nw >= 0) {
	goto L100;
    }
    *nz = nn;
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	cyr[i__] = zeror;
	cyi[i__] = zeroi;
/* L90: */
    }
    return 0;
L100:
    if(nw > 0) {
	goto L130;
    }
    zwrsk_(zr, zi, fnu, kode, &nn, &cyr[1], &cyi[1], &nw, cwr, cwi, tol, elim,
	     alim);
    if(nw < 0) {
	goto L130;
    }
    goto L120;
L110:
/* ----------------------------------------------------------------------- */
/*     INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD */
/* ----------------------------------------------------------------------- */
    nui = (int) ((float) (*fnul - dfnu)) + 1;
    nui = max(nui,0);
    zbuni_(zr, zi, fnu, kode, &nn, &cyr[1], &cyi[1], &nw, &nui, &nlast, fnul, 
	    tol, elim, alim);
    if(nw < 0) {
	goto L130;
    }
    *nz += nw;
    if(nlast == 0) {
	goto L120;
    }
    nn = nlast;
    goto L60;
L120:
    return 0;
L130:
    *nz = -1;
    if(nw == -2) {
	*nz = -2;
    }
    return 0;
} /* zbinu_ */

/* ========================================================== */
double dgamln_(double *z__, int *ierr)
{
    /* Initialized data */

    static double gln[100] = { 0.,0.,.693147180559945309,
	    1.791759469228055,3.17805383034794562,4.78749174278204599,
	    6.579251212010101,8.5251613610654143,10.6046029027452502,
	    12.8018274800814696,15.1044125730755153,17.5023078458738858,
	    19.9872144956618861,22.5521638531234229,25.1912211827386815,
	    27.8992713838408916,30.6718601060806728,33.5050734501368889,
	    36.3954452080330536,39.339884187199494,42.335616460753485,
	    45.380138898476908,48.4711813518352239,51.6066755677643736,
	    54.7847293981123192,58.0036052229805199,61.261701761002002,
	    64.5575386270063311,67.889743137181535,71.257038967168009,
	    74.6582363488301644,78.0922235533153106,81.5579594561150372,
	    85.0544670175815174,88.5808275421976788,92.1361756036870925,
	    95.7196945421432025,99.3306124547874269,102.968198614513813,
	    106.631760260643459,110.320639714757395,114.034211781461703,
	    117.771881399745072,121.533081515438634,125.317271149356895,
	    129.123933639127215,132.95257503561631,136.802722637326368,
	    140.673923648234259,144.565743946344886,148.477766951773032,
	    152.409592584497358,156.360836303078785,160.331128216630907,
	    164.320112263195181,168.327445448427652,172.352797139162802,
	    176.395848406997352,180.456291417543771,184.533828861449491,
	    188.628173423671591,192.739047287844902,196.866181672889994,
	    201.009316399281527,205.168199482641199,209.342586752536836,
	    213.532241494563261,217.736934113954227,221.956441819130334,
	    226.190548323727593,230.439043565776952,234.701723442818268,
	    238.978389561834323,243.268849002982714,247.572914096186884,
	    251.890402209723194,256.221135550009525,260.564940971863209,
	    264.921649798552801,269.291097651019823,273.673124285693704,
	    278.067573440366143,282.474292687630396,286.893133295426994,
	    291.323950094270308,295.766601350760624,300.220948647014132,
	    304.686856765668715,309.164193580146922,313.652829949879062,
	    318.152639620209327,322.663499126726177,327.185287703775217,
	    331.717887196928473,336.261181979198477,340.815058870799018,
	    345.379407062266854,349.954118040770237,354.539085519440809,
	    359.134205369575399 };
    static double cf[22] = { .0833333333333333333,-.00277777777777777778,
	    7.93650793650793651e-4,-5.95238095238095238e-4,
	    8.41750841750841751e-4,-.00191752691752691753,
	    .00641025641025641026,-.0295506535947712418,.179644372368830573,
	    -1.39243221690590112,13.402864044168392,-156.848284626002017,
	    2193.10333333333333,-36108.7712537249894,691472.268851313067,
	    -15238221.5394074162,382900751.391414141,-10882266035.7843911,
	    347320283765.002252,-12369602142269.2745,488788064793079.335,
	    -21320333960919373.9 };
    static double con = 1.83787706640934548;

    /* System generated locals */
    int i__1;
    double ret_val = 0.0;

    /* Local variables */
    static int i__, k;
    static double s, t1, fz, zm;
    static int mz, nz;
    static double zp;
    static int i1m;
    static double fln, tlg, rln, trm, tst, zsq, zinc, zmin, zdmy, wdtol;
    extern double d1mach_(int *);
    extern int i1mach_(int *);

/* ***BEGIN PROLOGUE  DGAMLN */
/* ***DATE WRITTEN   830501   (YYMMDD) */
/* ***REVISION DATE  830501   (YYMMDD) */
/* ***CATEGORY NO.  B5F */
/* ***KEYWORDS  GAMMA FUNCTION,LOGARITHM OF GAMMA FUNCTION */
/* ***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES */
/* ***PURPOSE  TO COMPUTE THE LOGARITHM OF THE GAMMA FUNCTION */
/* ***DESCRIPTION */

/*               **** A DOUBLE PRECISION ROUTINE **** */
/*         DGAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR */
/*         Z.GT.0.  THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES */
/*         GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION */
/*         G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN.  THE FUNCTION WAS MADE AS */
/*         PORTABLE AS POSSIBLE BY COMPUTIMG ZMIN FROM THE NUMBER OF BASE */
/*         10 DIGITS IN A WORD, RLN=AMAX1(-ALOG10(R1MACH(4)),0.5E-18) */
/*         LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY. */

/*         SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100 */
/*         VALUES IS USED FOR SPEED OF EXECUTION. */

/*     DESCRIPTION OF ARGUMENTS */

/*         INPUT      Z IS D0UBLE PRECISION */
/*           Z      - ARGUMENT, Z.GT.0.0D0 */

/*         OUTPUT      DGAMLN IS DOUBLE PRECISION */
/*           DGAMLN  - NATURAL LOG OF THE GAMMA FUNCTION AT Z.NE.0.0D0 */
/*           IERR    - ERROR FLAG */
/*                     IERR=0, NORMAL RETURN, COMPUTATION COMPLETED */
/*                     IERR=1, Z.LE.0.0D0,    NO COMPUTATION */


/* ***REFERENCES  COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT */
/*                 BY D. E. AMOS, SAND83-0083, MAY, 1983. */
/* ***ROUTINES CALLED  I1MACH,D1MACH */
/* ***END PROLOGUE  DGAMLN */
/*           LNGAMMA(N), N=1,100 */
/*             COEFFICIENTS OF ASYMPTOTIC EXPANSION */

/*             LN(2*PI) */

/* ***FIRST EXECUTABLE STATEMENT  DGAMLN */
    *ierr = 0;
    if(*z__ <= 0.) {
	goto L70;
    }
    if(*z__ > 101.) {
	goto L10;
    }
    nz = (int) ((float) (*z__));
    fz = *z__ - (float) nz;
    if(fz > 0.) {
	goto L10;
    }
    if(nz > 100) {
	goto L10;
    }
    ret_val = gln[nz - 1];
    return ret_val;
L10:
    wdtol = d1mach_(&c__4);
    wdtol = max(wdtol,5e-19);
    i1m = i1mach_(&c__14);
    rln = d1mach_(&c__5) * (float) i1m;
    fln = min(rln,20.);
    fln = max(fln,3.);
    fln += -3.;
    zm = fln * .3875 + 1.8;
    mz = (int) ((float) zm) + 1;
    zmin = (float) mz;
    zdmy = *z__;
    zinc = 0.;
    if(*z__ >= zmin) {
	goto L20;
    }
    zinc = zmin - (float) nz;
    zdmy = *z__ + zinc;
L20:
    zp = 1. / zdmy;
    t1 = cf[0] * zp;
    s = t1;
    if(zp < wdtol) {
	goto L40;
    }
    zsq = zp * zp;
    tst = t1 * wdtol;
    for (k = 2; k <= 22; ++k) {
	zp *= zsq;
	trm = cf[k - 1] * zp;
	if(abs(trm) < tst) {
	    goto L40;
	}
	s += trm;
/* L30: */
    }
L40:
    if(zinc != 0.) {
	goto L50;
    }
    tlg = log(*z__);
    ret_val = *z__ * (tlg - 1.) + (con - tlg) * .5 + s;
    return ret_val;
L50:
    zp = 1.;
    nz = (int) ((float) zinc);
    i__1 = nz;
    for (i__ = 1; i__ <= i__1; ++i__) {
	zp *= *z__ + (float) (i__ - 1);
/* L60: */
    }
    tlg = log(zdmy);
    ret_val = zdmy * (tlg - 1.) - log(zp) + (con - tlg) * .5 + s;
    return ret_val;


L70:
    *ierr = 1;
    return ret_val;
} /* dgamln_ */

/* ========================================================== */
/* Subroutine */ int zacai_(double *zr, double *zi, double *fnu, 
	int *kode, int *mr, int *n, double *yr, double *
	yi, int *nz, double *rl, double *tol, double *elim, 
	double *alim)
{
    /* Initialized data */

    static double pi = 3.14159265358979324;

    /* Local variables */
    static double az;
    static int nn, nw;
    static double yy, c1i, c2i, c1r, c2r, arg;
    static int iuf;
    static double cyi[2], fmr, sgn;
    static int inu;
    static double cyr[2], zni, znr, dfnu;
    extern /* Subroutine */ int zs1s2_(double *, double *, double 
	    *, double *, double *, double *, int *, 
	    double *, double *, int *);
    static double ascle, csgni;
    extern double zabse_(double *, double *);
    static double csgnr, cspni, cspnr;
    extern /* Subroutine */ int zbknu_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *, double *, double *), zseri_(double *, 
	    double *, double *, int *, int *, double *, 
	    double *, int *, double *, double *, double *)
	    ;
    extern double d1mach_(int *);
    extern /* Subroutine */ int zmlri_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    double *), zasyi_(double *, double *, double *, 
	    int *, int *, double *, double *, int *, 
	    double *, double *, double *, double *);

/* ***BEGIN PROLOGUE  ZACAI */
/* ***REFER TO  ZAIRY */

/*     ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA */

/*         K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) */
/*                 MP=PI*MR*CMPLX(0.0,1.0) */

/*     TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT */
/*     HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1. */
/*     ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND */
/*     RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT IF ZACON */
/*     IS CALLED FROM ZAIRY. */

/* ***ROUTINES CALLED  ZASYI,ZBKNU,ZMLRI,ZSERI,ZS1S2,D1MACH,ZABSE */
/* ***END PROLOGUE  ZACAI */
/*     COMPLEX CSGN,CSPN,C1,C2,Y,Z,ZN,CY */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    *nz = 0;
    znr = -(*zr);
    zni = -(*zi);
    az = zabse_(zr, zi);
    nn = *n;
    dfnu = *fnu + (double) ((float) (*n - 1));
    if(az <= 2.) {
	goto L10;
    }
    if(az * az * .25 > dfnu + 1.) {
	goto L20;
    }
L10:
/* ----------------------------------------------------------------------- */
/*     POWER SERIES FOR THE I FUNCTION */
/* ----------------------------------------------------------------------- */
    zseri_(&znr, &zni, fnu, kode, &nn, &yr[1], &yi[1], &nw, tol, elim, alim);
    goto L40;
L20:
    if(az < *rl) {
	goto L30;
    }
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION */
/* ----------------------------------------------------------------------- */
    zasyi_(&znr, &zni, fnu, kode, &nn, &yr[1], &yi[1], &nw, rl, tol, elim, 
	    alim);
    if(nw < 0) {
	goto L80;
    }
    goto L40;
L30:
/* ----------------------------------------------------------------------- */
/*     MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION */
/* ----------------------------------------------------------------------- */
    zmlri_(&znr, &zni, fnu, kode, &nn, &yr[1], &yi[1], &nw, tol);
    if(nw < 0) {
	goto L80;
    }
L40:
/* ----------------------------------------------------------------------- */
/*     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION */
/* ----------------------------------------------------------------------- */
    zbknu_(&znr, &zni, fnu, kode, &c__1, cyr, cyi, &nw, tol, elim, alim);
    if(nw != 0) {
	goto L80;
    }
    fmr = (double) ((float) (*mr));
    sgn = -d_sign(&pi, &fmr);
    csgnr = 0.;
    csgni = sgn;
    if(*kode == 1) {
	goto L50;
    }
    yy = -zni;
    csgnr = -csgni * sin(yy);
    csgni *= cos(yy);
L50:
/* ----------------------------------------------------------------------- */
/*     CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE */
/*     WHEN FNU IS LARGE */
/* ----------------------------------------------------------------------- */
    inu = (int) ((float) (*fnu));
    arg = (*fnu - (double) ((float) inu)) * sgn;
    cspnr = cos(arg);
    cspni = sin(arg);
    if(inu % 2 == 0) {
	goto L60;
    }
    cspnr = -cspnr;
    cspni = -cspni;
L60:
    c1r = cyr[0];
    c1i = cyi[0];
    c2r = yr[1];
    c2i = yi[1];
    if(*kode == 1) {
	goto L70;
    }
    iuf = 0;
    ascle = d1mach_(&c__1) * 1e3 / *tol;
    zs1s2_(&znr, &zni, &c1r, &c1i, &c2r, &c2i, &nw, &ascle, alim, &iuf);
    *nz += nw;
L70:
    yr[1] = cspnr * c1r - cspni * c1i + csgnr * c2r - csgni * c2i;
    yi[1] = cspnr * c1i + cspni * c1r + csgnr * c2i + csgni * c2r;
    return 0;
L80:
    *nz = -1;
    if(nw == -2) {
	*nz = -2;
    }
    return 0;
} /* zacai_ */

/* ========================================================== */
/* Subroutine */ int zuchk_(double *yr, double *yi, int *nz, 
	double *ascle, double *tol)
{
    static double wi, ss, st, wr;

/* ***BEGIN PROLOGUE  ZUCHK */
/* ***REFER TO ZSERI,ZUOIK,ZUNK1,ZUNK2,ZUNI1,ZUNI2,ZKSCL */

/*      Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN */
/*      EXP(-ALIM)=ASCLE=1.0E+3*D1MACH(1)/TOL. THE TEST IS MADE TO SEE */
/*      IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW */
/*      WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED */
/*      IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE */
/*      OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE */
/*      ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. */

/* ***ROUTINES CALLED  (NONE) */
/* ***END PROLOGUE  ZUCHK */

/*     COMPLEX Y */
    *nz = 0;
    wr = abs(*yr);
    wi = abs(*yi);
    st = min(wr,wi);
    if(st > *ascle) {
	return 0;
    }
    ss = max(wr,wi);
    st /= *tol;
    if(ss < st) {
	*nz = 1;
    }
    return 0;
} /* zuchk_ */

/* Subroutine */ int zunik_(double *zrr, double *zri, double *fnu,
	 int *ikflg, int *ipmtr, double *tol, int *init, 
	double *phir, double *phii, double *zeta1r, double *
	zeta1i, double *zeta2r, double *zeta2i, double *sumr, 
	double *sumi, double *cwrkr, double *cwrki)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;
    static double con[2] = { .398942280401432678,1.25331413731550025 };
    static double c__[120] = { 1.,-.208333333333333333,.125,
	    .334201388888888889,-.401041666666666667,.0703125,
	    -1.02581259645061728,1.84646267361111111,-.8912109375,.0732421875,
	    4.66958442342624743,-11.2070026162229938,8.78912353515625,
	    -2.3640869140625,.112152099609375,-28.2120725582002449,
	    84.6362176746007346,-91.8182415432400174,42.5349987453884549,
	    -7.3687943594796317,.227108001708984375,212.570130039217123,
	    -765.252468141181642,1059.99045252799988,-699.579627376132541,
	    218.19051174421159,-26.4914304869515555,.572501420974731445,
	    -1919.457662318407,8061.72218173730938,-13586.5500064341374,
	    11655.3933368645332,-5305.64697861340311,1200.90291321635246,
	    -108.090919788394656,1.7277275025844574,20204.2913309661486,
	    -96980.5983886375135,192547.001232531532,-203400.177280415534,
	    122200.46498301746,-41192.6549688975513,7109.51430248936372,
	    -493.915304773088012,6.07404200127348304,-242919.187900551333,
	    1311763.6146629772,-2998015.91853810675,3763271.297656404,
	    -2813563.22658653411,1268365.27332162478,-331645.172484563578,
	    45218.7689813627263,-2499.83048181120962,24.3805296995560639,
	    3284469.85307203782,-19706819.1184322269,50952602.4926646422,
	    -74105148.2115326577,66344512.2747290267,-37567176.6607633513,
	    13288767.1664218183,-2785618.12808645469,308186.404612662398,
	    -13886.0897537170405,110.017140269246738,-49329253.664509962,
	    325573074.185765749,-939462359.681578403,1553596899.57058006,
	    -1621080552.10833708,1106842816.82301447,-495889784.275030309,
	    142062907.797533095,-24474062.7257387285,2243768.17792244943,
	    -84005.4336030240853,551.335896122020586,814789096.118312115,
	    -5866481492.05184723,18688207509.2958249,-34632043388.1587779,
	    41280185579.753974,-33026599749.8007231,17954213731.1556001,
	    -6563293792.61928433,1559279864.87925751,-225105661.889415278,
	    17395107.5539781645,-549842.327572288687,3038.09051092238427,
	    -14679261247.6956167,114498237732.02581,-399096175224.466498,
	    819218669548.577329,-1098375156081.22331,1008158106865.38209,
	    -645364869245.376503,287900649906.150589,-87867072178.0232657,
	    17634730606.8349694,-2167164983.22379509,143157876.718888981,
	    -3871833.44257261262,18257.7554742931747,286464035717.679043,
	    -2406297900028.50396,9109341185239.89896,-20516899410934.4374,
	    30565125519935.3206,-31667088584785.1584,23348364044581.8409,
	    -12320491305598.2872,4612725780849.13197,-1196552880196.1816,
	    205914503232.410016,-21822927757.5292237,1247009293.51271032,
	    -29188388.1222208134,118838.426256783253 };

    /* System generated locals */
    int i__1;
    double d__1, d__2;

    /* Local variables */
    static int i__, j, k, l;
    static double ac, si, ti, sr, tr, t2i, t2r, rfn, sri, sti, zni, srr, 
	    str, znr;
    static int idum;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *);
    static double test, crfni, crfnr;
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *);
    extern double d1mach_(int *);
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);

/* ***BEGIN PROLOGUE  ZUNIK */
/* ***REFER TO  ZBESI,ZBESK */

/*        ZUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC */
/*        EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2 */
/*        RESPECTIVELY BY */

/*        W(FNU,ZR) = PHI*EXP(ZETA)*SUM */

/*        WHERE       ZETA=-ZETA1 + ZETA2       OR */
/*                          ZETA1 - ZETA2 */

/*        THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE */
/*        SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG= */
/*        1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK */
/*        ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI, */
/*        ZETA1,ZETA2. */

/* ***ROUTINES CALLED  ZDIV,ZLOGE,ZSQRTE,D1MACH */
/* ***END PROLOGUE  ZUNIK */
/*     COMPLEX CFN,CON,CONE,CRFN,CWRK,CZERO,PHI,S,SR,SUM,T,T2,ZETA1, */
/*    *ZETA2,ZN,ZR */
    /* Parameter adjustments */
    --cwrki;
    --cwrkr;

    /* Function Body */

    if(*init != 0) {
	goto L40;
    }
/* ----------------------------------------------------------------------- */
/*     INITIALIZE ALL VARIABLES */
/* ----------------------------------------------------------------------- */
    rfn = 1. / *fnu;
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST (ZR/FNU TOO SMALL) */
/* ----------------------------------------------------------------------- */
    test = d1mach_(&c__1) * 1e3;
    ac = *fnu * test;
    if(abs(*zrr) > ac || abs(*zri) > ac) {
	goto L15;
    }
    *zeta1r = (d__1 = log(test), abs(d__1)) * 2. + *fnu;
    *zeta1i = 0.;
    *zeta2r = *fnu;
    *zeta2i = 0.;
    *phir = 1.;
    *phii = 0.;
    return 0;
L15:
    tr = *zrr * rfn;
    ti = *zri * rfn;
    sr = coner + (tr * tr - ti * ti);
    si = conei + (tr * ti + ti * tr);
    zsqrte_(&sr, &si, &srr, &sri);
    str = coner + srr;
    sti = conei + sri;
    zdiv_(&str, &sti, &tr, &ti, &znr, &zni);
    zloge_(&znr, &zni, &str, &sti, &idum);
    *zeta1r = *fnu * str;
    *zeta1i = *fnu * sti;
    *zeta2r = *fnu * srr;
    *zeta2i = *fnu * sri;
    zdiv_(&coner, &conei, &srr, &sri, &tr, &ti);
    srr = tr * rfn;
    sri = ti * rfn;
    zsqrte_(&srr, &sri, &cwrkr[16], &cwrki[16]);
    *phir = cwrkr[16] * con[*ikflg - 1];
    *phii = cwrki[16] * con[*ikflg - 1];
    if(*ipmtr != 0) {
	return 0;
    }
    zdiv_(&coner, &conei, &sr, &si, &t2r, &t2i);
    cwrkr[1] = coner;
    cwrki[1] = conei;
    crfnr = coner;
    crfni = conei;
    ac = 1.;
    l = 1;
    for (k = 2; k <= 15; ++k) {
	sr = zeror;
	si = zeroi;
	i__1 = k;
	for (j = 1; j <= i__1; ++j) {
	    ++l;
	    str = sr * t2r - si * t2i + c__[l - 1];
	    si = sr * t2i + si * t2r;
	    sr = str;
/* L10: */
	}
	str = crfnr * srr - crfni * sri;
	crfni = crfnr * sri + crfni * srr;
	crfnr = str;
	cwrkr[k] = crfnr * sr - crfni * si;
	cwrki[k] = crfnr * si + crfni * sr;
	ac *= rfn;
	test = (d__1 = cwrkr[k], abs(d__1)) + (d__2 = cwrki[k], abs(d__2));
	if(ac < *tol && test < *tol) {
	    goto L30;
	}
/* L20: */
    }
    k = 15;
L30:
    *init = k;
L40:
    if(*ikflg == 2) {
	goto L60;
    }
/* ----------------------------------------------------------------------- */
/*     COMPUTE SUM FOR THE I FUNCTION */
/* ----------------------------------------------------------------------- */
    sr = zeror;
    si = zeroi;
    i__1 = *init;
    for (i__ = 1; i__ <= i__1; ++i__) {
	sr += cwrkr[i__];
	si += cwrki[i__];
/* L50: */
    }
    *sumr = sr;
    *sumi = si;
    *phir = cwrkr[16] * con[0];
    *phii = cwrki[16] * con[0];
    return 0;
L60:
/* ----------------------------------------------------------------------- */
/*     COMPUTE SUM FOR THE K FUNCTION */
/* ----------------------------------------------------------------------- */
    sr = zeror;
    si = zeroi;
    tr = coner;
    i__1 = *init;
    for (i__ = 1; i__ <= i__1; ++i__) {
	sr += tr * cwrkr[i__];
	si += tr * cwrki[i__];
	tr = -tr;
/* L70: */
    }
    *sumr = sr;
    *sumi = si;
    *phir = cwrkr[16] * con[1];
    *phii = cwrki[16] * con[1];
    return 0;
} /* zunik_ */

/* ========================================================== */
/* Subroutine */ int zunhj_(double *zr, double *zi, double *fnu, 
	int *ipmtr, double *tol, double *phir, double *phii, 
	double *argr, double *argi, double *zeta1r, double *
	zeta1i, double *zeta2r, double *zeta2i, double *asumr, 
	double *asumi, double *bsumr, double *bsumi)
{
    /* Initialized data */

    static double ar[14] = { 1.,.104166666666666667,.0835503472222222222,
	    .12822657455632716,.291849026464140464,.881627267443757652,
	    3.32140828186276754,14.9957629868625547,78.9230130115865181,
	    474.451538868264323,3207.49009089066193,24086.5496408740049,
	    198923.119169509794,1791902.00777534383 };
    static double br[14] = { 1.,-.145833333333333333,
	    -.0987413194444444444,-.143312053915895062,-.317227202678413548,
	    -.942429147957120249,-3.51120304082635426,-15.7272636203680451,
	    -82.2814390971859444,-492.355370523670524,-3316.21856854797251,
	    -24827.6742452085896,-204526.587315129788,-1838444.9170682099 };
    static double c__[105] = { 1.,-.208333333333333333,.125,
	    .334201388888888889,-.401041666666666667,.0703125,
	    -1.02581259645061728,1.84646267361111111,-.8912109375,.0732421875,
	    4.66958442342624743,-11.2070026162229938,8.78912353515625,
	    -2.3640869140625,.112152099609375,-28.2120725582002449,
	    84.6362176746007346,-91.8182415432400174,42.5349987453884549,
	    -7.3687943594796317,.227108001708984375,212.570130039217123,
	    -765.252468141181642,1059.99045252799988,-699.579627376132541,
	    218.19051174421159,-26.4914304869515555,.572501420974731445,
	    -1919.457662318407,8061.72218173730938,-13586.5500064341374,
	    11655.3933368645332,-5305.64697861340311,1200.90291321635246,
	    -108.090919788394656,1.7277275025844574,20204.2913309661486,
	    -96980.5983886375135,192547.001232531532,-203400.177280415534,
	    122200.46498301746,-41192.6549688975513,7109.51430248936372,
	    -493.915304773088012,6.07404200127348304,-242919.187900551333,
	    1311763.6146629772,-2998015.91853810675,3763271.297656404,
	    -2813563.22658653411,1268365.27332162478,-331645.172484563578,
	    45218.7689813627263,-2499.83048181120962,24.3805296995560639,
	    3284469.85307203782,-19706819.1184322269,50952602.4926646422,
	    -74105148.2115326577,66344512.2747290267,-37567176.6607633513,
	    13288767.1664218183,-2785618.12808645469,308186.404612662398,
	    -13886.0897537170405,110.017140269246738,-49329253.664509962,
	    325573074.185765749,-939462359.681578403,1553596899.57058006,
	    -1621080552.10833708,1106842816.82301447,-495889784.275030309,
	    142062907.797533095,-24474062.7257387285,2243768.17792244943,
	    -84005.4336030240853,551.335896122020586,814789096.118312115,
	    -5866481492.05184723,18688207509.2958249,-34632043388.1587779,
	    41280185579.753974,-33026599749.8007231,17954213731.1556001,
	    -6563293792.61928433,1559279864.87925751,-225105661.889415278,
	    17395107.5539781645,-549842.327572288687,3038.09051092238427,
	    -14679261247.6956167,114498237732.02581,-399096175224.466498,
	    819218669548.577329,-1098375156081.22331,1008158106865.38209,
	    -645364869245.376503,287900649906.150589,-87867072178.0232657,
	    17634730606.8349694,-2167164983.22379509,143157876.718888981,
	    -3871833.44257261262,18257.7554742931747 };
    static double alfa[180] = { -.00444444444444444444,
	    -9.22077922077922078e-4,-8.84892884892884893e-5,
	    1.65927687832449737e-4,2.4669137274179291e-4,
	    2.6599558934625478e-4,2.61824297061500945e-4,
	    2.48730437344655609e-4,2.32721040083232098e-4,
	    2.16362485712365082e-4,2.00738858762752355e-4,
	    1.86267636637545172e-4,1.73060775917876493e-4,
	    1.61091705929015752e-4,1.50274774160908134e-4,
	    1.40503497391269794e-4,1.31668816545922806e-4,
	    1.23667445598253261e-4,1.16405271474737902e-4,
	    1.09798298372713369e-4,1.03772410422992823e-4,
	    9.82626078369363448e-5,9.32120517249503256e-5,
	    8.85710852478711718e-5,8.42963105715700223e-5,
	    8.03497548407791151e-5,7.66981345359207388e-5,
	    7.33122157481777809e-5,7.01662625163141333e-5,
	    6.72375633790160292e-5,6.93735541354588974e-4,
	    2.32241745182921654e-4,-1.41986273556691197e-5,
	    -1.1644493167204864e-4,-1.50803558053048762e-4,
	    -1.55121924918096223e-4,-1.46809756646465549e-4,
	    -1.33815503867491367e-4,-1.19744975684254051e-4,
	    -1.0618431920797402e-4,-9.37699549891194492e-5,
	    -8.26923045588193274e-5,-7.29374348155221211e-5,
	    -6.44042357721016283e-5,-5.69611566009369048e-5,
	    -5.04731044303561628e-5,-4.48134868008882786e-5,
	    -3.98688727717598864e-5,-3.55400532972042498e-5,
	    -3.1741425660902248e-5,-2.83996793904174811e-5,
	    -2.54522720634870566e-5,-2.28459297164724555e-5,
	    -2.05352753106480604e-5,-1.84816217627666085e-5,
	    -1.66519330021393806e-5,-1.50179412980119482e-5,
	    -1.35554031379040526e-5,-1.22434746473858131e-5,
	    -1.10641884811308169e-5,-3.54211971457743841e-4,
	    -1.56161263945159416e-4,3.0446550359493641e-5,
	    1.30198655773242693e-4,1.67471106699712269e-4,
	    1.70222587683592569e-4,1.56501427608594704e-4,
	    1.3633917097744512e-4,1.14886692029825128e-4,
	    9.45869093034688111e-5,7.64498419250898258e-5,
	    6.07570334965197354e-5,4.74394299290508799e-5,
	    3.62757512005344297e-5,2.69939714979224901e-5,
	    1.93210938247939253e-5,1.30056674793963203e-5,
	    7.82620866744496661e-6,3.59257485819351583e-6,
	    1.44040049814251817e-7,-2.65396769697939116e-6,
	    -4.9134686709848591e-6,-6.72739296091248287e-6,
	    -8.17269379678657923e-6,-9.31304715093561232e-6,
	    -1.02011418798016441e-5,-1.0880596251059288e-5,
	    -1.13875481509603555e-5,-1.17519675674556414e-5,
	    -1.19987364870944141e-5,3.78194199201772914e-4,
	    2.02471952761816167e-4,-6.37938506318862408e-5,
	    -2.38598230603005903e-4,-3.10916256027361568e-4,
	    -3.13680115247576316e-4,-2.78950273791323387e-4,
	    -2.28564082619141374e-4,-1.75245280340846749e-4,
	    -1.25544063060690348e-4,-8.22982872820208365e-5,
	    -4.62860730588116458e-5,-1.72334302366962267e-5,
	    5.60690482304602267e-6,2.313954431482868e-5,
	    3.62642745856793957e-5,4.58006124490188752e-5,
	    5.2459529495911405e-5,5.68396208545815266e-5,
	    5.94349820393104052e-5,6.06478527578421742e-5,
	    6.08023907788436497e-5,6.01577894539460388e-5,
	    5.891996573446985e-5,5.72515823777593053e-5,
	    5.52804375585852577e-5,5.3106377380288017e-5,
	    5.08069302012325706e-5,4.84418647620094842e-5,
	    4.6056858160747537e-5,-6.91141397288294174e-4,
	    -4.29976633058871912e-4,1.83067735980039018e-4,
	    6.60088147542014144e-4,8.75964969951185931e-4,
	    8.77335235958235514e-4,7.49369585378990637e-4,
	    5.63832329756980918e-4,3.68059319971443156e-4,
	    1.88464535514455599e-4,3.70663057664904149e-5,
	    -8.28520220232137023e-5,-1.72751952869172998e-4,
	    -2.36314873605872983e-4,-2.77966150694906658e-4,
	    -3.02079514155456919e-4,-3.12594712643820127e-4,
	    -3.12872558758067163e-4,-3.05678038466324377e-4,
	    -2.93226470614557331e-4,-2.77255655582934777e-4,
	    -2.59103928467031709e-4,-2.39784014396480342e-4,
	    -2.20048260045422848e-4,-2.00443911094971498e-4,
	    -1.81358692210970687e-4,-1.63057674478657464e-4,
	    -1.45712672175205844e-4,-1.29425421983924587e-4,
	    -1.14245691942445952e-4,.00192821964248775885,
	    .00135592576302022234,-7.17858090421302995e-4,
	    -.00258084802575270346,-.00349271130826168475,
	    -.00346986299340960628,-.00282285233351310182,
	    -.00188103076404891354,-8.895317183839476e-4,
	    3.87912102631035228e-6,7.28688540119691412e-4,
	    .00126566373053457758,.00162518158372674427,.00183203153216373172,
	    .00191588388990527909,.00190588846755546138,.00182798982421825727,
	    .0017038950642112153,.00155097127171097686,.00138261421852276159,
	    .00120881424230064774,.00103676532638344962,
	    8.71437918068619115e-4,7.16080155297701002e-4,
	    5.72637002558129372e-4,4.42089819465802277e-4,
	    3.24724948503090564e-4,2.20342042730246599e-4,
	    1.28412898401353882e-4,4.82005924552095464e-5 };
    static double beta[210] = { .0179988721413553309,
	    .00559964911064388073,.00288501402231132779,.00180096606761053941,
	    .00124753110589199202,9.22878876572938311e-4,
	    7.14430421727287357e-4,5.71787281789704872e-4,
	    4.69431007606481533e-4,3.93232835462916638e-4,
	    3.34818889318297664e-4,2.88952148495751517e-4,
	    2.52211615549573284e-4,2.22280580798883327e-4,
	    1.97541838033062524e-4,1.76836855019718004e-4,
	    1.59316899661821081e-4,1.44347930197333986e-4,
	    1.31448068119965379e-4,1.20245444949302884e-4,
	    1.10449144504599392e-4,1.01828770740567258e-4,
	    9.41998224204237509e-5,8.74130545753834437e-5,
	    8.13466262162801467e-5,7.59002269646219339e-5,
	    7.09906300634153481e-5,6.65482874842468183e-5,
	    6.25146958969275078e-5,5.88403394426251749e-5,
	    -.00149282953213429172,-8.78204709546389328e-4,
	    -5.02916549572034614e-4,-2.94822138512746025e-4,
	    -1.75463996970782828e-4,-1.04008550460816434e-4,
	    -5.96141953046457895e-5,-3.1203892907609834e-5,
	    -1.26089735980230047e-5,-2.42892608575730389e-7,
	    8.05996165414273571e-6,1.36507009262147391e-5,
	    1.73964125472926261e-5,1.9867297884213378e-5,
	    2.14463263790822639e-5,2.23954659232456514e-5,
	    2.28967783814712629e-5,2.30785389811177817e-5,
	    2.30321976080909144e-5,2.28236073720348722e-5,
	    2.25005881105292418e-5,2.20981015361991429e-5,
	    2.16418427448103905e-5,2.11507649256220843e-5,
	    2.06388749782170737e-5,2.01165241997081666e-5,
	    1.95913450141179244e-5,1.9068936791043674e-5,
	    1.85533719641636667e-5,1.80475722259674218e-5,
	    5.5221307672129279e-4,4.47932581552384646e-4,
	    2.79520653992020589e-4,1.52468156198446602e-4,
	    6.93271105657043598e-5,1.76258683069991397e-5,
	    -1.35744996343269136e-5,-3.17972413350427135e-5,
	    -4.18861861696693365e-5,-4.69004889379141029e-5,
	    -4.87665447413787352e-5,-4.87010031186735069e-5,
	    -4.74755620890086638e-5,-4.55813058138628452e-5,
	    -4.33309644511266036e-5,-4.09230193157750364e-5,
	    -3.84822638603221274e-5,-3.60857167535410501e-5,
	    -3.37793306123367417e-5,-3.15888560772109621e-5,
	    -2.95269561750807315e-5,-2.75978914828335759e-5,
	    -2.58006174666883713e-5,-2.413083567612802e-5,
	    -2.25823509518346033e-5,-2.11479656768912971e-5,
	    -1.98200638885294927e-5,-1.85909870801065077e-5,
	    -1.74532699844210224e-5,-1.63997823854497997e-5,
	    -4.74617796559959808e-4,-4.77864567147321487e-4,
	    -3.20390228067037603e-4,-1.61105016119962282e-4,
	    -4.25778101285435204e-5,3.44571294294967503e-5,
	    7.97092684075674924e-5,1.031382367082722e-4,
	    1.12466775262204158e-4,1.13103642108481389e-4,
	    1.08651634848774268e-4,1.01437951597661973e-4,
	    9.29298396593363896e-5,8.40293133016089978e-5,
	    7.52727991349134062e-5,6.69632521975730872e-5,
	    5.92564547323194704e-5,5.22169308826975567e-5,
	    4.58539485165360646e-5,4.01445513891486808e-5,
	    3.50481730031328081e-5,3.05157995034346659e-5,
	    2.64956119950516039e-5,2.29363633690998152e-5,
	    1.97893056664021636e-5,1.70091984636412623e-5,
	    1.45547428261524004e-5,1.23886640995878413e-5,
	    1.04775876076583236e-5,8.79179954978479373e-6,
	    7.36465810572578444e-4,8.72790805146193976e-4,
	    6.22614862573135066e-4,2.85998154194304147e-4,
	    3.84737672879366102e-6,-1.87906003636971558e-4,
	    -2.97603646594554535e-4,-3.45998126832656348e-4,
	    -3.53382470916037712e-4,-3.35715635775048757e-4,
	    -3.04321124789039809e-4,-2.66722723047612821e-4,
	    -2.27654214122819527e-4,-1.89922611854562356e-4,
	    -1.5505891859909387e-4,-1.2377824076187363e-4,
	    -9.62926147717644187e-5,-7.25178327714425337e-5,
	    -5.22070028895633801e-5,-3.50347750511900522e-5,
	    -2.06489761035551757e-5,-8.70106096849767054e-6,
	    1.1369868667510029e-6,9.16426474122778849e-6,
	    1.5647778542887262e-5,2.08223629482466847e-5,
	    2.48923381004595156e-5,2.80340509574146325e-5,
	    3.03987774629861915e-5,3.21156731406700616e-5,
	    -.00180182191963885708,-.00243402962938042533,
	    -.00183422663549856802,-7.62204596354009765e-4,
	    2.39079475256927218e-4,9.49266117176881141e-4,
	    .00134467449701540359,.00148457495259449178,.00144732339830617591,
	    .00130268261285657186,.00110351597375642682,
	    8.86047440419791759e-4,6.73073208165665473e-4,
	    4.77603872856582378e-4,3.05991926358789362e-4,
	    1.6031569459472163e-4,4.00749555270613286e-5,
	    -5.66607461635251611e-5,-1.32506186772982638e-4,
	    -1.90296187989614057e-4,-2.32811450376937408e-4,
	    -2.62628811464668841e-4,-2.82050469867598672e-4,
	    -2.93081563192861167e-4,-2.97435962176316616e-4,
	    -2.96557334239348078e-4,-2.91647363312090861e-4,
	    -2.83696203837734166e-4,-2.73512317095673346e-4,
	    -2.6175015580676858e-4,.00638585891212050914,
	    .00962374215806377941,.00761878061207001043,.00283219055545628054,
	    -.0020984135201272009,-.00573826764216626498,
	    -.0077080424449541462,-.00821011692264844401,
	    -.00765824520346905413,-.00647209729391045177,
	    -.00499132412004966473,-.0034561228971313328,
	    -.00201785580014170775,-7.59430686781961401e-4,
	    2.84173631523859138e-4,.00110891667586337403,
	    .00172901493872728771,.00216812590802684701,.00245357710494539735,
	    .00261281821058334862,.00267141039656276912,.0026520307339598043,
	    .00257411652877287315,.00245389126236094427,.00230460058071795494,
	    .00213684837686712662,.00195896528478870911,.00177737008679454412,
	    .00159690280765839059,.00142111975664438546 };
    static double gama[30] = { .629960524947436582,.251984209978974633,
	    .154790300415655846,.110713062416159013,.0857309395527394825,
	    .0697161316958684292,.0586085671893713576,.0504698873536310685,
	    .0442600580689154809,.0393720661543509966,.0354283195924455368,
	    .0321818857502098231,.0294646240791157679,.0271581677112934479,
	    .0251768272973861779,.0234570755306078891,.0219508390134907203,
	    .020621082823564624,.0194388240897880846,.0183810633800683158,
	    .0174293213231963172,.0165685837786612353,.0157865285987918445,
	    .0150729501494095594,.0144193250839954639,.0138184805735341786,
	    .0132643378994276568,.0127517121970498651,.0122761545318762767,
	    .0118338262398482403 };
    static double ex1 = .333333333333333333;
    static double ex2 = .666666666666666667;
    static double hpi = 1.57079632679489662;
    static double gpi = 3.14159265358979324;
    static double thpi = 4.71238898038468986;
    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double conei = 0.;

    /* System generated locals */
    int i__1, i__2;
    double d__1;

    /* Local variables */
    static int j, k, l, m, l1, l2;
    static double ac, ap[30], pi[30];
    static int is, jr, ks, ju;
    static double pp, wi, pr[30];
    static int lr;
    static double wr, aw2;
    static int kp1;
    static double t2i, w2i, t2r, w2r, ang, fn13, fn23;
    static int ias;
    static double cri[14], dri[14];
    static int ibs;
    static double zai, zbi, zci, crr[14], drr[14], raw, zar, upi[14], sti,
	     zbr, zcr, upr[14], str, raw2;
    static int lrp1;
    static double rfn13;
    static int idum;
    static double atol, btol, tfni;
    static int kmax;
    static double azth, tzai, tfnr, rfnu;
    extern /* Subroutine */ int zdiv_(double *, double *, double *
	    , double *, double *, double *);
    static double zthi, test, tzar, zthr, rfnu2;
    extern double zabse_(double *, double *);
    static double zetai, ptfni, sumai, sumbi;
    extern /* Subroutine */ int zloge_(double *, double *, double 
	    *, double *, int *);
    static double zetar, ptfnr, razth, sumar, sumbr, rzthi;
    extern double d1mach_(int *);
    static double rzthr, rtzti, rtztr, przthi;
    extern /* Subroutine */ int zsqrte_(double *, double *, 
	    double *, double *);
    static double przthr;

/* ***BEGIN PROLOGUE  ZUNHJ */
/* ***REFER TO  ZBESI,ZBESK */

/*     REFERENCES */
/*         HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. */
/*         STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. */

/*         ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC */
/*         PRESS, N.Y., 1974, PAGE 420 */

/*     ABSTRACT */
/*         ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = */
/*         J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU */
/*         BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION */

/*         C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) */

/*         FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS */
/*         AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. */

/*               (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, */

/*         ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING */
/*         PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. */

/*         MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND */
/*         MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= */
/*         1 COMPUTES ALL EXCEPT ASUM AND BSUM. */

/* ***ROUTINES CALLED  ZABSE,ZDIV,ZLOGE,ZSQRTE,D1MACH */
/* ***END PROLOGUE  ZUNHJ */
/*     COMPLEX ARG,ASUM,BSUM,CFNU,CONE,CR,CZERO,DR,P,PHI,PRZTH,PTFN, */
/*    *RFN13,RTZTA,RZTH,SUMA,SUMB,TFN,T2,UP,W,W2,Z,ZA,ZB,ZC,ZETA,ZETA1, */
/*    *ZETA2,ZTH */

    rfnu = 1. / *fnu;
/* ----------------------------------------------------------------------- */
/*     OVERFLOW TEST (Z/FNU TOO SMALL) */
/* ----------------------------------------------------------------------- */
    test = d1mach_(&c__1) * 1e3;
    ac = *fnu * test;
    if(abs(*zr) > ac || abs(*zi) > ac) {
	goto L15;
    }
    *zeta1r = (d__1 = log(test), abs(d__1)) * 2. + *fnu;
    *zeta1i = 0.;
    *zeta2r = *fnu;
    *zeta2i = 0.;
    *phir = 1.;
    *phii = 0.;
    *argr = 1.;
    *argi = 0.;
    return 0;
L15:
    zbr = *zr * rfnu;
    zbi = *zi * rfnu;
    rfnu2 = rfnu * rfnu;
/* ----------------------------------------------------------------------- */
/*     COMPUTE IN THE FOURTH QUADRANT */
/* ----------------------------------------------------------------------- */
    fn13 = pow_dd(fnu, &ex1);
    fn23 = fn13 * fn13;
    rfn13 = 1. / fn13;
    w2r = coner - zbr * zbr + zbi * zbi;
    w2i = conei - zbr * zbi - zbr * zbi;
    aw2 = zabse_(&w2r, &w2i);
    if(aw2 > .25) {
	goto L130;
    }
/* ----------------------------------------------------------------------- */
/*     POWER SERIES FOR CABS(W2).LE.0.25D0 */
/* ----------------------------------------------------------------------- */
    k = 1;
    pr[0] = coner;
    pi[0] = conei;
    sumar = gama[0];
    sumai = zeroi;
    ap[0] = 1.;
    if(aw2 < *tol) {
	goto L20;
    }
    for (k = 2; k <= 30; ++k) {
	pr[k - 1] = pr[k - 2] * w2r - pi[k - 2] * w2i;
	pi[k - 1] = pr[k - 2] * w2i + pi[k - 2] * w2r;
	sumar += pr[k - 1] * gama[k - 1];
	sumai += pi[k - 1] * gama[k - 1];
	ap[k - 1] = ap[k - 2] * aw2;
	if(ap[k - 1] < *tol) {
	    goto L20;
	}
/* L10: */
    }
    k = 30;
L20:
    kmax = k;
    zetar = w2r * sumar - w2i * sumai;
    zetai = w2r * sumai + w2i * sumar;
    *argr = zetar * fn23;
    *argi = zetai * fn23;
    zsqrte_(&sumar, &sumai, &zar, &zai);
    zsqrte_(&w2r, &w2i, &str, &sti);
    *zeta2r = str * *fnu;
    *zeta2i = sti * *fnu;
    str = coner + ex2 * (zetar * zar - zetai * zai);
    sti = conei + ex2 * (zetar * zai + zetai * zar);
    *zeta1r = str * *zeta2r - sti * *zeta2i;
    *zeta1i = str * *zeta2i + sti * *zeta2r;
    zar += zar;
    zai += zai;
    zsqrte_(&zar, &zai, &str, &sti);
    *phir = str * rfn13;
    *phii = sti * rfn13;
    if(*ipmtr == 1) {
	goto L120;
    }
/* ----------------------------------------------------------------------- */
/*     SUM SERIES FOR ASUM AND BSUM */
/* ----------------------------------------------------------------------- */
    sumbr = zeror;
    sumbi = zeroi;
    i__1 = kmax;
    for (k = 1; k <= i__1; ++k) {
	sumbr += pr[k - 1] * beta[k - 1];
	sumbi += pi[k - 1] * beta[k - 1];
/* L30: */
    }
    *asumr = zeror;
    *asumi = zeroi;
    *bsumr = sumbr;
    *bsumi = sumbi;
    l1 = 0;
    l2 = 30;
    btol = *tol * (abs(*bsumr) + abs(*bsumi));
    atol = *tol;
    pp = 1.;
    ias = 0;
    ibs = 0;
    if(rfnu2 < *tol) {
	goto L110;
    }
    for (is = 2; is <= 7; ++is) {
	atol /= rfnu2;
	pp *= rfnu2;
	if(ias == 1) {
	    goto L60;
	}
	sumar = zeror;
	sumai = zeroi;
	i__1 = kmax;
	for (k = 1; k <= i__1; ++k) {
	    m = l1 + k;
	    sumar += pr[k - 1] * alfa[m - 1];
	    sumai += pi[k - 1] * alfa[m - 1];
	    if(ap[k - 1] < atol) {
		goto L50;
	    }
/* L40: */
	}
L50:
	*asumr += sumar * pp;
	*asumi += sumai * pp;
	if(pp < *tol) {
	    ias = 1;
	}
L60:
	if(ibs == 1) {
	    goto L90;
	}
	sumbr = zeror;
	sumbi = zeroi;
	i__1 = kmax;
	for (k = 1; k <= i__1; ++k) {
	    m = l2 + k;
	    sumbr += pr[k - 1] * beta[m - 1];
	    sumbi += pi[k - 1] * beta[m - 1];
	    if(ap[k - 1] < atol) {
		goto L80;
	    }
/* L70: */
	}
L80:
	*bsumr += sumbr * pp;
	*bsumi += sumbi * pp;
	if(pp < btol) {
	    ibs = 1;
	}
L90:
	if(ias == 1 && ibs == 1) {
	    goto L110;
	}
	l1 += 30;
	l2 += 30;
/* L100: */
    }
L110:
    *asumr += coner;
    pp = rfnu * rfn13;
    *bsumr *= pp;
    *bsumi *= pp;
L120:
    return 0;
/* ----------------------------------------------------------------------- */
/*     CABS(W2).GT.0.25D0 */
/* ----------------------------------------------------------------------- */
L130:
    zsqrte_(&w2r, &w2i, &wr, &wi);
    if(wr < 0.) {
	wr = 0.;
    }
    if(wi < 0.) {
	wi = 0.;
    }
    str = coner + wr;
    sti = wi;
    zdiv_(&str, &sti, &zbr, &zbi, &zar, &zai);
    zloge_(&zar, &zai, &zcr, &zci, &idum);
    if(zci < 0.) {
	zci = 0.;
    }
    if(zci > hpi) {
	zci = hpi;
    }
    if(zcr < 0.) {
	zcr = 0.;
    }
    zthr = (zcr - wr) * 1.5;
    zthi = (zci - wi) * 1.5;
    *zeta1r = zcr * *fnu;
    *zeta1i = zci * *fnu;
    *zeta2r = wr * *fnu;
    *zeta2i = wi * *fnu;
    azth = zabse_(&zthr, &zthi);
    ang = thpi;
    if(zthr >= 0. && zthi < 0.) {
	goto L140;
    }
    ang = hpi;
    if(zthr == 0.) {
	goto L140;
    }
    ang = atan(zthi / zthr);
    if(zthr < 0.) {
	ang += gpi;
    }
L140:
    pp = pow_dd(&azth, &ex2);
    ang *= ex2;
    zetar = pp * cos(ang);
    zetai = pp * sin(ang);
    if(zetai < 0.) {
	zetai = 0.;
    }
    *argr = zetar * fn23;
    *argi = zetai * fn23;
    zdiv_(&zthr, &zthi, &zetar, &zetai, &rtztr, &rtzti);
    zdiv_(&rtztr, &rtzti, &wr, &wi, &zar, &zai);
    tzar = zar + zar;
    tzai = zai + zai;
    zsqrte_(&tzar, &tzai, &str, &sti);
    *phir = str * rfn13;
    *phii = sti * rfn13;
    if(*ipmtr == 1) {
	goto L120;
    }
    raw = 1. / sqrt(aw2);
    str = wr * raw;
    sti = -wi * raw;
    tfnr = str * rfnu * raw;
    tfni = sti * rfnu * raw;
    razth = 1. / azth;
    str = zthr * razth;
    sti = -zthi * razth;
    rzthr = str * razth * rfnu;
    rzthi = sti * razth * rfnu;
    zcr = rzthr * ar[1];
    zci = rzthi * ar[1];
    raw2 = 1. / aw2;
    str = w2r * raw2;
    sti = -w2i * raw2;
    t2r = str * raw2;
    t2i = sti * raw2;
    str = t2r * c__[1] + c__[2];
    sti = t2i * c__[1];
    upr[1] = str * tfnr - sti * tfni;
    upi[1] = str * tfni + sti * tfnr;
    *bsumr = upr[1] + zcr;
    *bsumi = upi[1] + zci;
    *asumr = zeror;
    *asumi = zeroi;
    if(rfnu < *tol) {
	goto L220;
    }
    przthr = rzthr;
    przthi = rzthi;
    ptfnr = tfnr;
    ptfni = tfni;
    upr[0] = coner;
    upi[0] = conei;
    pp = 1.;
    btol = *tol * (abs(*bsumr) + abs(*bsumi));
    ks = 0;
    kp1 = 2;
    l = 3;
    ias = 0;
    ibs = 0;
    for (lr = 2; lr <= 12; lr += 2) {
	lrp1 = lr + 1;
/* ----------------------------------------------------------------------- */
/*     COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN */
/*     NEXT SUMA AND SUMB */
/* ----------------------------------------------------------------------- */
	i__1 = lrp1;
	for (k = lr; k <= i__1; ++k) {
	    ++ks;
	    ++kp1;
	    ++l;
	    zar = c__[l - 1];
	    zai = zeroi;
	    i__2 = kp1;
	    for (j = 2; j <= i__2; ++j) {
		++l;
		str = zar * t2r - t2i * zai + c__[l - 1];
		zai = zar * t2i + zai * t2r;
		zar = str;
/* L150: */
	    }
	    str = ptfnr * tfnr - ptfni * tfni;
	    ptfni = ptfnr * tfni + ptfni * tfnr;
	    ptfnr = str;
	    upr[kp1 - 1] = ptfnr * zar - ptfni * zai;
	    upi[kp1 - 1] = ptfni * zar + ptfnr * zai;
	    crr[ks - 1] = przthr * br[ks];
	    cri[ks - 1] = przthi * br[ks];
	    str = przthr * rzthr - przthi * rzthi;
	    przthi = przthr * rzthi + przthi * rzthr;
	    przthr = str;
	    drr[ks - 1] = przthr * ar[ks + 1];
	    dri[ks - 1] = przthi * ar[ks + 1];
/* L160: */
	}
	pp *= rfnu2;
	if(ias == 1) {
	    goto L180;
	}
	sumar = upr[lrp1 - 1];
	sumai = upi[lrp1 - 1];
	ju = lrp1;
	i__1 = lr;
	for (jr = 1; jr <= i__1; ++jr) {
	    --ju;
	    sumar = sumar + crr[jr - 1] * upr[ju - 1] - cri[jr - 1] * upi[ju 
		    - 1];
	    sumai = sumai + crr[jr - 1] * upi[ju - 1] + cri[jr - 1] * upr[ju 
		    - 1];
/* L170: */
	}
	*asumr += sumar;
	*asumi += sumai;
	test = abs(sumar) + abs(sumai);
	if(pp < *tol && test < *tol) {
	    ias = 1;
	}
L180:
	if(ibs == 1) {
	    goto L200;
	}
	sumbr = upr[lr + 1] + upr[lrp1 - 1] * zcr - upi[lrp1 - 1] * zci;
	sumbi = upi[lr + 1] + upr[lrp1 - 1] * zci + upi[lrp1 - 1] * zcr;
	ju = lrp1;
	i__1 = lr;
	for (jr = 1; jr <= i__1; ++jr) {
	    --ju;
	    sumbr = sumbr + drr[jr - 1] * upr[ju - 1] - dri[jr - 1] * upi[ju 
		    - 1];
	    sumbi = sumbi + drr[jr - 1] * upi[ju - 1] + dri[jr - 1] * upr[ju 
		    - 1];
/* L190: */
	}
	*bsumr += sumbr;
	*bsumi += sumbi;
	test = abs(sumbr) + abs(sumbi);
	if(pp < btol && test < btol) {
	    ibs = 1;
	}
L200:
	if(ias == 1 && ibs == 1) {
	    goto L220;
	}
/* L210: */
    }
L220:
    *asumr += coner;
    str = -(*bsumr) * rfn13;
    sti = -(*bsumi) * rfn13;
    zdiv_(&str, &sti, &rtztr, &rtzti, bsumr, bsumi);
    goto L120;
} /* zunhj_ */

/* ========================================================== */
/* Subroutine */ int zunk1_(double *zr, double *zi, double *fnu, 
	int *kode, int *mr, int *n, double *yr, double *
	yi, int *nz, double *tol, double *elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double pi = 3.14159265358979324;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, j, k, m, ib, ic;
    static double fn;
    static int il, kk, nw;
    static double c1i, c2i, c2m, c1r, c2r, s1i, s2i, rs1, s1r, s2r, ang, 
	    asc, cki, fnf;
    static int ifn;
    static double ckr;
    static int iuf;
    static double cyi[2], fmr, csr, sgn;
    static int inu;
    static double bry[3], cyr[2], sti, rzi, zri, str, rzr, zrr, aphi, 
	    cscl, phii[2], crsc, phir[2];
    static int init[2];
    static double csrr[3], cssr[3], rast, sumi[2], razr;
    extern /* Subroutine */ int zs1s2_(double *, double *, double 
	    *, double *, double *, double *, int *, 
	    double *, double *, int *);
    static double sumr[2];
    static int iflag, kflag;
    static double ascle;
    static int kdflg;
    static double phidi;
    static int ipard;
    static double csgni;
    extern double zabse_(double *, double *);
    static double phidr;
    static int initd;
    static double cspni, cwrki[48]	/* was [16][3] */, sumdi;
    extern /* Subroutine */ int zuchk_(double *, double *, int *, 
	    double *, double *);
    static double cspnr, cwrkr[48]	/* was [16][3] */, sumdr;
    extern double d1mach_(int *);
    extern /* Subroutine */ int zunik_(double *, double *, double 
	    *, int *, int *, double *, int *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *);
    static double zeta1i[2], zeta2i[2], zet1di, zet2di, zeta1r[2], zeta2r[
	    2], zet1dr, zet2dr;

/* ***BEGIN PROLOGUE  ZUNK1 */
/* ***REFER TO  ZBESK */

/*     ZUNK1 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE */
/*     RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE */
/*     UNIFORM ASYMPTOTIC EXPANSION. */
/*     MR INDICATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. */
/*     NZ=-1 MEANS AN OVERFLOW WILL OCCUR */

/* ***ROUTINES CALLED  ZKSCL,ZS1S2,ZUCHK,ZUNIK,D1MACH,ZABSE */
/* ***END PROLOGUE  ZUNK1 */
/*     COMPLEX CFN,CK,CONE,CRSC,CS,CSCL,CSGN,CSPN,CSR,CSS,CWRK,CY,CZERO, */
/*    *C1,C2,PHI,PHID,RZ,SUM,SUMD,S1,S2,Y,Z,ZETA1,ZETA1D,ZETA2,ZETA2D,ZR */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    kdflg = 1;
    *nz = 0;
/* ----------------------------------------------------------------------- */
/*     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN */
/*     THE UNDERFLOW LIMIT */
/* ----------------------------------------------------------------------- */
    cscl = 1. / *tol;
    crsc = *tol;
    cssr[0] = cscl;
    cssr[1] = coner;
    cssr[2] = crsc;
    csrr[0] = crsc;
    csrr[1] = coner;
    csrr[2] = cscl;
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
    bry[1] = 1. / bry[0];
    bry[2] = d1mach_(&c__2);
    zrr = *zr;
    zri = *zi;
    if(*zr >= 0.) {
	goto L10;
    }
    zrr = -(*zr);
    zri = -(*zi);
L10:
    j = 2;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
/* ----------------------------------------------------------------------- */
/*     J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J */
/* ----------------------------------------------------------------------- */
	j = 3 - j;
	fn = *fnu + (double) ((float) (i__ - 1));
	init[j - 1] = 0;
	zunik_(&zrr, &zri, &fn, &c__2, &c__0, tol, &init[j - 1], &phir[j - 1],
		 &phii[j - 1], &zeta1r[j - 1], &zeta1i[j - 1], &zeta2r[j - 1],
		 &zeta2i[j - 1], &sumr[j - 1], &sumi[j - 1], &cwrkr[(j << 4) 
		- 16], &cwrki[(j << 4) - 16]);
	if(*kode == 1) {
	    goto L20;
	}
	str = zrr + zeta2r[j - 1];
	sti = zri + zeta2i[j - 1];
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = zeta1r[j - 1] - str;
	s1i = zeta1i[j - 1] - sti;
	goto L30;
L20:
	s1r = zeta1r[j - 1] - zeta2r[j - 1];
	s1i = zeta1i[j - 1] - zeta2i[j - 1];
L30:
	rs1 = s1r;
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	if(abs(rs1) > *elim) {
	    goto L60;
	}
	if(kdflg == 1) {
	    kflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L40;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phir[j - 1], &phii[j - 1]);
	rs1 += log(aphi);
	if(abs(rs1) > *elim) {
	    goto L60;
	}
	if(kdflg == 1) {
	    kflag = 1;
	}
	if(rs1 < 0.) {
	    goto L40;
	}
	if(kdflg == 1) {
	    kflag = 3;
	}
L40:
/* ----------------------------------------------------------------------- */
/*     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR */
/*     EXPONENT EXTREMES */
/* ----------------------------------------------------------------------- */
	s2r = phir[j - 1] * sumr[j - 1] - phii[j - 1] * sumi[j - 1];
	s2i = phir[j - 1] * sumi[j - 1] + phii[j - 1] * sumr[j - 1];
	str = exp(s1r) * cssr[kflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s1r * s2i + s2r * s1i;
	s2r = str;
	if(kflag != 1) {
	    goto L50;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw != 0) {
	    goto L60;
	}
L50:
	cyr[kdflg - 1] = s2r;
	cyi[kdflg - 1] = s2i;
	yr[i__] = s2r * csrr[kflag - 1];
	yi[i__] = s2i * csrr[kflag - 1];
	if(kdflg == 2) {
	    goto L75;
	}
	kdflg = 2;
	goto L70;
L60:
	if(rs1 > 0.) {
	    goto L300;
	}
/* ----------------------------------------------------------------------- */
/*     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */
/* ----------------------------------------------------------------------- */
	if(*zr < 0.) {
	    goto L300;
	}
	kdflg = 1;
	yr[i__] = zeror;
	yi[i__] = zeroi;
	++(*nz);
	if(i__ == 1) {
	    goto L70;
	}
	if(yr[i__ - 1] == zeror && yi[i__ - 1] == zeroi) {
	    goto L70;
	}
	yr[i__ - 1] = zeror;
	yi[i__ - 1] = zeroi;
	++(*nz);
L70:
	;
    }
    i__ = *n;
L75:
    razr = 1. / zabse_(&zrr, &zri);
    str = zrr * razr;
    sti = -zri * razr;
    rzr = (str + str) * razr;
    rzi = (sti + sti) * razr;
    ckr = fn * rzr;
    cki = fn * rzi;
    ib = i__ + 1;
    if(*n < ib) {
	goto L160;
    }
/* ----------------------------------------------------------------------- */
/*     TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO */
/*     ON UNDERFLOW. */
/* ----------------------------------------------------------------------- */
    fn = *fnu + (double) ((float) (*n - 1));
    ipard = 1;
    if(*mr != 0) {
	ipard = 0;
    }
    initd = 0;
    zunik_(&zrr, &zri, &fn, &c__2, &ipard, tol, &initd, &phidr, &phidi, &
	    zet1dr, &zet1di, &zet2dr, &zet2di, &sumdr, &sumdi, &cwrkr[32], &
	    cwrki[32]);
    if(*kode == 1) {
	goto L80;
    }
    str = zrr + zet2dr;
    sti = zri + zet2di;
    rast = fn / zabse_(&str, &sti);
    str = str * rast * rast;
    sti = -sti * rast * rast;
    s1r = zet1dr - str;
    s1i = zet1di - sti;
    goto L90;
L80:
    s1r = zet1dr - zet2dr;
    s1i = zet1di - zet2di;
L90:
    rs1 = s1r;
    if(abs(rs1) > *elim) {
	goto L95;
    }
    if(abs(rs1) < *alim) {
	goto L100;
    }
/* ---------------------------------------------------------------------------- */
/*     REFINE ESTIMATE AND TEST */
/* ------------------------------------------------------------------------- */
    aphi = zabse_(&phidr, &phidi);
    rs1 += log(aphi);
    if(abs(rs1) < *elim) {
	goto L100;
    }
L95:
    if(abs(rs1) > 0.) {
	goto L300;
    }
/* ----------------------------------------------------------------------- */
/*     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */
/* ----------------------------------------------------------------------- */
    if(*zr < 0.) {
	goto L300;
    }
    *nz = *n;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L96: */
    }
    return 0;
/* --------------------------------------------------------------------------- */
/*     FORWARD RECUR FOR REMAINDER OF THE SEQUENCE */
/* ---------------------------------------------------------------------------- */
L100:
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    c1r = csrr[kflag - 1];
    ascle = bry[kflag - 1];
    i__1 = *n;
    for (i__ = ib; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = ckr * c2r - cki * c2i + s1r;
	s2i = ckr * c2i + cki * c2r + s1i;
	s1r = c2r;
	s1i = c2i;
	ckr += rzr;
	cki += rzi;
	c2r = s2r * c1r;
	c2i = s2i * c1r;
	yr[i__] = c2r;
	yi[i__] = c2i;
	if(kflag >= 3) {
	    goto L120;
	}
	str = abs(c2r);
	sti = abs(c2i);
	c2m = max(str,sti);
	if(c2m <= ascle) {
	    goto L120;
	}
	++kflag;
	ascle = bry[kflag - 1];
	s1r *= c1r;
	s1i *= c1r;
	s2r = c2r;
	s2i = c2i;
	s1r *= cssr[kflag - 1];
	s1i *= cssr[kflag - 1];
	s2r *= cssr[kflag - 1];
	s2i *= cssr[kflag - 1];
	c1r = csrr[kflag - 1];
L120:
	;
    }
L160:
    if(*mr == 0) {
	return 0;
    }
/* ----------------------------------------------------------------------- */
/*     ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0 */
/* ----------------------------------------------------------------------- */
    *nz = 0;
    fmr = (double) ((float) (*mr));
    sgn = -d_sign(&pi, &fmr);
/* ----------------------------------------------------------------------- */
/*     CSPN AND CSGN ARE COEFF OF K AND I FUNCTIONS RESP. */
/* ----------------------------------------------------------------------- */
    csgni = sgn;
    inu = (int) ((float) (*fnu));
    fnf = *fnu - (double) ((float) inu);
    ifn = inu + *n - 1;
    ang = fnf * sgn;
    cspnr = cos(ang);
    cspni = sin(ang);
    if(ifn % 2 == 0) {
	goto L170;
    }
    cspnr = -cspnr;
    cspni = -cspni;
L170:
    asc = bry[0];
    iuf = 0;
    kk = *n;
    kdflg = 1;
    --ib;
    ic = ib - 1;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	fn = *fnu + (double) ((float) (kk - 1));
/* ----------------------------------------------------------------------- */
/*     LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K */
/*     FUNCTION ABOVE */
/* ----------------------------------------------------------------------- */
	m = 3;
	if(*n > 2) {
	    goto L175;
	}
L172:
	initd = init[j - 1];
	phidr = phir[j - 1];
	phidi = phii[j - 1];
	zet1dr = zeta1r[j - 1];
	zet1di = zeta1i[j - 1];
	zet2dr = zeta2r[j - 1];
	zet2di = zeta2i[j - 1];
	sumdr = sumr[j - 1];
	sumdi = sumi[j - 1];
	m = j;
	j = 3 - j;
	goto L180;
L175:
	if(kk == *n && ib < *n) {
	    goto L180;
	}
	if(kk == ib || kk == ic) {
	    goto L172;
	}
	initd = 0;
L180:
	zunik_(&zrr, &zri, &fn, &c__1, &c__0, tol, &initd, &phidr, &phidi, &
		zet1dr, &zet1di, &zet2dr, &zet2di, &sumdr, &sumdi, &cwrkr[(m 
		<< 4) - 16], &cwrki[(m << 4) - 16]);
	if(*kode == 1) {
	    goto L200;
	}
	str = zrr + zet2dr;
	sti = zri + zet2di;
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = -zet1dr + str;
	s1i = -zet1di + sti;
	goto L210;
L200:
	s1r = -zet1dr + zet2dr;
	s1i = -zet1di + zet2di;
L210:
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	rs1 = s1r;
	if(abs(rs1) > *elim) {
	    goto L260;
	}
	if(kdflg == 1) {
	    iflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L220;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phidr, &phidi);
	rs1 += log(aphi);
	if(abs(rs1) > *elim) {
	    goto L260;
	}
	if(kdflg == 1) {
	    iflag = 1;
	}
	if(rs1 < 0.) {
	    goto L220;
	}
	if(kdflg == 1) {
	    iflag = 3;
	}
L220:
	str = phidr * sumdr - phidi * sumdi;
	sti = phidr * sumdi + phidi * sumdr;
	s2r = -csgni * sti;
	s2i = csgni * str;
	str = exp(s1r) * cssr[iflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s2r * s1i + s2i * s1r;
	s2r = str;
	if(iflag != 1) {
	    goto L230;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw == 0) {
	    goto L230;
	}
	s2r = zeror;
	s2i = zeroi;
L230:
	cyr[kdflg - 1] = s2r;
	cyi[kdflg - 1] = s2i;
	c2r = s2r;
	c2i = s2i;
	s2r *= csrr[iflag - 1];
	s2i *= csrr[iflag - 1];
/* ----------------------------------------------------------------------- */
/*     ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N */
/* ----------------------------------------------------------------------- */
	s1r = yr[kk];
	s1i = yi[kk];
	if(*kode == 1) {
	    goto L250;
	}
	zs1s2_(&zrr, &zri, &s1r, &s1i, &s2r, &s2i, &nw, &asc, alim, &iuf);
	*nz += nw;
L250:
	yr[kk] = s1r * cspnr - s1i * cspni + s2r;
	yi[kk] = cspnr * s1i + cspni * s1r + s2i;
	--kk;
	cspnr = -cspnr;
	cspni = -cspni;
	if(c2r != 0. || c2i != 0.) {
	    goto L255;
	}
	kdflg = 1;
	goto L270;
L255:
	if(kdflg == 2) {
	    goto L275;
	}
	kdflg = 2;
	goto L270;
L260:
	if(rs1 > 0.) {
	    goto L300;
	}
	s2r = zeror;
	s2i = zeroi;
	goto L230;
L270:
	;
    }
    k = *n;
L275:
    il = *n - k;
    if(il == 0) {
	return 0;
    }
/* ----------------------------------------------------------------------- */
/*     RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE */
/*     K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP */
/*     INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. */
/* ----------------------------------------------------------------------- */
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    csr = csrr[iflag - 1];
    ascle = bry[iflag - 1];
    fn = (double) ((float) (inu + il));
    i__1 = il;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = s1r + (fn + fnf) * (rzr * c2r - rzi * c2i);
	s2i = s1i + (fn + fnf) * (rzr * c2i + rzi * c2r);
	s1r = c2r;
	s1i = c2i;
	fn += -1.;
	c2r = s2r * csr;
	c2i = s2i * csr;
	ckr = c2r;
	cki = c2i;
	c1r = yr[kk];
	c1i = yi[kk];
	if(*kode == 1) {
	    goto L280;
	}
	zs1s2_(&zrr, &zri, &c1r, &c1i, &c2r, &c2i, &nw, &asc, alim, &iuf);
	*nz += nw;
L280:
	yr[kk] = c1r * cspnr - c1i * cspni + c2r;
	yi[kk] = c1r * cspni + c1i * cspnr + c2i;
	--kk;
	cspnr = -cspnr;
	cspni = -cspni;
	if(iflag >= 3) {
	    goto L290;
	}
	c2r = abs(ckr);
	c2i = abs(cki);
	c2m = max(c2r,c2i);
	if(c2m <= ascle) {
	    goto L290;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= csr;
	s1i *= csr;
	s2r = ckr;
	s2i = cki;
	s1r *= cssr[iflag - 1];
	s1i *= cssr[iflag - 1];
	s2r *= cssr[iflag - 1];
	s2i *= cssr[iflag - 1];
	csr = csrr[iflag - 1];
L290:
	;
    }
    return 0;
L300:
    *nz = -1;
    return 0;
} /* zunk1_ */

/* ========================================================== */
/* Subroutine */ int zunk2_(double *zr, double *zi, double *fnu, 
	int *kode, int *mr, int *n, double *yr, double *
	yi, int *nz, double *tol, double *elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double cr1r = 1.;
    static double cr1i = 1.73205080756887729;
    static double cr2r = -.5;
    static double cr2i = -.866025403784438647;
    static double hpi = 1.57079632679489662;
    static double pi = 3.14159265358979324;
    static double aic = 1.26551212348464539;
    static double cipr[4] = { 1.,0.,-1.,0. };
    static double cipi[4] = { 0.,-1.,0.,1. };

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, j, k, ib, ic;
    static double fn;
    static int il, kk, in, nw;
    static double yy, c1i, c2i, c2m, c1r, c2r, s1i, s2i, rs1, s1r, s2r, 
	    aii, ang, asc, car, cki, fnf;
    static int nai;
    static double air;
    static int ifn;
    static double csi, ckr;
    static int iuf;
    static double cyi[2], fmr, sar, csr, sgn, zbi;
    static int inu;
    static double bry[3], cyr[2], pti, sti, zbr, zni, rzi, ptr, zri, str, 
	    znr, rzr, zrr, daii, aarg;
    static int ndai;
    static double dair, aphi, argi[2], cscl, phii[2], crsc, argr[2];
    static int idum;
    static double phir[2], csrr[3], cssr[3], rast, razr;
    extern /* Subroutine */ int zs1s2_(double *, double *, double 
	    *, double *, double *, double *, int *, 
	    double *, double *, int *);
    static int iflag, kflag;
    static double argdi, ascle;
    static int kdflg;
    static double phidi, argdr;
    static int ipard;
    static double csgni;
    extern double zabse_(double *, double *);
    static double phidr, cspni, asumi[2], bsumi[2];
    extern /* Subroutine */ int zuchk_(double *, double *, int *, 
	    double *, double *);
    static double cspnr, asumr[2], bsumr[2];
    extern double d1mach_(int *);
    extern /* Subroutine */ int zunhj_(double *, double *, double 
	    *, int *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *), zairy_(double *, double *, 
	    int *, int *, double *, double *, int *, 
	    int *);
    static double zeta1i[2], zeta2i[2], zet1di, zet2di, zeta1r[2], zeta2r[
	    2], zet1dr, zet2dr, asumdi, bsumdi, asumdr, bsumdr;

/* ***BEGIN PROLOGUE  ZUNK2 */
/* ***REFER TO  ZBESK */

/*     ZUNK2 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE */
/*     RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE */
/*     UNIFORM ASYMPTOTIC EXPANSIONS FOR H(KIND,FNU,ZN) AND J(FNU,ZN) */
/*     WHERE ZN IS IN THE RIGHT HALF PLANE, KIND=(3-MR)/2, MR=+1 OR */
/*     -1. HERE ZN=ZR*I OR -ZR*I WHERE ZR=Z IF Z IS IN THE RIGHT */
/*     HALF PLANE OR ZR=-Z IF Z IS IN THE LEFT HALF PLANE. MR INDIC- */
/*     ATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. */
/*     NZ=-1 MEANS AN OVERFLOW WILL OCCUR */

/* ***ROUTINES CALLED  ZAIRY,ZKSCL,ZS1S2,ZUCHK,ZUNHJ,D1MACH,ZABSE */
/* ***END PROLOGUE  ZUNK2 */
/*     COMPLEX AI,ARG,ARGD,ASUM,ASUMD,BSUM,BSUMD,CFN,CI,CIP,CK,CONE,CRSC, */
/*    *CR1,CR2,CS,CSCL,CSGN,CSPN,CSR,CSS,CY,CZERO,C1,C2,DAI,PHI,PHID,RZ, */
/*    *S1,S2,Y,Z,ZB,ZETA1,ZETA1D,ZETA2,ZETA2D,ZN,ZR */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    kdflg = 1;
    *nz = 0;
/* ----------------------------------------------------------------------- */
/*     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN */
/*     THE UNDERFLOW LIMIT */
/* ----------------------------------------------------------------------- */
    cscl = 1. / *tol;
    crsc = *tol;
    cssr[0] = cscl;
    cssr[1] = coner;
    cssr[2] = crsc;
    csrr[0] = crsc;
    csrr[1] = coner;
    csrr[2] = cscl;
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
    bry[1] = 1. / bry[0];
    bry[2] = d1mach_(&c__2);
    zrr = *zr;
    zri = *zi;
    if(*zr >= 0.) {
	goto L10;
    }
    zrr = -(*zr);
    zri = -(*zi);
L10:
    yy = zri;
    znr = zri;
    zni = -zrr;
    zbr = zrr;
    zbi = zri;
    inu = (int) ((float) (*fnu));
    fnf = *fnu - (double) ((float) inu);
    ang = -hpi * fnf;
    car = cos(ang);
    sar = sin(ang);
    c2r = hpi * sar;
    c2i = -hpi * car;
    kk = inu % 4 + 1;
    str = c2r * cipr[kk - 1] - c2i * cipi[kk - 1];
    sti = c2r * cipi[kk - 1] + c2i * cipr[kk - 1];
    csr = cr1r * str - cr1i * sti;
    csi = cr1r * sti + cr1i * str;
    if(yy > 0.) {
	goto L20;
    }
    znr = -znr;
    zbi = -zbi;
L20:
/* ----------------------------------------------------------------------- */
/*     K(FNU,Z) IS COMPUTED FROM H(2,FNU,-I*Z) WHERE Z IS IN THE FIRST */
/*     QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY */
/*     CONJUGATION SINCE THE K FUNCTION IS REAL ON THE POSITIVE REAL AXIS */
/* ----------------------------------------------------------------------- */
    j = 2;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
/* ----------------------------------------------------------------------- */
/*     J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J */
/* ----------------------------------------------------------------------- */
	j = 3 - j;
	fn = *fnu + (double) ((float) (i__ - 1));
	zunhj_(&znr, &zni, &fn, &c__0, tol, &phir[j - 1], &phii[j - 1], &argr[
		j - 1], &argi[j - 1], &zeta1r[j - 1], &zeta1i[j - 1], &zeta2r[
		j - 1], &zeta2i[j - 1], &asumr[j - 1], &asumi[j - 1], &bsumr[
		j - 1], &bsumi[j - 1]);
	if(*kode == 1) {
	    goto L30;
	}
	str = zbr + zeta2r[j - 1];
	sti = zbi + zeta2i[j - 1];
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = zeta1r[j - 1] - str;
	s1i = zeta1i[j - 1] - sti;
	goto L40;
L30:
	s1r = zeta1r[j - 1] - zeta2r[j - 1];
	s1i = zeta1i[j - 1] - zeta2i[j - 1];
L40:
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	rs1 = s1r;
	if(abs(rs1) > *elim) {
	    goto L70;
	}
	if(kdflg == 1) {
	    kflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L50;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phir[j - 1], &phii[j - 1]);
	aarg = zabse_(&argr[j - 1], &argi[j - 1]);
	rs1 = rs1 + log(aphi) - log(aarg) * .25 - aic;
	if(abs(rs1) > *elim) {
	    goto L70;
	}
	if(kdflg == 1) {
	    kflag = 1;
	}
	if(rs1 < 0.) {
	    goto L50;
	}
	if(kdflg == 1) {
	    kflag = 3;
	}
L50:
/* ----------------------------------------------------------------------- */
/*     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR */
/*     EXPONENT EXTREMES */
/* ----------------------------------------------------------------------- */
	c2r = argr[j - 1] * cr2r - argi[j - 1] * cr2i;
	c2i = argr[j - 1] * cr2i + argi[j - 1] * cr2r;
	zairy_(&c2r, &c2i, &c__0, &c__2, &air, &aii, &nai, &idum);
	zairy_(&c2r, &c2i, &c__1, &c__2, &dair, &daii, &ndai, &idum);
	str = dair * bsumr[j - 1] - daii * bsumi[j - 1];
	sti = dair * bsumi[j - 1] + daii * bsumr[j - 1];
	ptr = str * cr2r - sti * cr2i;
	pti = str * cr2i + sti * cr2r;
	str = ptr + (air * asumr[j - 1] - aii * asumi[j - 1]);
	sti = pti + (air * asumi[j - 1] + aii * asumr[j - 1]);
	ptr = str * phir[j - 1] - sti * phii[j - 1];
	pti = str * phii[j - 1] + sti * phir[j - 1];
	s2r = ptr * csr - pti * csi;
	s2i = ptr * csi + pti * csr;
	str = exp(s1r) * cssr[kflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s1r * s2i + s2r * s1i;
	s2r = str;
	if(kflag != 1) {
	    goto L60;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw != 0) {
	    goto L70;
	}
L60:
	if(yy <= 0.) {
	    s2i = -s2i;
	}
	cyr[kdflg - 1] = s2r;
	cyi[kdflg - 1] = s2i;
	yr[i__] = s2r * csrr[kflag - 1];
	yi[i__] = s2i * csrr[kflag - 1];
	str = csi;
	csi = -csr;
	csr = str;
	if(kdflg == 2) {
	    goto L85;
	}
	kdflg = 2;
	goto L80;
L70:
	if(rs1 > 0.) {
	    goto L320;
	}
/* ----------------------------------------------------------------------- */
/*     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */
/* ----------------------------------------------------------------------- */
	if(*zr < 0.) {
	    goto L320;
	}
	kdflg = 1;
	yr[i__] = zeror;
	yi[i__] = zeroi;
	++(*nz);
	str = csi;
	csi = -csr;
	csr = str;
	if(i__ == 1) {
	    goto L80;
	}
	if(yr[i__ - 1] == zeror && yi[i__ - 1] == zeroi) {
	    goto L80;
	}
	yr[i__ - 1] = zeror;
	yi[i__ - 1] = zeroi;
	++(*nz);
L80:
	;
    }
    i__ = *n;
L85:
    razr = 1. / zabse_(&zrr, &zri);
    str = zrr * razr;
    sti = -zri * razr;
    rzr = (str + str) * razr;
    rzi = (sti + sti) * razr;
    ckr = fn * rzr;
    cki = fn * rzi;
    ib = i__ + 1;
    if(*n < ib) {
	goto L180;
    }
/* ----------------------------------------------------------------------- */
/*     TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO */
/*     ON UNDERFLOW. */
/* ----------------------------------------------------------------------- */
    fn = *fnu + (double) ((float) (*n - 1));
    ipard = 1;
    if(*mr != 0) {
	ipard = 0;
    }
    zunhj_(&znr, &zni, &fn, &ipard, tol, &phidr, &phidi, &argdr, &argdi, &
	    zet1dr, &zet1di, &zet2dr, &zet2di, &asumdr, &asumdi, &bsumdr, &
	    bsumdi);
    if(*kode == 1) {
	goto L90;
    }
    str = zbr + zet2dr;
    sti = zbi + zet2di;
    rast = fn / zabse_(&str, &sti);
    str = str * rast * rast;
    sti = -sti * rast * rast;
    s1r = zet1dr - str;
    s1i = zet1di - sti;
    goto L100;
L90:
    s1r = zet1dr - zet2dr;
    s1i = zet1di - zet2di;
L100:
    rs1 = s1r;
    if(abs(rs1) > *elim) {
	goto L105;
    }
    if(abs(rs1) < *alim) {
	goto L120;
    }
/* ---------------------------------------------------------------------------- */
/*     REFINE ESTIMATE AND TEST */
/* ------------------------------------------------------------------------- */
    aphi = zabse_(&phidr, &phidi);
    rs1 += log(aphi);
    if(abs(rs1) < *elim) {
	goto L120;
    }
L105:
    if(rs1 > 0.) {
	goto L320;
    }
/* ----------------------------------------------------------------------- */
/*     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW */
/* ----------------------------------------------------------------------- */
    if(*zr < 0.) {
	goto L320;
    }
    *nz = *n;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L106: */
    }
    return 0;
L120:
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    c1r = csrr[kflag - 1];
    ascle = bry[kflag - 1];
    i__1 = *n;
    for (i__ = ib; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = ckr * c2r - cki * c2i + s1r;
	s2i = ckr * c2i + cki * c2r + s1i;
	s1r = c2r;
	s1i = c2i;
	ckr += rzr;
	cki += rzi;
	c2r = s2r * c1r;
	c2i = s2i * c1r;
	yr[i__] = c2r;
	yi[i__] = c2i;
	if(kflag >= 3) {
	    goto L130;
	}
	str = abs(c2r);
	sti = abs(c2i);
	c2m = max(str,sti);
	if(c2m <= ascle) {
	    goto L130;
	}
	++kflag;
	ascle = bry[kflag - 1];
	s1r *= c1r;
	s1i *= c1r;
	s2r = c2r;
	s2i = c2i;
	s1r *= cssr[kflag - 1];
	s1i *= cssr[kflag - 1];
	s2r *= cssr[kflag - 1];
	s2i *= cssr[kflag - 1];
	c1r = csrr[kflag - 1];
L130:
	;
    }
L180:
    if(*mr == 0) {
	return 0;
    }
/* ----------------------------------------------------------------------- */
/*     ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0 */
/* ----------------------------------------------------------------------- */
    *nz = 0;
    fmr = (double) ((float) (*mr));
    sgn = -d_sign(&pi, &fmr);
/* ----------------------------------------------------------------------- */
/*     CSPN AND CSGN ARE COEFF OF K AND I FUNCIONS RESP. */
/* ----------------------------------------------------------------------- */
    csgni = sgn;
    if(yy <= 0.) {
	csgni = -csgni;
    }
    ifn = inu + *n - 1;
    ang = fnf * sgn;
    cspnr = cos(ang);
    cspni = sin(ang);
    if(ifn % 2 == 0) {
	goto L190;
    }
    cspnr = -cspnr;
    cspni = -cspni;
L190:
/* ----------------------------------------------------------------------- */
/*     CS=COEFF OF THE J FUNCTION TO GET THE I FUNCTION. I(FNU,Z) IS */
/*     COMPUTED FROM EXP(I*FNU*HPI)*J(FNU,-I*Z) WHERE Z IS IN THE FIRST */
/*     QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY */
/*     CONJUGATION SINCE THE I FUNCTION IS REAL ON THE POSITIVE REAL AXIS */
/* ----------------------------------------------------------------------- */
    csr = sar * csgni;
    csi = car * csgni;
    in = ifn % 4 + 1;
    c2r = cipr[in - 1];
    c2i = cipi[in - 1];
    str = csr * c2r + csi * c2i;
    csi = -csr * c2i + csi * c2r;
    csr = str;
    asc = bry[0];
    iuf = 0;
    kk = *n;
    kdflg = 1;
    --ib;
    ic = ib - 1;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	fn = *fnu + (double) ((float) (kk - 1));
/* ----------------------------------------------------------------------- */
/*     LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K */
/*     FUNCTION ABOVE */
/* ----------------------------------------------------------------------- */
	if(*n > 2) {
	    goto L175;
	}
L172:
	phidr = phir[j - 1];
	phidi = phii[j - 1];
	argdr = argr[j - 1];
	argdi = argi[j - 1];
	zet1dr = zeta1r[j - 1];
	zet1di = zeta1i[j - 1];
	zet2dr = zeta2r[j - 1];
	zet2di = zeta2i[j - 1];
	asumdr = asumr[j - 1];
	asumdi = asumi[j - 1];
	bsumdr = bsumr[j - 1];
	bsumdi = bsumi[j - 1];
	j = 3 - j;
	goto L210;
L175:
	if(kk == *n && ib < *n) {
	    goto L210;
	}
	if(kk == ib || kk == ic) {
	    goto L172;
	}
	zunhj_(&znr, &zni, &fn, &c__0, tol, &phidr, &phidi, &argdr, &argdi, &
		zet1dr, &zet1di, &zet2dr, &zet2di, &asumdr, &asumdi, &bsumdr, 
		&bsumdi);
L210:
	if(*kode == 1) {
	    goto L220;
	}
	str = zbr + zet2dr;
	sti = zbi + zet2di;
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = -zet1dr + str;
	s1i = -zet1di + sti;
	goto L230;
L220:
	s1r = -zet1dr + zet2dr;
	s1i = -zet1di + zet2di;
L230:
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	rs1 = s1r;
	if(abs(rs1) > *elim) {
	    goto L280;
	}
	if(kdflg == 1) {
	    iflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L240;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phidr, &phidi);
	aarg = zabse_(&argdr, &argdi);
	rs1 = rs1 + log(aphi) - log(aarg) * .25 - aic;
	if(abs(rs1) > *elim) {
	    goto L280;
	}
	if(kdflg == 1) {
	    iflag = 1;
	}
	if(rs1 < 0.) {
	    goto L240;
	}
	if(kdflg == 1) {
	    iflag = 3;
	}
L240:
	zairy_(&argdr, &argdi, &c__0, &c__2, &air, &aii, &nai, &idum);
	zairy_(&argdr, &argdi, &c__1, &c__2, &dair, &daii, &ndai, &idum);
	str = dair * bsumdr - daii * bsumdi;
	sti = dair * bsumdi + daii * bsumdr;
	str += air * asumdr - aii * asumdi;
	sti += air * asumdi + aii * asumdr;
	ptr = str * phidr - sti * phidi;
	pti = str * phidi + sti * phidr;
	s2r = ptr * csr - pti * csi;
	s2i = ptr * csi + pti * csr;
	str = exp(s1r) * cssr[iflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s2r * s1i + s2i * s1r;
	s2r = str;
	if(iflag != 1) {
	    goto L250;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw == 0) {
	    goto L250;
	}
	s2r = zeror;
	s2i = zeroi;
L250:
	if(yy <= 0.) {
	    s2i = -s2i;
	}
	cyr[kdflg - 1] = s2r;
	cyi[kdflg - 1] = s2i;
	c2r = s2r;
	c2i = s2i;
	s2r *= csrr[iflag - 1];
	s2i *= csrr[iflag - 1];
/* ----------------------------------------------------------------------- */
/*     ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N */
/* ----------------------------------------------------------------------- */
	s1r = yr[kk];
	s1i = yi[kk];
	if(*kode == 1) {
	    goto L270;
	}
	zs1s2_(&zrr, &zri, &s1r, &s1i, &s2r, &s2i, &nw, &asc, alim, &iuf);
	*nz += nw;
L270:
	yr[kk] = s1r * cspnr - s1i * cspni + s2r;
	yi[kk] = s1r * cspni + s1i * cspnr + s2i;
	--kk;
	cspnr = -cspnr;
	cspni = -cspni;
	str = csi;
	csi = -csr;
	csr = str;
	if(c2r != 0. || c2i != 0.) {
	    goto L255;
	}
	kdflg = 1;
	goto L290;
L255:
	if(kdflg == 2) {
	    goto L295;
	}
	kdflg = 2;
	goto L290;
L280:
	if(rs1 > 0.) {
	    goto L320;
	}
	s2r = zeror;
	s2i = zeroi;
	goto L250;
L290:
	;
    }
    k = *n;
L295:
    il = *n - k;
    if(il == 0) {
	return 0;
    }
/* ----------------------------------------------------------------------- */
/*     RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE */
/*     K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP */
/*     INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. */
/* ----------------------------------------------------------------------- */
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    csr = csrr[iflag - 1];
    ascle = bry[iflag - 1];
    fn = (double) ((float) (inu + il));
    i__1 = il;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = s1r + (fn + fnf) * (rzr * c2r - rzi * c2i);
	s2i = s1i + (fn + fnf) * (rzr * c2i + rzi * c2r);
	s1r = c2r;
	s1i = c2i;
	fn += -1.;
	c2r = s2r * csr;
	c2i = s2i * csr;
	ckr = c2r;
	cki = c2i;
	c1r = yr[kk];
	c1i = yi[kk];
	if(*kode == 1) {
	    goto L300;
	}
	zs1s2_(&zrr, &zri, &c1r, &c1i, &c2r, &c2i, &nw, &asc, alim, &iuf);
	*nz += nw;
L300:
	yr[kk] = c1r * cspnr - c1i * cspni + c2r;
	yi[kk] = c1r * cspni + c1i * cspnr + c2i;
	--kk;
	cspnr = -cspnr;
	cspni = -cspni;
	if(iflag >= 3) {
	    goto L310;
	}
	c2r = abs(ckr);
	c2i = abs(cki);
	c2m = max(c2r,c2i);
	if(c2m <= ascle) {
	    goto L310;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= csr;
	s1i *= csr;
	s2r = ckr;
	s2i = cki;
	s1r *= cssr[iflag - 1];
	s1i *= cssr[iflag - 1];
	s2r *= cssr[iflag - 1];
	s2i *= cssr[iflag - 1];
	csr = csrr[iflag - 1];
L310:
	;
    }
    return 0;
L320:
    *nz = -1;
    return 0;
} /* zunk2_ */

/* ========================================================== */
/* Subroutine */ int zbuni_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, int *nui, int *nlast, double *fnul, double *tol, 
	double *elim, double *alim)
{
    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, k;
    static double ax, ay;
    static int nl, nw;
    static double c1i, c1m, c1r, s1i, s2i, s1r, s2r, cyi[2], gnu, raz, 
	    cyr[2], sti, bry[3], rzi, str, rzr, dfnu, fnui;
    extern /* Subroutine */ int zuni1_(double *, double *, double 
	    *, int *, int *, double *, double *, int *, 
	    int *, double *, double *, double *, double *)
	    , zuni2_(double *, double *, double *, int *, 
	    int *, double *, double *, int *, int *, 
	    double *, double *, double *, double *);
    static int iflag;
    static double ascle;
    extern double zabse_(double *, double *);
    static double csclr, cscrr;
    static int iform;
    extern double d1mach_(int *);

/* ***BEGIN PROLOGUE  ZBUNI */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE CABS(Z).GT. */
/*     FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM */
/*     FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING */
/*     ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) */
/*     ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 */

/* ***ROUTINES CALLED  ZUNI1,ZUNI2,ZABSE,D1MACH */
/* ***END PROLOGUE  ZBUNI */
/*     COMPLEX CSCL,CSCR,CY,RZ,ST,S1,S2,Y,Z */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */
    *nz = 0;
    ax = abs(*zr) * 1.7321;
    ay = abs(*zi);
    iform = 1;
    if(ay > ax) {
	iform = 2;
    }
    if(*nui == 0) {
	goto L60;
    }
    fnui = (double) ((float) (*nui));
    dfnu = *fnu + (double) ((float) (*n - 1));
    gnu = dfnu + fnui;
    if(iform == 2) {
	goto L10;
    }
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN */
/*     -PI/3.LE.ARG(Z).LE.PI/3 */
/* ----------------------------------------------------------------------- */
    zuni1_(zr, zi, &gnu, kode, &c__2, cyr, cyi, &nw, nlast, fnul, tol, elim, 
	    alim);
    goto L20;
L10:
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU */
/*     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I */
/*     AND HPI=PI/2 */
/* ----------------------------------------------------------------------- */
    zuni2_(zr, zi, &gnu, kode, &c__2, cyr, cyi, &nw, nlast, fnul, tol, elim, 
	    alim);
L20:
    if(nw < 0) {
	goto L50;
    }
    if(nw != 0) {
	goto L90;
    }
    str = zabse_(cyr, cyi);
/* ---------------------------------------------------------------------- */
/*     SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED */
/* ---------------------------------------------------------------------- */
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
    bry[1] = 1. / bry[0];
    bry[2] = bry[1];
    iflag = 2;
    ascle = bry[1];
    csclr = 1.;
    if(str > bry[0]) {
	goto L21;
    }
    iflag = 1;
    ascle = bry[0];
    csclr = 1. / *tol;
    goto L25;
L21:
    if(str < bry[1]) {
	goto L25;
    }
    iflag = 3;
    ascle = bry[2];
    csclr = *tol;
L25:
    cscrr = 1. / csclr;
    s1r = cyr[1] * csclr;
    s1i = cyi[1] * csclr;
    s2r = cyr[0] * csclr;
    s2i = cyi[0] * csclr;
    raz = 1. / zabse_(zr, zi);
    str = *zr * raz;
    sti = -(*zi) * raz;
    rzr = (str + str) * raz;
    rzi = (sti + sti) * raz;
    i__1 = *nui;
    for (i__ = 1; i__ <= i__1; ++i__) {
	str = s2r;
	sti = s2i;
	s2r = (dfnu + fnui) * (rzr * str - rzi * sti) + s1r;
	s2i = (dfnu + fnui) * (rzr * sti + rzi * str) + s1i;
	s1r = str;
	s1i = sti;
	fnui += -1.;
	if(iflag >= 3) {
	    goto L30;
	}
	str = s2r * cscrr;
	sti = s2i * cscrr;
	c1r = abs(str);
	c1i = abs(sti);
	c1m = max(c1r,c1i);
	if(c1m <= ascle) {
	    goto L30;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= cscrr;
	s1i *= cscrr;
	s2r = str;
	s2i = sti;
	csclr *= *tol;
	cscrr = 1. / csclr;
	s1r *= csclr;
	s1i *= csclr;
	s2r *= csclr;
	s2i *= csclr;
L30:
	;
    }
    yr[*n] = s2r * cscrr;
    yi[*n] = s2i * cscrr;
    if(*n == 1) {
	return 0;
    }
    nl = *n - 1;
    fnui = (double) ((float) nl);
    k = nl;
    i__1 = nl;
    for (i__ = 1; i__ <= i__1; ++i__) {
	str = s2r;
	sti = s2i;
	s2r = (*fnu + fnui) * (rzr * str - rzi * sti) + s1r;
	s2i = (*fnu + fnui) * (rzr * sti + rzi * str) + s1i;
	s1r = str;
	s1i = sti;
	str = s2r * cscrr;
	sti = s2i * cscrr;
	yr[k] = str;
	yi[k] = sti;
	fnui += -1.;
	--k;
	if(iflag >= 3) {
	    goto L40;
	}
	c1r = abs(str);
	c1i = abs(sti);
	c1m = max(c1r,c1i);
	if(c1m <= ascle) {
	    goto L40;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= cscrr;
	s1i *= cscrr;
	s2r = str;
	s2i = sti;
	csclr *= *tol;
	cscrr = 1. / csclr;
	s1r *= csclr;
	s1i *= csclr;
	s2r *= csclr;
	s2i *= csclr;
L40:
	;
    }
    return 0;
L50:
    *nz = -1;
    if(nw == -2) {
	*nz = -2;
    }
    return 0;
L60:
    if(iform == 2) {
	goto L70;
    }
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN */
/*     -PI/3.LE.ARG(Z).LE.PI/3 */
/* ----------------------------------------------------------------------- */
/* ========================================================== */
    zuni1_(zr, zi, fnu, kode, n, &yr[1], &yi[1], &nw, nlast, fnul, tol, elim, 
	    alim);
    goto L80;
L70:
/* ----------------------------------------------------------------------- */
/*     ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU */
/*     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I */
/*     AND HPI=PI/2 */
/* ----------------------------------------------------------------------- */
    zuni2_(zr, zi, fnu, kode, n, &yr[1], &yi[1], &nw, nlast, fnul, tol, elim, 
	    alim);
L80:
    if(nw < 0) {
	goto L50;
    }
    *nz = nw;
    return 0;
L90:
    *nlast = *n;
    return 0;
} /* zbuni_ */

/* Subroutine */ int zuni1_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, int *nlast, double *fnul, double *tol, double *
	elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, k, m, nd;
    static double fn;
    static int nn, nw;
    static double c2i, c2m, c1r, c2r, s1i, s2i, rs1, s1r, s2r, cyi[2];
    static int nuf;
    static double bry[3], cyr[2], sti, rzi, str, rzr, aphi, cscl, phii, 
	    crsc, phir;
    static int init;
    static double csrr[3], cssr[3], rast, sumi, sumr;
    static int iflag;
    static double ascle;
    extern double zabse_(double *, double *);
    static double cwrki[16];
    extern /* Subroutine */ int zuchk_(double *, double *, int *, 
	    double *, double *);
    static double cwrkr[16];
    extern double d1mach_(int *);
    extern /* Subroutine */ int zunik_(double *, double *, double 
	    *, int *, int *, double *, int *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *), zuoik_(double *, double *, double *, 
	    int *, int *, int *, double *, double *, 
	    int *, double *, double *, double *);
    static double zeta1i, zeta2i, zeta1r, zeta2r;

/* ***BEGIN PROLOGUE  ZUNI1 */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZUNI1 COMPUTES I(FNU,Z)  BY MEANS OF THE UNIFORM ASYMPTOTIC */
/*     EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3. */

/*     FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC */
/*     EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. */
/*     NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER */
/*     FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. */
/*     Y(I)=CZERO FOR I=NLAST+1,N */

/* ***ROUTINES CALLED  ZUCHK,ZUNIK,ZUOIK,D1MACH,ZABSE */
/* ***END PROLOGUE  ZUNI1 */
/*     COMPLEX CFN,CONE,CRSC,CSCL,CSR,CSS,CWRK,CZERO,C1,C2,PHI,RZ,SUM,S1, */
/*    *S2,Y,Z,ZETA1,ZETA2 */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    *nz = 0;
    nd = *n;
    *nlast = 0;
/* ----------------------------------------------------------------------- */
/*     COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- */
/*     NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, */
/*     EXP(ALIM)=EXP(ELIM)*TOL */
/* ----------------------------------------------------------------------- */
    cscl = 1. / *tol;
    crsc = *tol;
    cssr[0] = cscl;
    cssr[1] = coner;
    cssr[2] = crsc;
    csrr[0] = crsc;
    csrr[1] = coner;
    csrr[2] = cscl;
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
/* ----------------------------------------------------------------------- */
/*     CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER */
/* ----------------------------------------------------------------------- */
    fn = max(*fnu,1.);
    init = 0;
    zunik_(zr, zi, &fn, &c__1, &c__1, tol, &init, &phir, &phii, &zeta1r, &
	    zeta1i, &zeta2r, &zeta2i, &sumr, &sumi, cwrkr, cwrki);
    if(*kode == 1) {
	goto L10;
    }
    str = *zr + zeta2r;
    sti = *zi + zeta2i;
    rast = fn / zabse_(&str, &sti);
    str = str * rast * rast;
    sti = -sti * rast * rast;
    s1r = -zeta1r + str;
    s1i = -zeta1i + sti;
    goto L20;
L10:
    s1r = -zeta1r + zeta2r;
    s1i = -zeta1i + zeta2i;
L20:
    rs1 = s1r;
    if(abs(rs1) > *elim) {
	goto L130;
    }
L30:
    nn = min(2,nd);
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	fn = *fnu + (double) ((float) (nd - i__));
	init = 0;
	zunik_(zr, zi, &fn, &c__1, &c__0, tol, &init, &phir, &phii, &zeta1r, &
		zeta1i, &zeta2r, &zeta2i, &sumr, &sumi, cwrkr, cwrki);
	if(*kode == 1) {
	    goto L40;
	}
	str = *zr + zeta2r;
	sti = *zi + zeta2i;
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = -zeta1r + str;
	s1i = -zeta1i + sti + *zi;
	goto L50;
L40:
	s1r = -zeta1r + zeta2r;
	s1i = -zeta1i + zeta2i;
L50:
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	rs1 = s1r;
	if(abs(rs1) > *elim) {
	    goto L110;
	}
	if(i__ == 1) {
	    iflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L60;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phir, &phii);
	rs1 += log(aphi);
	if(abs(rs1) > *elim) {
	    goto L110;
	}
	if(i__ == 1) {
	    iflag = 1;
	}
	if(rs1 < 0.) {
	    goto L60;
	}
	if(i__ == 1) {
	    iflag = 3;
	}
L60:
/* ----------------------------------------------------------------------- */
/*     SCALE S1 IF CABS(S1).LT.ASCLE */
/* ----------------------------------------------------------------------- */
	s2r = phir * sumr - phii * sumi;
	s2i = phir * sumi + phii * sumr;
	str = exp(s1r) * cssr[iflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s2r * s1i + s2i * s1r;
	s2r = str;
	if(iflag != 1) {
	    goto L70;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw != 0) {
	    goto L110;
	}
L70:
	cyr[i__ - 1] = s2r;
	cyi[i__ - 1] = s2i;
	m = nd - i__ + 1;
	yr[m] = s2r * csrr[iflag - 1];
	yi[m] = s2i * csrr[iflag - 1];
/* L80: */
    }
    if(nd <= 2) {
	goto L100;
    }
    rast = 1. / zabse_(zr, zi);
    str = *zr * rast;
    sti = -(*zi) * rast;
    rzr = (str + str) * rast;
    rzi = (sti + sti) * rast;
    bry[1] = 1. / bry[0];
    bry[2] = d1mach_(&c__2);
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    c1r = csrr[iflag - 1];
    ascle = bry[iflag - 1];
    k = nd - 2;
    fn = (double) ((float) k);
    i__1 = nd;
    for (i__ = 3; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = s1r + (*fnu + fn) * (rzr * c2r - rzi * c2i);
	s2i = s1i + (*fnu + fn) * (rzr * c2i + rzi * c2r);
	s1r = c2r;
	s1i = c2i;
	c2r = s2r * c1r;
	c2i = s2i * c1r;
	yr[k] = c2r;
	yi[k] = c2i;
	--k;
	fn += -1.;
	if(iflag >= 3) {
	    goto L90;
	}
	str = abs(c2r);
	sti = abs(c2i);
	c2m = max(str,sti);
	if(c2m <= ascle) {
	    goto L90;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= c1r;
	s1i *= c1r;
	s2r = c2r;
	s2i = c2i;
	s1r *= cssr[iflag - 1];
	s1i *= cssr[iflag - 1];
	s2r *= cssr[iflag - 1];
	s2i *= cssr[iflag - 1];
	c1r = csrr[iflag - 1];
L90:
	;
    }
L100:
    return 0;
/* ----------------------------------------------------------------------- */
/*     SET UNDERFLOW AND UPDATE PARAMETERS */
/* ----------------------------------------------------------------------- */
L110:
    if(rs1 > 0.) {
	goto L120;
    }
    yr[nd] = zeror;
    yi[nd] = zeroi;
    ++(*nz);
    --nd;
    if(nd == 0) {
	goto L100;
    }
    zuoik_(zr, zi, fnu, kode, &c__1, &nd, &yr[1], &yi[1], &nuf, tol, elim, 
	    alim);
    if(nuf < 0) {
	goto L120;
    }
    nd -= nuf;
    *nz += nuf;
    if(nd == 0) {
	goto L100;
    }
    fn = *fnu + (double) ((float) (nd - 1));
    if(fn >= *fnul) {
	goto L30;
    }
    *nlast = nd;
    return 0;
L120:
    *nz = -1;
    return 0;
L130:
    if(rs1 > 0.) {
	goto L120;
    }
    *nz = *n;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L140: */
    }
    return 0;
} /* zuni1_ */

/* ========================================================== */
/* Subroutine */ int zuni2_(double *zr, double *zi, double *fnu, 
	int *kode, int *n, double *yr, double *yi, int *
	nz, int *nlast, double *fnul, double *tol, double *
	elim, double *alim)
{
    /* Initialized data */

    static double zeror = 0.;
    static double zeroi = 0.;
    static double coner = 1.;
    static double cipr[4] = { 1.,0.,-1.,0. };
    static double cipi[4] = { 0.,1.,0.,-1. };
    static double hpi = 1.57079632679489662;
    static double aic = 1.265512123484645396;

    /* System generated locals */
    int i__1;

    /* Local variables */
    static int i__, j, k, nd;
    static double fn;
    static int in, nn, nw;
    static double c2i, c2m, c1r, c2r, s1i, s2i, rs1, s1r, s2r, aii, ang, 
	    car;
    static int nai;
    static double air, zbi, cyi[2], sar;
    static int nuf, inu;
    static double bry[3], raz, sti, zbr, zni, cyr[2], rzi, str, znr, rzr, 
	    daii, cidi, aarg;
    static int ndai;
    static double dair, aphi, argi, cscl, phii, crsc, argr;
    static int idum;
    static double phir, csrr[3], cssr[3], rast;
    static int iflag;
    static double ascle;
    extern double zabse_(double *, double *);
    static double asumi, bsumi;
    extern /* Subroutine */ int zuchk_(double *, double *, int *, 
	    double *, double *);
    static double asumr, bsumr;
    extern double d1mach_(int *);
    extern /* Subroutine */ int zunhj_(double *, double *, double 
	    *, int *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *, double *, double *, 
	    double *, double *), zairy_(double *, double *, 
	    int *, int *, double *, double *, int *, 
	    int *), zuoik_(double *, double *, double *, 
	    int *, int *, int *, double *, double *, 
	    int *, double *, double *, double *);
    static double zeta1i, zeta2i, zeta1r, zeta2r;

/* ***BEGIN PROLOGUE  ZUNI2 */
/* ***REFER TO  ZBESI,ZBESK */

/*     ZUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF */
/*     UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I */
/*     OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO. */

/*     FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC */
/*     EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. */
/*     NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER */
/*     FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. */
/*     Y(I)=CZERO FOR I=NLAST+1,N */

/* ***ROUTINES CALLED  ZAIRY,ZUCHK,ZUNHJ,ZUOIK,D1MACH,ZABSE */
/* ***END PROLOGUE  ZUNI2 */
/*     COMPLEX AI,ARG,ASUM,BSUM,CFN,CI,CID,CIP,CONE,CRSC,CSCL,CSR,CSS, */
/*    *CZERO,C1,C2,DAI,PHI,RZ,S1,S2,Y,Z,ZB,ZETA1,ZETA2,ZN */
    /* Parameter adjustments */
    --yi;
    --yr;

    /* Function Body */

    *nz = 0;
    nd = *n;
    *nlast = 0;
/* ----------------------------------------------------------------------- */
/*     COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- */
/*     NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, */
/*     EXP(ALIM)=EXP(ELIM)*TOL */
/* ----------------------------------------------------------------------- */
    cscl = 1. / *tol;
    crsc = *tol;
    cssr[0] = cscl;
    cssr[1] = coner;
    cssr[2] = crsc;
    csrr[0] = crsc;
    csrr[1] = coner;
    csrr[2] = cscl;
    bry[0] = d1mach_(&c__1) * 1e3 / *tol;
/* ----------------------------------------------------------------------- */
/*     ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI */
/* ----------------------------------------------------------------------- */
    znr = *zi;
    zni = -(*zr);
    zbr = *zr;
    zbi = *zi;
    cidi = -coner;
    inu = (int) ((float) (*fnu));
    ang = hpi * (*fnu - (double) ((float) inu));
    c2r = cos(ang);
    c2i = sin(ang);
    car = c2r;
    sar = c2i;
    in = inu + *n - 1;
    in = in % 4 + 1;
    str = c2r * cipr[in - 1] - c2i * cipi[in - 1];
    c2i = c2r * cipi[in - 1] + c2i * cipr[in - 1];
    c2r = str;
    if(*zi > 0.) {
	goto L10;
    }
    znr = -znr;
    zbi = -zbi;
    cidi = -cidi;
    c2i = -c2i;
L10:
/* ----------------------------------------------------------------------- */
/*     CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER */
/* ----------------------------------------------------------------------- */
    fn = max(*fnu,1.);
    zunhj_(&znr, &zni, &fn, &c__1, tol, &phir, &phii, &argr, &argi, &zeta1r, &
	    zeta1i, &zeta2r, &zeta2i, &asumr, &asumi, &bsumr, &bsumi);
    if(*kode == 1) {
	goto L20;
    }
    str = zbr + zeta2r;
    sti = zbi + zeta2i;
    rast = fn / zabse_(&str, &sti);
    str = str * rast * rast;
    sti = -sti * rast * rast;
    s1r = -zeta1r + str;
    s1i = -zeta1i + sti;
    goto L30;
L20:
    s1r = -zeta1r + zeta2r;
    s1i = -zeta1i + zeta2i;
L30:
    rs1 = s1r;
    if(abs(rs1) > *elim) {
	goto L150;
    }
L40:
    nn = min(2,nd);
    i__1 = nn;
    for (i__ = 1; i__ <= i__1; ++i__) {
	fn = *fnu + (double) ((float) (nd - i__));
	zunhj_(&znr, &zni, &fn, &c__0, tol, &phir, &phii, &argr, &argi, &
		zeta1r, &zeta1i, &zeta2r, &zeta2i, &asumr, &asumi, &bsumr, &
		bsumi);
	if(*kode == 1) {
	    goto L50;
	}
	str = zbr + zeta2r;
	sti = zbi + zeta2i;
	rast = fn / zabse_(&str, &sti);
	str = str * rast * rast;
	sti = -sti * rast * rast;
	s1r = -zeta1r + str;
	s1i = -zeta1i + sti + abs(*zi);
	goto L60;
L50:
	s1r = -zeta1r + zeta2r;
	s1i = -zeta1i + zeta2i;
L60:
/* ----------------------------------------------------------------------- */
/*     TEST FOR UNDERFLOW AND OVERFLOW */
/* ----------------------------------------------------------------------- */
	rs1 = s1r;
	if(abs(rs1) > *elim) {
	    goto L120;
	}
	if(i__ == 1) {
	    iflag = 2;
	}
	if(abs(rs1) < *alim) {
	    goto L70;
	}
/* ----------------------------------------------------------------------- */
/*     REFINE  TEST AND SCALE */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
	aphi = zabse_(&phir, &phii);
	aarg = zabse_(&argr, &argi);
	rs1 = rs1 + log(aphi) - log(aarg) * .25 - aic;
	if(abs(rs1) > *elim) {
	    goto L120;
	}
	if(i__ == 1) {
	    iflag = 1;
	}
	if(rs1 < 0.) {
	    goto L70;
	}
	if(i__ == 1) {
	    iflag = 3;
	}
L70:
/* ----------------------------------------------------------------------- */
/*     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR */
/*     EXPONENT EXTREMES */
/* ----------------------------------------------------------------------- */
	zairy_(&argr, &argi, &c__0, &c__2, &air, &aii, &nai, &idum);
	zairy_(&argr, &argi, &c__1, &c__2, &dair, &daii, &ndai, &idum);
	str = dair * bsumr - daii * bsumi;
	sti = dair * bsumi + daii * bsumr;
	str += air * asumr - aii * asumi;
	sti += air * asumi + aii * asumr;
	s2r = phir * str - phii * sti;
	s2i = phir * sti + phii * str;
	str = exp(s1r) * cssr[iflag - 1];
	s1r = str * cos(s1i);
	s1i = str * sin(s1i);
	str = s2r * s1r - s2i * s1i;
	s2i = s2r * s1i + s2i * s1r;
	s2r = str;
	if(iflag != 1) {
	    goto L80;
	}
	zuchk_(&s2r, &s2i, &nw, bry, tol);
	if(nw != 0) {
	    goto L120;
	}
L80:
	if(*zi <= 0.) {
	    s2i = -s2i;
	}
	str = s2r * c2r - s2i * c2i;
	s2i = s2r * c2i + s2i * c2r;
	s2r = str;
	cyr[i__ - 1] = s2r;
	cyi[i__ - 1] = s2i;
	j = nd - i__ + 1;
	yr[j] = s2r * csrr[iflag - 1];
	yi[j] = s2i * csrr[iflag - 1];
	str = -c2i * cidi;
	c2i = c2r * cidi;
	c2r = str;
/* L90: */
    }
    if(nd <= 2) {
	goto L110;
    }
    raz = 1. / zabse_(zr, zi);
    str = *zr * raz;
    sti = -(*zi) * raz;
    rzr = (str + str) * raz;
    rzi = (sti + sti) * raz;
    bry[1] = 1. / bry[0];
    bry[2] = d1mach_(&c__2);
    s1r = cyr[0];
    s1i = cyi[0];
    s2r = cyr[1];
    s2i = cyi[1];
    c1r = csrr[iflag - 1];
    ascle = bry[iflag - 1];
    k = nd - 2;
    fn = (double) ((float) k);
    i__1 = nd;
    for (i__ = 3; i__ <= i__1; ++i__) {
	c2r = s2r;
	c2i = s2i;
	s2r = s1r + (*fnu + fn) * (rzr * c2r - rzi * c2i);
	s2i = s1i + (*fnu + fn) * (rzr * c2i + rzi * c2r);
	s1r = c2r;
	s1i = c2i;
	c2r = s2r * c1r;
	c2i = s2i * c1r;
	yr[k] = c2r;
	yi[k] = c2i;
	--k;
	fn += -1.;
	if(iflag >= 3) {
	    goto L100;
	}
	str = abs(c2r);
	sti = abs(c2i);
	c2m = max(str,sti);
	if(c2m <= ascle) {
	    goto L100;
	}
	++iflag;
	ascle = bry[iflag - 1];
	s1r *= c1r;
	s1i *= c1r;
	s2r = c2r;
	s2i = c2i;
	s1r *= cssr[iflag - 1];
	s1i *= cssr[iflag - 1];
	s2r *= cssr[iflag - 1];
	s2i *= cssr[iflag - 1];
	c1r = csrr[iflag - 1];
L100:
	;
    }
L110:
    return 0;
L120:
    if(rs1 > 0.) {
	goto L140;
    }
/* ----------------------------------------------------------------------- */
/*     SET UNDERFLOW AND UPDATE PARAMETERS */
/* ----------------------------------------------------------------------- */
    yr[nd] = zeror;
    yi[nd] = zeroi;
    ++(*nz);
    --nd;
    if(nd == 0) {
	goto L110;
    }
    zuoik_(zr, zi, fnu, kode, &c__1, &nd, &yr[1], &yi[1], &nuf, tol, elim, 
	    alim);
    if(nuf < 0) {
	goto L140;
    }
    nd -= nuf;
    *nz += nuf;
    if(nd == 0) {
	goto L110;
    }
    fn = *fnu + (double) ((float) (nd - 1));
    if(fn < *fnul) {
	goto L130;
    }
/*      FN = CIDI */
/*      J = NUF + 1 */
/*      K = MOD(J,4) + 1 */
/*      S1R = CIPR(K) */
/*      S1I = CIPI(K) */
/*      IF (FN.LT.0.0D0) S1I = -S1I */
/*      STR = C2R*S1R - C2I*S1I */
/*      C2I = C2R*S1I + C2I*S1R */
/*      C2R = STR */
    in = inu + nd - 1;
    in = in % 4 + 1;
    c2r = car * cipr[in - 1] - sar * cipi[in - 1];
    c2i = car * cipi[in - 1] + sar * cipr[in - 1];
    if(*zi <= 0.) {
	c2i = -c2i;
    }
    goto L40;
L130:
    *nlast = nd;
    return 0;
L140:
    *nz = -1;
    return 0;
L150:
    if(rs1 > 0.) {
	goto L140;
    }
    *nz = *n;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	yr[i__] = zeror;
	yi[i__] = zeroi;
/* L160: */
    }
    return 0;
} /* zuni2_ */


#undef abs
#undef dabs
#undef min
#undef max
#undef dmin
#undef dmax

/* ------------------------- %%% ------------------------------------- */


/*
 * Circurs - Circular optical microresonators simulation tools
 * Kirankumar R. Hiremath (k.r.hiremath@ieee.org)
 * University of Twente, Department of Applied Mathematics 
 * P.O. Box 217, 7500AE Enschede, The Netherlands
 * (2005)
 */

/* 
 * bessel.cpp
 * Computation of complex order Bessel and Hankel functions. 
 */
/* 
  KODE = 1 => without scaling
  KODE = 2 => with scaling

  Error codes:
  IERR =  0 => :-) Success
  IERR = 11 => situation beyond scope of routines
  IERR = 12 => division by zero
  IERR =  5 => no computation, algorithm termination condition not met
  IERR =  4 => |z| too large. no computation.
  IERR =  3 => |z| too large. ans may be wrong.
  IERR =  2 => overflow. no computation. Re(\zeta) too large for KODE = 1
  IERR =  1 => inout error
*/

#define nan sqrt(-1.0)   

/* error message */
void bessel_error(const char *s)
{
	fprintf(stderr, "cylfunc.cpp, Circurs: %s.\n", s);
	exit(1);
}
  
double lambda(int s);
double mu(int s);
Complex u(int k, Complex t);
Complex v(int k, Complex t);
Complex a(int k, Complex zeta);
Complex b(int k, Complex zeta);
Complex c(int k, Complex zeta, Complex z);
Complex d(int k, Complex zeta, Complex z);

#define CircBF_zero_arg   (1.0e-10)
#define CircBF_zero_ord   (1.0e-14)
#define CircBF_ord_eq_arg (1.0e-8)

//----------------- arccos() -----------------------------
Complex arccos(Complex z)
{  
	return log(z+CCI*sqrt(1.0-z*z))/CCI; 
}

//Hankel function of the first kind
Complex HankelH1(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{   
	Complex J = BesselJ(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10 )
	{ 
		return Complex(nan, nan);
	}
	Complex Y = BesselY(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10 )
	{ 
		return Complex(nan, nan);
	}
	return J+CCI*Y;
}

// Hankel function of the second kind
Complex HankelH2(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{ 
	int NZ_tmp, IERR_tmp;
	Complex J = BesselJ(order,argument, KODE, &NZ_tmp, &IERR_tmp);
	if((IERR_tmp) > 10 )
	{ 
		return Complex(nan, nan);
	}
	Complex Y = BesselY(order,argument, KODE, &NZ_tmp, &IERR_tmp);
	if((IERR_tmp) > 10 )
	{ 
		return Complex(nan, nan);
	}
	*NZ = NZ_tmp;
	*IERR = IERR_tmp;
	return J-CCI*Y;
}


// derivative of the Hankel function of the first kind
Complex DHankelH1(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{   
	Complex DJ = DBesselJ(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10)
	{ 
		return Complex(nan, nan);
	}
	Complex DY = DBesselY(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10)
	{ 
		return Complex(nan, nan);
	}
	return DJ+CCI*DY;
}

// derivative of the Hankel function of the second kind
Complex DHankelH2(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{ 
	Complex DJ = DBesselJ(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10)
	{ 
		return Complex(nan, nan);
	}
	Complex DY = DBesselY(order,argument, KODE, &(*NZ), &(*IERR));
	if((*IERR) > 10)
	{ 
		return Complex(nan, nan);
	}
	return DJ-CCI*DY;
}

Complex DBesselJ(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
	int nz1, ierr1, nz2, ierr2;
	Complex d = (BesselJ(order-1, argument, KODE, &nz1, &ierr1)
	            -BesselJ(order+1, argument, KODE, &nz2, &ierr2))*0.5;
	*NZ = max(nz1, nz2);
	*IERR = max(ierr1, ierr2);
	return d;
}

Complex DBesselY(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
        int nz1, ierr1, nz2, ierr2;
        Complex d = (BesselY(order-1, argument, KODE, &nz1, &ierr1)
                    -BesselY(order+1, argument, KODE, &nz2, &ierr2))*0.5;
        *NZ = max(nz1, nz2);
        *IERR = max(ierr1, ierr2);
	return d;
}

/*
// derivative of the Bessel function of the first kind
Complex DBesselJ(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
	*NZ=0;
	*IERR=0;
	if(argument.abs() < CircBF_zero_arg)
	{
		return 0;
	}
	else if(order.abs() < CircBF_zero_ord)
	{
		*IERR = 11;
		return Complex(nan, nan);
	}
	else if((order-argument).abs() < CircBF_ord_eq_arg)
	{
		//using same notation of Abramowitz and Stegun
		double a = 0.4473073184;
		double gamma[4] = { 1.0, 0.0073015873, -0.0009373, 0.000444 };
		double b = 0.4108501939;
		double delta[4] = { 0.2, -947.0/346500.0, 0.0006047, -0.00038};

		Complex a1, a2, ans;


		a1  = gamma[0] + gamma[1]/pow(order,2.0) + gamma[2]/pow(order,4.0) 
			+  gamma[3]/pow(order,6.0);
		a2 = delta[0] + delta[1]/pow(order,2.0) + delta[2]/pow(order,4.0) 
			+  delta[3]/pow(order,6.0);
		ans = ((b / pow(order,2.0/3.0))*a1) - ((a/pow(order,4.0/3.0))*a2);

		return ans;
	}
	else
	{
		Complex z, zeta, ans;

		z = argument/order;

		if(z.abs() < 1.0)
		{ 	zeta = pow(1.5*(log((1.0 + sqrt(1.0 - z*z))/z) -
					sqrt(1.0 - z*z)), 2.0/3.0);
		}
		else
		{
			zeta = -1.0 * pow(1.5*(sqrt(z*z -1.0) - arccos(1.0/z)), 2.0/3.0);
		}

		//------------Computation of Ai and DAi------------------------------------

		Complex Airy_argument = pow(order, 2.0/3.0)*zeta;
		Complex AiryAi, DAiryAi, scale_factor;
		double zr, zi, air, aii;
		int Airy_ID;

		zr = Airy_argument.re;
		zi = Airy_argument.im;

		//calling 644 routine to compute Ai(z)
		if(KODE == 1)
		{
			Airy_ID=0; //calculating airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			AiryAi=Complex(air, aii);

			Airy_ID=1; //now calculating derivative of airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			DAiryAi=Complex(air, aii);

		}
		else // KODE == 2
		{
			Complex scale_factor=exp(2.0*(Airy_argument*sqrt(Airy_argument))/3.0);

			Airy_ID=0; //calculating airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			AiryAi=Complex(air, aii);
			AiryAi =  AiryAi/scale_factor;

			Airy_ID=1; //now calculating derivative of airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			DAiryAi=Complex(air, aii);
			DAiryAi = DAiryAi/scale_factor;
		}

		//---------------------------------------------

		Complex a1, a2, a3, a4, a5;

		a1 = -2.0*sqrt(sqrt((1.0 - z*z)/(4.0*zeta)))/z;
		a2 = AiryAi/pow(order, 4.0/3.0);
		a3 = c(0,zeta,z);
		a4 = DAiryAi/(pow(order, 2.0/3.0));
		a5 = d(0,zeta,z) + d(1, zeta,z)/(order*order);

		ans = a1*(a2*a3 + a4*a5);

		return ans  ;

	}
}
*/

/*
// derivative of the Bessel function of the second kind
Complex DBesselY(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
	*NZ=0;
	*IERR=0;
	if(argument.abs() < CircBF_zero_arg)
	{
		*IERR=12;
		return Complex(nan,nan);
	}
	else if(order.abs() < CircBF_zero_ord)
	{
		*IERR = 11;
		return Complex(nan, nan);
	}
	else if((order-argument).abs() < CircBF_ord_eq_arg)
	{
		//using same notation of Abramowitz and Stegun
		double a = 0.4473073184;
		double gamma[4] = { 1.0, 0.0073015873, -0.000937300, 0.000444 };
		double b = 0.4108501939;
		double delta[4] = { 0.2, -947.0/346500.0, 0.0006047, -0.00038};

		Complex a1, a2, ans;

		a1  = gamma[0] + gamma[1]/pow(order,2) + gamma[2]/pow(order,4) +
			gamma[3]/pow(order,6);
		a2 = delta[0] + delta[1]/pow(order,2) + delta[2]/pow(order,4) +
			delta[3]/pow(order,6);
		ans = sqrt(3.0)*((b / pow(order,2.0/3.0))*a1) + ((a/pow(order,4.0/3.0))*a2);

		*IERR = 0;
		return ans;
	}
	else
	{
		Complex z, zeta, ans;
		z = argument/order;

		if(z.abs() < 1.0 )
			zeta = pow(1.5*(log((1.0 + sqrt(1.0 - z*z))/z) - sqrt(1.0 - z*z)), 2.0/3.0);
		else
			zeta = -1.0 * pow(1.5*(sqrt(z*z -1.0) - arccos(1.0/z)), 2.0/3.0);


		//------------Computation of AiryBi and AiryDBi-------------------

		Complex Airy_argument = pow(order, 2.0/3.0)*zeta;
		Complex scale_factor, AiryBi, DAiryBi;
		double zr, zi, air, aii;
		int Airy_ID;

		zr = Airy_argument.re;
		zi = Airy_argument.im;

		//calling 644 routine to compute Ai(z)
		if(KODE == 1)
		{
			Airy_ID=0; //calculating airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			AiryBi=Complex(air, aii);

			Airy_ID=1; //now calculating derivative of airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			DAiryBi=Complex(air, aii);
		}
		else // KODE == 2
		{
			Complex scale_factor=exp(fabs((2.0*(Airy_argument*sqrt(Airy_argument))/3.0).re));

			Airy_ID=0; //calculating airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			AiryBi=Complex(air, aii);
			AiryBi =  AiryBi*scale_factor;

			Airy_ID=1; //now calculating derivative of airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			DAiryBi=Complex(air, aii);
			DAiryBi = DAiryBi*scale_factor;
		}

		//---------------------------------------------

		Complex a1, a2, a3, a4, a5;

		a1 = 2.0*pow((1.0 - z*z)/(4.0*zeta), 0.25)/z;
		a2 = AiryBi/pow(order, 4.0/3.0);
		a3 = c(0,zeta,z);
		a4 = DAiryBi/pow(order, 2.0/3.0);
		a5 = d(0,zeta,z) + d(1, zeta,z)/pow(order,2);

		ans =a1*(a2*a3 + a4*a5);

		return ans  ;
	}
}
*/

// Bessel function of the second kind
Complex BesselY(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
	*NZ=0;
	*IERR=0; *IERR = 0;
	if(argument.abs() < CircBF_zero_arg)
	{
		*IERR=12;
		return Complex(nan,nan);
	}
	else if(order.abs() < CircBF_zero_ord)
	{
		*IERR = 11;
		return Complex(nan, nan);
	}
	else if((order-argument).abs() < CircBF_ord_eq_arg)
	{
		//using same notation of Abramowitz and Stegun
		double a = 0.4473073184f;
		double alpha[4] = { 1.0, -1.0/225.0, 0.000693735, -0.0003538 };
		double b = 0.4108501939f;
		double beta[4] = {1.0/70.0, -1213.0/1023750.0, 0.0004378, -0.00038};

		Complex a1, a2, ans;


		a1  = alpha[0] + alpha[1]/pow(order,2) + alpha[2]/pow(order,4) + 
			alpha[3]/pow(order,6);
		a2 = beta[0] + beta[1]/pow(order,2) + beta[2]/pow(order,4) + 
			beta[3]/pow(order,6);
		ans = -(((sqrt(3.0)*a / pow(order,1.0/3.0))*a1) + ((sqrt(3.0)*b/pow(order,5.0/3.0))*a2));

		*IERR = 0;
		return ans;
	}
	else
	{
		Complex z, zeta, ans;

		z = argument/order;

		if(z.abs() < 1.0)
			zeta = pow(1.5*(log((1.0 + sqrt(1.0 - z*z))/z) - sqrt(1.0 - z*z)), 2.0/3.0);
		else
			zeta = -1.0 * pow(1.5*(sqrt(z*z -1.0) - arccos(1.0/z)), 2.0/3.0);

		//------------Computation of AiryBi and DAiryBi--------------------

		Complex Airy_argument = pow(order, 2.0/3.0)*zeta;
		Complex AiryBi, DAiryBi, scale_factor;
		double zr, zi, air=0.0, aii=0.0;
		int Airy_ID;
		zr=Airy_argument.re;
		zi=Airy_argument.im;

		if(KODE == 1)
		{
			Airy_ID=0; //calculating biry()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			AiryBi=Complex(air, aii);

			Airy_ID=1; //now calculating derivative of airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			DAiryBi=Complex(air, aii);

		}
		else // KODE == 2
		{
			Complex scale_factor=exp(fabs((2.0*(Airy_argument*sqrt(Airy_argument))/3.0).re));

			Airy_ID=0; //calculating airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			AiryBi=Complex(air, aii);
			AiryBi =  AiryBi*scale_factor;

			Airy_ID=1; //now calculating derivative of airy()
			zbiry_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, IERR);
			DAiryBi=Complex(air, aii);
			DAiryBi = DAiryBi*scale_factor;


		}

		Complex a1, a2, a3, a4, a5;
		a1 = sqrt(sqrt(4.0*zeta/(1.0 - z*z)));
		a2 = AiryBi/pow(order, 1.0/3.0);
		a3 = a(0,zeta) +a(1, zeta)/(order*order);
		a4 = DAiryBi/pow(order, 5.0/3.0);
		a5 = b(0,zeta) + b(1, zeta)/(order*order);

		ans =-a1*(a2*a3 + a4*a5);

		return ans  ;
	}
}

// Bessel function of the first kind
Complex BesselJ(Complex order, Complex argument, int KODE, int *NZ, int *IERR)
{
	*NZ=0;
	*IERR=0;
	if(argument.abs() < CircBF_zero_arg)
	{
		return 0;
	}
	else if(order.abs() < CircBF_zero_ord)
	{
		*IERR = 11;
		return Complex(nan, nan);
	}
	else if((order-argument).abs() < CircBF_ord_eq_arg) 
	{
		//using same notation of Abramowitz and Stegun
		double a = 0.4473073184;
		double alpha[4] = { 1.0, -1.0/225.0, 0.000693735, -0.0003538 };
		double b = 0.4108501939;
		double beta[4] = {1.0/70.0, -1213.0/1023750.0, 0.0004378, -0.00038};
		Complex a1, a2, ans;
		a1  = alpha[0] + alpha[1]/pow(order,2) + alpha[2]/pow(order,4) +  
			alpha[3]/pow(order,6);
		a2 = beta[0] + beta[1]/pow(order,2) + beta[2]/pow(order,4) +  
			beta[3]/pow(order,6);
		ans = ((a / pow(order,1.0/3.0))*a1) - ((b/pow(order,5.0/3.0))*a2);
		*IERR = 0;
		return ans;
	}
	else
	{
		Complex z, zeta, ans;
		z = argument/order;
		if(z.abs() < 1.0)
			zeta = pow(1.5*(log((1.0 + sqrt(1.0 - z*z))/z) - sqrt(1.0 - z*z)), 2.0/3.0);
		else
			zeta = -1.0 * pow(1.5*(sqrt(z*z -1.0) - arccos(1.0/z)), 2.0/3.0);

		//------------Computation of AiryAi and DAiryAi--------------------

		Complex Airy_argument = pow(order, 2.0/3.0)*zeta;

		Complex AiryAi, DAiryAi, scale_factor;
		double zr, zi, air=0.0, aii=0.0;
		int Airy_ID;
		zr=Airy_argument.re;
		zi=Airy_argument.im;

		if(KODE == 1)
		{
			Airy_ID=0; //calculating airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			AiryAi=Complex(air, aii);

			Airy_ID=1; //now calculating derivative of airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			DAiryAi=Complex(air, aii);
		}
		else // KODE == 2
		{
			scale_factor=exp(2.0*(Airy_argument*sqrt(Airy_argument))/3.0);

			Airy_ID=0; //calculating airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			AiryAi=Complex(air, aii);
			AiryAi =  AiryAi/scale_factor;

			Airy_ID=1; //now calculating derivative of airy()
			zairy_(&zr, &zi, &Airy_ID, &KODE, &air, &aii, NZ, IERR);
			DAiryAi=Complex(air, aii);
			DAiryAi = DAiryAi/scale_factor;
		}

		Complex a1, a2, a3, a4, a5;
		a1 = sqrt(sqrt(4.0*zeta/(1.0 - z*z)));
		a2 = AiryAi/pow(order, 1.0/3.0);
		a3 = a(0,zeta) + a(1,zeta)/(order*order);
		a4 = DAiryAi/pow(order, 5.0/3.0);
		a5 = b(0,zeta)  + b(1, zeta)/(order*order);
		ans =a1*(a2*a3 + a4*a5);
		return ans  ;

	}
}

// ----------------lambda()------------------------------
double lambda(int s)
{
	int i;
	double out_lambda=1.0, s_fact, s_in_double;
	s_in_double = s + 1.0;
	for (i=0; i<= (2*s -1); i++)
	{
		out_lambda = out_lambda*(2*s + (2*i+1));
	}
	s_fact=dgamma_(&s_in_double);
	out_lambda = out_lambda /(s_fact * pow(144.0,(double) s));
	return out_lambda;
}

// ----------------mu()---------------------------------
double mu(int s)
{ 
	return -1.0*(6.0*s + 1.0)*lambda(s)/(6.0*s -1.0);
}

// ---------------u()-----------------------------------
Complex u(int k, Complex t)
{
	if(k == 0) return 1.0;
	else if(k == 1) return (3.0*t - 5.0*pow(t,3.0))/24.0;
	else if(k == 2) return (81.0*pow(t,2.0) - 462.0*pow(t,4.0) + 385.0*pow(t,6.0))/1152.0;
	else if(k == 3) return (30375.0*pow(t,3) - 369603.0*pow(t,5.0) + 765765.0*pow(t,7.0) - 425425.0*pow(t,9.0))/414720.0;
	else if(k == 4) return (4465125.0*pow(t,4.0) - 94121676.0*pow(t,6.0) + 349922430.0*pow(t,8.0) - 446185740.0*pow(t,10.0) + 185910725.0*pow(t,12.0))/39813120.0;
	else if(k == 5) return -pow(t,5.0)/6688604160.0*(-1519035525.0 + 49286948607.0*pow(t,2.0) - 284499769554.0*pow(t,4.0) + 614135872350.0*pow(t,6.0) - 566098157625.0*pow(t,8.0) + 188699385875.0*pow(t,10.0));
	else if(k == 6) return pow(t,6.0)/4815794995200.0*(2757049477875.0 - 127577298354750.0 * pow(t,2.0) + 1050760774457901.0*pow(t,4.0) - 3369032068261860.0*pow(t,6.0) + 5104696716244125.0*pow(t,8.0) - 3685299006138750.0*pow(t,10.0) + 1023694168371875.0*pow(t,12.0));
	bessel_error("u(): not implemented for k > 6");
	return Complex(nan, nan);
}

// ---------------v()-----------------------------------
Complex v(int k, Complex t)
{
	if(k == 0)  return 1;
	else if(k == 1) return (-9.0*t + 7.0*pow(t,3.0))/24.0;
	else if(k == 2) return (-135.0*pow(t,2.0) + 594.0*pow(t,4.0) - 455.0*pow(t,6.0))/1152.0;
	else if(k == 3) return (-42525.0*pow(t,3.0) + 451737.0*pow(t,5.0) -  883575.0*pow(t,7.0) + 475475.0*pow(t,9.0))/414720.0;
	bessel_error("v(): not implemented for k > 3");
	return Complex(nan, nan);
}

// ---------------a()-----------------------------------
Complex a(int k, Complex zeta)
{
	Complex eta = zeta / pow(2.0, 1.0/3.0);
	if(k == 0)
		return Complex(1.0, 0);
	else if(k ==1 )
		return -1.0/225.0 - 71.0 * eta / 38500.0 + 82.0*eta*eta/73125.0;
	else if(k == 2)
		return 151439.0/218295000.0 + 68401.0 * eta / 147262500.0 - 1796498167.0*eta*eta/4193689500000.0 - 583721053.0*eta*eta*eta/830718281250.0;
	else if(k == 3)
		return - 887278009.0/2504935125000.0 - 3032321618951.0*eta/9708942993750000.0;
	bessel_error("a(): not implemented for k > 3");
	return Complex(nan, nan);
}

// ---------------b()-----------------------------------
Complex b(int k, Complex zeta)
{
	Complex eta = zeta / pow(2.0, 1.0/3.0);
	if(k == 0)
		return pow(2.0, 1.0/3.0)*(1.0/70.0 + 2.0 *eta/225.0 + 138.0*eta*eta/67373.0 - 296.0*eta*eta*eta/511875.0 - 38464.0*eta*eta*eta*eta/63669375.0);
	else if(k ==1 )
		return pow(2.0, 1.0/3.0)*(-1213.0/1023750.0 -3757.0*eta/2695000.0 - 3225661.0*eta*eta/6700443750.0 + 90454643.0*eta*eta*eta/336992906250.0);
	else if(k == 2)
		return pow(2.0, 1.0/3.0)*(16542537833.0/37743205500000.0 + 115773498223.0*eta/162820783125000.0 + 548511920915149.0*eta*eta/1721719224225000000.0);
	else if(k == 3)
		return pow(2.0, 1.0/3.0)*(-430990563936859253.0/568167343994250000000.0 - 3191320338955050557.0*eta/7777535495585625000000.0);
	bessel_error("b(): not implemented for k > 3");
	return Complex(nan, nan);
}

// -------------c()--------------------------------------
Complex c(int k, Complex zeta, Complex z)
{

	int s;
	Complex out_a(0,0);
	for(s=0; s<= 2*k+1; s++)
	{
		out_a = out_a + pow(zeta, -1.5*s) * v(2*k -s +1, pow(1.0-z*z, -0.5))*mu(s);
	}
	return -1.0*sqrt(zeta)*out_a;
}

// -------------d()--------------------------------------
Complex d(int k, Complex zeta, Complex z)
{
	int s;
	Complex out_b(0,0);
	for(s=0; s<= 2*k; s++)
	{   
		double lam = lambda(s);
		out_b = out_b + lam*(pow(zeta, -1.5*s) * v(2*k -s, 1.0/sqrt(1.0-z*z)));
	}
	return out_b;
}