static Py_complex
c_asinh(Py_complex x)
{
Py_complex z;
z = c_sqrt(c_half);
z = c_log(c_prod(z, c_sum(c_sqrt(c_sum(x, c_i)),
c_sqrt(c_diff(x, c_i)))));
return c_sum(z, z);
}
static Py_complex
c_asin(Py_complex x)
{
/* -i * log[(sqrt(1-x**2) + i*x] */
const Py_complex squared = c_prod(x, x);
const Py_complex sqrt_1_minus_x_sq = c_sqrt(c_diff(c_one, squared));
return c_neg(c_prodi(c_log(
c_sum(sqrt_1_minus_x_sq, c_prodi(x))
) ) );
}
static PyObject *
cmath_log(PyObject *self, PyObject *args)
{
Py_complex x;
Py_complex y;
if (!PyArg_ParseTuple(args, "D|D", &x, &y))
return NULL;
errno = 0;
PyFPE_START_PROTECT("complex function", return 0)
x = c_log(x);
if (PyTuple_GET_SIZE(args) == 2)
x = c_quot(x, c_log(y));
PyFPE_END_PROTECT(x)
if (errno != 0)
return math_error();
Py_ADJUST_ERANGE2(x.real, x.imag);
return PyComplex_FromCComplex(x);
}
/* doRPCCmd
Based on the request type (set by one of the init function)
send an RPC to the server
parameter: request pointer to request data structure that was already
initialized
return: int 1 or -1 for success or failure respectively
*/
int doRPCCmd(Request* request)
{
int rc=-1;
long double clk = tick();
// Unpack the request
Client *C;
Proto_Msg_Hdr hdr;
bzero(&hdr,sizeof(Proto_Msg_Hdr));
C = request->client;
switch (request->type) {
case PROTO_MT_REQ_HELLO:
if(proto_debug()) fprintf(stderr,"HELLO COMMAND ISSUED");
hdr.type = request->type;
rc = do_no_body_rpc(C->ph,&hdr);
if (proto_debug()) fprintf(stderr,"hello: rc=%x\n", rc);
if (rc < 0) fprintf(stderr, "Unable to connect");
break;
case PROTO_MT_REQ_ACTION:
if(proto_debug()) fprintf(stderr,"Action COMMAND ISSUED");
hdr.type = request->type;
hdr.gstate.v1.raw = request->action_type;
hdr.pstate.v1.raw = request->team;
hdr.pstate.v0.raw = C->my_player->id;
rc = do_action_request_rpc(C->ph,&hdr,request->current,request->next);
break;
case PROTO_MT_REQ_SYNC:
if (proto_debug() ) fprintf(stderr,"Sync COMMAND ISSUED");
hdr.type = request->type;
rc = do_no_body_rpc(C->ph,&hdr);
break;
case PROTO_MT_REQ_GOODBYE:
if (proto_debug() ) fprintf(stderr,"Goodbye COMMAND ISSUED");
hdr.type = request->type;
rc = do_no_body_rpc(C->ph,&hdr);
/*rc = proto_client_goodbye(C->ph);*/
/*printf("Game Over - You Quit");*/
break;
default:
fprintf(stderr,"%s: unknown command %d\n", __func__, request->type);
}
c_log(request->type,request->action_type,rc,clk);
// NULL MT OVERRIDE ;-)
if(proto_debug()) fprintf(stderr,"%s: rc=0x%x\n", __func__, rc);
if (rc == 0xdeadbeef) rc=1;
if (proto_debug()) printf("rc=1\n");
return rc;
}
int main() /* テスト (ごく一部) */
{
double x, y;
complex z;
printf("x, y ? "); scanf("%lf%lf", &x, &y);
z = c_conv(x, y);
printf("z = %s\n", c_string(z));
z = c_exp(z);
printf("exp(z) = %s\n", c_string(z));
z = c_log(z);
printf("log(exp(z)) = %s\n", c_string(z));
return EXIT_SUCCESS;
}
/**
* \brief Derivative of variance with respect to q
* \param poles0 unscaled pole locations
* \param q rescaling parameter
* \param K number of poles
* \return derivative of variance with respect to q
* \ingroup vyv_gaussian
*
* This function is used by compute_q() in solving for q.
*/
static double dq_variance(const complex4c *poles0, int K, double q)
{
complex4c sum = { 0, 0 };
int k;
for (k = 0; k < K; ++k)
{
complex4c z = c_real_pow(poles0[k], 1 / q), w = z, denom = z;
w.real += 1;
denom.real -= 1;
/* Compute sum += z log(z) (z + 1) / (z - 1)^3 */
sum = c_add(sum, c_div(c_mul(c_mul(z, c_log(z)), w),
c_real_pow(denom, 3)));
}
return (2 / q) * sum.real;
}
/* Function: main
* --------------
* Initiatialize clocks and USART. Setup output options.
* Loop infinitely doing output using a convenience log function and a debug macro.
*
* Returns: 0, never.
*/
int main(void)
{
clock_init();
usart_init();
logfd = stdout;
verbose = 1;
printf("\r\n\r\n-------------\r\nStarting up..\r\n-------------\r\n");
while (2 > 1) {
c_log('I', "USART is alive!");
msleep(DELAY);
DBG();
msleep(DELAY);
}
/* if you're happy and you know it, */
return 0;
}
static Py_complex
c_atanh(Py_complex x)
{
return c_prod(c_half,c_log(c_quot(c_sum(c_one,x),c_diff(c_one,x))));
}
static Py_complex
c_acos(Py_complex x)
{
return c_neg(c_prodi(c_log(c_sum(x,c_prod(c_i,
c_sqrt(c_diff(c_one,c_prod(x,x))))))));
}
/* Function Definitions */
void mfcc_bare(const real_T samples_in_window[128], const real_T hamming_coeff
[128], const real_T mel_filterbank[2016], real_T fftA, real_T
fftB, const creal_T dct_coeff[32], creal_T mel[13])
{
real_T b_samples_in_window[128];
int32_T i3;
creal_T samples_in_freq[128];
int32_T i4;
int32_T i5;
int32_T i6;
int32_T ar;
int32_T ib;
creal_T samples_in_freq_data[65];
int32_T tmp_data[65];
int32_T ia;
int32_T loop_ub;
int32_T samples_in_freq_size[2];
int32_T tmp_size[2];
real_T b_tmp_data[65];
real_T b_data[65];
real_T melfilter_resps[32];
real_T b_melfilter_resps[32];
creal_T dcv0[32];
int32_T c_tmp_data[65];
int32_T b_samples_in_freq_size[2];
creal_T dc0;
/* initialization */
/* 8kHz sampling frequency. */
/* 128 (size of windows). */
/* 64 step size for subsequent windows. */
/* 26 (# of mel frequency pass band filters). */
/* overrride this to power of 2. */
/* # 12 (# of cepstral coefficients (output features)) */
/* compute features for one input window */
for (i3 = 0; i3 < 128; i3++) {
b_samples_in_window[i3] = samples_in_window[i3] * hamming_coeff[i3];
}
fft(b_samples_in_window, samples_in_freq);
if (fftA > fftB) {
i3 = 1;
i4 = 0;
} else {
i3 = (int32_T)fftA;
i4 = (int32_T)fftB;
}
if (fftA > fftB) {
i5 = 1;
i6 = 0;
} else {
i5 = (int32_T)fftA;
i6 = (int32_T)fftB;
}
if (fftA > fftB) {
ar = 1;
ib = 0;
} else {
ar = (int32_T)fftA;
ib = (int32_T)fftB;
}
ia = (ib - ar) + 1;
loop_ub = ib - ar;
for (ib = 0; ib <= loop_ub; ib++) {
tmp_data[ib] = ar + ib;
}
samples_in_freq_size[0] = 1;
samples_in_freq_size[1] = ia;
loop_ub = ia - 1;
for (ar = 0; ar <= loop_ub; ar++) {
samples_in_freq_data[ar] = samples_in_freq[tmp_data[ar] - 1];
}
d_abs(samples_in_freq_data, samples_in_freq_size, b_tmp_data, tmp_size);
loop_ub = tmp_size[1] - 1;
for (ar = 0; ar <= loop_ub; ar++) {
b_data[ar] = b_tmp_data[ar];
}
if (tmp_size[1] == 1) {
for (ar = 0; ar < 32; ar++) {
melfilter_resps[ar] = 0.0;
for (ib = 0; ib < 63; ib++) {
melfilter_resps[ar] += mel_filterbank[ar + (ib << 5)] * b_data[ib];
}
}
} else {
memset(&melfilter_resps[0], 0, sizeof(real_T) << 5);
if (63 == tmp_size[1]) {
for (ar = 0; ar < 32; ar++) {
melfilter_resps[ar] = 0.0;
for (ib = 0; ib < 63; ib++) {
melfilter_resps[ar] += mel_filterbank[ar + (ib << 5)] * b_data[ib];
}
}
} else {
memset(&melfilter_resps[0], 0, sizeof(real_T) << 5);
ar = -1;
for (ib = 0; ib < 63; ib++) {
if (b_data[ib] != 0.0) {
ia = ar;
for (loop_ub = 0; loop_ub < 32; loop_ub++) {
ia++;
melfilter_resps[loop_ub] += b_data[ib] * mel_filterbank[ia];
}
}
ar += 32;
}
}
}
b_log(melfilter_resps);
/* Compute DCT */
for (ar = 0; ar < 16; ar++) {
b_melfilter_resps[ar] = melfilter_resps[ar << 1];
}
for (ar = 0; ar < 16; ar++) {
b_melfilter_resps[ar + 16] = melfilter_resps[31 + -2 * ar];
}
b_fft(b_melfilter_resps, dcv0);
for (ar = 0; ar < 32; ar++) {
melfilter_resps[ar] = dcv0[ar].re * dct_coeff[ar].re - dcv0[ar].im *
dct_coeff[ar].im;
}
ia = (i4 - i3) + 1;
loop_ub = i4 - i3;
for (i4 = 0; i4 <= loop_ub; i4++) {
tmp_data[i4] = i3 + i4;
}
loop_ub = i6 - i5;
for (i3 = 0; i3 <= loop_ub; i3++) {
c_tmp_data[i3] = i5 + i3;
}
b_samples_in_freq_size[0] = 1;
b_samples_in_freq_size[1] = ia;
loop_ub = ia - 1;
for (i3 = 0; i3 <= loop_ub; i3++) {
samples_in_freq_data[i3].re = samples_in_freq[tmp_data[i3] - 1].re *
samples_in_freq[c_tmp_data[i3] - 1].re - samples_in_freq[tmp_data[i3] - 1]
.im * -samples_in_freq[c_tmp_data[i3] - 1].im;
samples_in_freq_data[i3].im = samples_in_freq[tmp_data[i3] - 1].re *
-samples_in_freq[c_tmp_data[i3] - 1].im + samples_in_freq[tmp_data[i3] - 1]
.im * samples_in_freq[c_tmp_data[i3] - 1].re;
}
dc0 = sum(samples_in_freq_data, b_samples_in_freq_size);
c_log(&dc0);
for (i3 = 0; i3 < 32; i3++) {
b_melfilter_resps[i3] = melfilter_resps[i3] / 8.0;
}
mel[0] = dc0;
for (i3 = 0; i3 < 12; i3++) {
mel[i3 + 1].re = b_melfilter_resps[i3 + 1];
mel[i3 + 1].im = 0.0;
}
}
/* DECK CUNHJ */
/* Subroutine */ int cunhj_(complex *z__, real *fnu, integer *ipmtr, real *
tol, complex *phi, complex *arg, complex *zeta1, complex *zeta2,
complex *asum, complex *bsum)
{
/* Initialized data */
static real ar[14] = { 1.f,.104166666666666667f,.0835503472222222222f,
.12822657455632716f,.291849026464140464f,.881627267443757652f,
3.32140828186276754f,14.9957629868625547f,78.9230130115865181f,
474.451538868264323f,3207.49009089066193f,24086.5496408740049f,
198923.119169509794f,1791902.00777534383f };
static real pi = 3.14159265358979324f;
static real thpi = 4.71238898038468986f;
static complex czero = {0.f,0.f};
static complex cone = {1.f,0.f};
static real br[14] = { 1.f,-.145833333333333333f,-.0987413194444444444f,
-.143312053915895062f,-.317227202678413548f,-.942429147957120249f,
-3.51120304082635426f,-15.7272636203680451f,-82.2814390971859444f,
-492.355370523670524f,-3316.21856854797251f,-24827.6742452085896f,
-204526.587315129788f,-1838444.9170682099f };
static real c__[105] = { 1.f,-.208333333333333333f,.125f,
.334201388888888889f,-.401041666666666667f,.0703125f,
-1.02581259645061728f,1.84646267361111111f,-.8912109375f,
.0732421875f,4.66958442342624743f,-11.2070026162229938f,
8.78912353515625f,-2.3640869140625f,.112152099609375f,
-28.2120725582002449f,84.6362176746007346f,-91.8182415432400174f,
42.5349987453884549f,-7.3687943594796317f,.227108001708984375f,
212.570130039217123f,-765.252468141181642f,1059.99045252799988f,
-699.579627376132541f,218.19051174421159f,-26.4914304869515555f,
.572501420974731445f,-1919.457662318407f,8061.72218173730938f,
-13586.5500064341374f,11655.3933368645332f,-5305.64697861340311f,
1200.90291321635246f,-108.090919788394656f,1.7277275025844574f,
20204.2913309661486f,-96980.5983886375135f,192547.001232531532f,
-203400.177280415534f,122200.46498301746f,-41192.6549688975513f,
7109.51430248936372f,-493.915304773088012f,6.07404200127348304f,
-242919.187900551333f,1311763.6146629772f,-2998015.91853810675f,
3763271.297656404f,-2813563.22658653411f,1268365.27332162478f,
-331645.172484563578f,45218.7689813627263f,-2499.83048181120962f,
24.3805296995560639f,3284469.85307203782f,-19706819.1184322269f,
50952602.4926646422f,-74105148.2115326577f,66344512.2747290267f,
-37567176.6607633513f,13288767.1664218183f,-2785618.12808645469f,
308186.404612662398f,-13886.0897537170405f,110.017140269246738f,
-49329253.664509962f,325573074.185765749f,-939462359.681578403f,
1553596899.57058006f,-1621080552.10833708f,1106842816.82301447f,
-495889784.275030309f,142062907.797533095f,-24474062.7257387285f,
2243768.17792244943f,-84005.4336030240853f,551.335896122020586f,
814789096.118312115f,-5866481492.05184723f,18688207509.2958249f,
-34632043388.1587779f,41280185579.753974f,-33026599749.8007231f,
17954213731.1556001f,-6563293792.61928433f,1559279864.87925751f,
-225105661.889415278f,17395107.5539781645f,-549842.327572288687f,
3038.09051092238427f,-14679261247.6956167f,114498237732.02581f,
-399096175224.466498f,819218669548.577329f,-1098375156081.22331f,
1008158106865.38209f,-645364869245.376503f,287900649906.150589f,
-87867072178.0232657f,17634730606.8349694f,-2167164983.22379509f,
143157876.718888981f,-3871833.44257261262f,18257.7554742931747f };
static real alfa[180] = { -.00444444444444444444f,
-9.22077922077922078e-4f,-8.84892884892884893e-5f,
1.65927687832449737e-4f,2.4669137274179291e-4f,
2.6599558934625478e-4f,2.61824297061500945e-4f,
2.48730437344655609e-4f,2.32721040083232098e-4f,
2.16362485712365082e-4f,2.00738858762752355e-4f,
1.86267636637545172e-4f,1.73060775917876493e-4f,
1.61091705929015752e-4f,1.50274774160908134e-4f,
1.40503497391269794e-4f,1.31668816545922806e-4f,
1.23667445598253261e-4f,1.16405271474737902e-4f,
1.09798298372713369e-4f,1.03772410422992823e-4f,
9.82626078369363448e-5f,9.32120517249503256e-5f,
8.85710852478711718e-5f,8.42963105715700223e-5f,
8.03497548407791151e-5f,7.66981345359207388e-5f,
7.33122157481777809e-5f,7.01662625163141333e-5f,
6.72375633790160292e-5f,6.93735541354588974e-4f,
2.32241745182921654e-4f,-1.41986273556691197e-5f,
-1.1644493167204864e-4f,-1.50803558053048762e-4f,
-1.55121924918096223e-4f,-1.46809756646465549e-4f,
-1.33815503867491367e-4f,-1.19744975684254051e-4f,
-1.0618431920797402e-4f,-9.37699549891194492e-5f,
-8.26923045588193274e-5f,-7.29374348155221211e-5f,
-6.44042357721016283e-5f,-5.69611566009369048e-5f,
-5.04731044303561628e-5f,-4.48134868008882786e-5f,
-3.98688727717598864e-5f,-3.55400532972042498e-5f,
-3.1741425660902248e-5f,-2.83996793904174811e-5f,
-2.54522720634870566e-5f,-2.28459297164724555e-5f,
-2.05352753106480604e-5f,-1.84816217627666085e-5f,
-1.66519330021393806e-5f,-1.50179412980119482e-5f,
-1.35554031379040526e-5f,-1.22434746473858131e-5f,
-1.10641884811308169e-5f,-3.54211971457743841e-4f,
-1.56161263945159416e-4f,3.0446550359493641e-5f,
1.30198655773242693e-4f,1.67471106699712269e-4f,
1.70222587683592569e-4f,1.56501427608594704e-4f,
1.3633917097744512e-4f,1.14886692029825128e-4f,
9.45869093034688111e-5f,7.64498419250898258e-5f,
6.07570334965197354e-5f,4.74394299290508799e-5f,
3.62757512005344297e-5f,2.69939714979224901e-5f,
1.93210938247939253e-5f,1.30056674793963203e-5f,
7.82620866744496661e-6f,3.59257485819351583e-6f,
1.44040049814251817e-7f,-2.65396769697939116e-6f,
-4.9134686709848591e-6f,-6.72739296091248287e-6f,
-8.17269379678657923e-6f,-9.31304715093561232e-6f,
-1.02011418798016441e-5f,-1.0880596251059288e-5f,
-1.13875481509603555e-5f,-1.17519675674556414e-5f,
-1.19987364870944141e-5f,3.78194199201772914e-4f,
2.02471952761816167e-4f,-6.37938506318862408e-5f,
-2.38598230603005903e-4f,-3.10916256027361568e-4f,
-3.13680115247576316e-4f,-2.78950273791323387e-4f,
-2.28564082619141374e-4f,-1.75245280340846749e-4f,
-1.25544063060690348e-4f,-8.22982872820208365e-5f,
-4.62860730588116458e-5f,-1.72334302366962267e-5f,
5.60690482304602267e-6f,2.313954431482868e-5f,
3.62642745856793957e-5f,4.58006124490188752e-5f,
5.2459529495911405e-5f,5.68396208545815266e-5f,
5.94349820393104052e-5f,6.06478527578421742e-5f,
6.08023907788436497e-5f,6.01577894539460388e-5f,
5.891996573446985e-5f,5.72515823777593053e-5f,
5.52804375585852577e-5f,5.3106377380288017e-5f,
5.08069302012325706e-5f,4.84418647620094842e-5f,
4.6056858160747537e-5f,-6.91141397288294174e-4f,
-4.29976633058871912e-4f,1.83067735980039018e-4f,
6.60088147542014144e-4f,8.75964969951185931e-4f,
8.77335235958235514e-4f,7.49369585378990637e-4f,
5.63832329756980918e-4f,3.68059319971443156e-4f,
1.88464535514455599e-4f,3.70663057664904149e-5f,
-8.28520220232137023e-5f,-1.72751952869172998e-4f,
-2.36314873605872983e-4f,-2.77966150694906658e-4f,
-3.02079514155456919e-4f,-3.12594712643820127e-4f,
-3.12872558758067163e-4f,-3.05678038466324377e-4f,
-2.93226470614557331e-4f,-2.77255655582934777e-4f,
-2.59103928467031709e-4f,-2.39784014396480342e-4f,
-2.20048260045422848e-4f,-2.00443911094971498e-4f,
-1.81358692210970687e-4f,-1.63057674478657464e-4f,
-1.45712672175205844e-4f,-1.29425421983924587e-4f,
-1.14245691942445952e-4f,.00192821964248775885f,
.00135592576302022234f,-7.17858090421302995e-4f,
-.00258084802575270346f,-.00349271130826168475f,
-.00346986299340960628f,-.00282285233351310182f,
-.00188103076404891354f,-8.895317183839476e-4f,
3.87912102631035228e-6f,7.28688540119691412e-4f,
.00126566373053457758f,.00162518158372674427f,
.00183203153216373172f,.00191588388990527909f,
.00190588846755546138f,.00182798982421825727f,
.0017038950642112153f,.00155097127171097686f,
.00138261421852276159f,.00120881424230064774f,
.00103676532638344962f,8.71437918068619115e-4f,
7.16080155297701002e-4f,5.72637002558129372e-4f,
4.42089819465802277e-4f,3.24724948503090564e-4f,
2.20342042730246599e-4f,1.28412898401353882e-4f,
4.82005924552095464e-5f };
static real beta[210] = { .0179988721413553309f,.00559964911064388073f,
.00288501402231132779f,.00180096606761053941f,
.00124753110589199202f,9.22878876572938311e-4f,
7.14430421727287357e-4f,5.71787281789704872e-4f,
4.69431007606481533e-4f,3.93232835462916638e-4f,
3.34818889318297664e-4f,2.88952148495751517e-4f,
2.52211615549573284e-4f,2.22280580798883327e-4f,
1.97541838033062524e-4f,1.76836855019718004e-4f,
1.59316899661821081e-4f,1.44347930197333986e-4f,
1.31448068119965379e-4f,1.20245444949302884e-4f,
1.10449144504599392e-4f,1.01828770740567258e-4f,
9.41998224204237509e-5f,8.74130545753834437e-5f,
8.13466262162801467e-5f,7.59002269646219339e-5f,
7.09906300634153481e-5f,6.65482874842468183e-5f,
6.25146958969275078e-5f,5.88403394426251749e-5f,
-.00149282953213429172f,-8.78204709546389328e-4f,
-5.02916549572034614e-4f,-2.94822138512746025e-4f,
-1.75463996970782828e-4f,-1.04008550460816434e-4f,
-5.96141953046457895e-5f,-3.1203892907609834e-5f,
-1.26089735980230047e-5f,-2.42892608575730389e-7f,
8.05996165414273571e-6f,1.36507009262147391e-5f,
1.73964125472926261e-5f,1.9867297884213378e-5f,
2.14463263790822639e-5f,2.23954659232456514e-5f,
2.28967783814712629e-5f,2.30785389811177817e-5f,
2.30321976080909144e-5f,2.28236073720348722e-5f,
2.25005881105292418e-5f,2.20981015361991429e-5f,
2.16418427448103905e-5f,2.11507649256220843e-5f,
2.06388749782170737e-5f,2.01165241997081666e-5f,
1.95913450141179244e-5f,1.9068936791043674e-5f,
1.85533719641636667e-5f,1.80475722259674218e-5f,
5.5221307672129279e-4f,4.47932581552384646e-4f,
2.79520653992020589e-4f,1.52468156198446602e-4f,
6.93271105657043598e-5f,1.76258683069991397e-5f,
-1.35744996343269136e-5f,-3.17972413350427135e-5f,
-4.18861861696693365e-5f,-4.69004889379141029e-5f,
-4.87665447413787352e-5f,-4.87010031186735069e-5f,
-4.74755620890086638e-5f,-4.55813058138628452e-5f,
-4.33309644511266036e-5f,-4.09230193157750364e-5f,
-3.84822638603221274e-5f,-3.60857167535410501e-5f,
-3.37793306123367417e-5f,-3.15888560772109621e-5f,
-2.95269561750807315e-5f,-2.75978914828335759e-5f,
-2.58006174666883713e-5f,-2.413083567612802e-5f,
-2.25823509518346033e-5f,-2.11479656768912971e-5f,
-1.98200638885294927e-5f,-1.85909870801065077e-5f,
-1.74532699844210224e-5f,-1.63997823854497997e-5f,
-4.74617796559959808e-4f,-4.77864567147321487e-4f,
-3.20390228067037603e-4f,-1.61105016119962282e-4f,
-4.25778101285435204e-5f,3.44571294294967503e-5f,
7.97092684075674924e-5f,1.031382367082722e-4f,
1.12466775262204158e-4f,1.13103642108481389e-4f,
1.08651634848774268e-4f,1.01437951597661973e-4f,
9.29298396593363896e-5f,8.40293133016089978e-5f,
7.52727991349134062e-5f,6.69632521975730872e-5f,
5.92564547323194704e-5f,5.22169308826975567e-5f,
4.58539485165360646e-5f,4.01445513891486808e-5f,
3.50481730031328081e-5f,3.05157995034346659e-5f,
2.64956119950516039e-5f,2.29363633690998152e-5f,
1.97893056664021636e-5f,1.70091984636412623e-5f,
1.45547428261524004e-5f,1.23886640995878413e-5f,
1.04775876076583236e-5f,8.79179954978479373e-6f,
7.36465810572578444e-4f,8.72790805146193976e-4f,
6.22614862573135066e-4f,2.85998154194304147e-4f,
3.84737672879366102e-6f,-1.87906003636971558e-4f,
-2.97603646594554535e-4f,-3.45998126832656348e-4f,
-3.53382470916037712e-4f,-3.35715635775048757e-4f,
-3.04321124789039809e-4f,-2.66722723047612821e-4f,
-2.27654214122819527e-4f,-1.89922611854562356e-4f,
-1.5505891859909387e-4f,-1.2377824076187363e-4f,
-9.62926147717644187e-5f,-7.25178327714425337e-5f,
-5.22070028895633801e-5f,-3.50347750511900522e-5f,
-2.06489761035551757e-5f,-8.70106096849767054e-6f,
1.1369868667510029e-6f,9.16426474122778849e-6f,
1.5647778542887262e-5f,2.08223629482466847e-5f,
2.48923381004595156e-5f,2.80340509574146325e-5f,
3.03987774629861915e-5f,3.21156731406700616e-5f,
-.00180182191963885708f,-.00243402962938042533f,
-.00183422663549856802f,-7.62204596354009765e-4f,
2.39079475256927218e-4f,9.49266117176881141e-4f,
.00134467449701540359f,.00148457495259449178f,
.00144732339830617591f,.00130268261285657186f,
.00110351597375642682f,8.86047440419791759e-4f,
6.73073208165665473e-4f,4.77603872856582378e-4f,
3.05991926358789362e-4f,1.6031569459472163e-4f,
4.00749555270613286e-5f,-5.66607461635251611e-5f,
-1.32506186772982638e-4f,-1.90296187989614057e-4f,
-2.32811450376937408e-4f,-2.62628811464668841e-4f,
-2.82050469867598672e-4f,-2.93081563192861167e-4f,
-2.97435962176316616e-4f,-2.96557334239348078e-4f,
-2.91647363312090861e-4f,-2.83696203837734166e-4f,
-2.73512317095673346e-4f,-2.6175015580676858e-4f,
.00638585891212050914f,.00962374215806377941f,
.00761878061207001043f,.00283219055545628054f,
-.0020984135201272009f,-.00573826764216626498f,
-.0077080424449541462f,-.00821011692264844401f,
-.00765824520346905413f,-.00647209729391045177f,
-.00499132412004966473f,-.0034561228971313328f,
-.00201785580014170775f,-7.59430686781961401e-4f,
2.84173631523859138e-4f,.00110891667586337403f,
.00172901493872728771f,.00216812590802684701f,
.00245357710494539735f,.00261281821058334862f,
.00267141039656276912f,.0026520307339598043f,
.00257411652877287315f,.00245389126236094427f,
.00230460058071795494f,.00213684837686712662f,
.00195896528478870911f,.00177737008679454412f,
.00159690280765839059f,.00142111975664438546f };
static real gama[30] = { .629960524947436582f,.251984209978974633f,
.154790300415655846f,.110713062416159013f,.0857309395527394825f,
.0697161316958684292f,.0586085671893713576f,.0504698873536310685f,
.0442600580689154809f,.0393720661543509966f,.0354283195924455368f,
.0321818857502098231f,.0294646240791157679f,.0271581677112934479f,
.0251768272973861779f,.0234570755306078891f,.0219508390134907203f,
.020621082823564624f,.0194388240897880846f,.0183810633800683158f,
.0174293213231963172f,.0165685837786612353f,.0157865285987918445f,
.0150729501494095594f,.0144193250839954639f,.0138184805735341786f,
.0132643378994276568f,.0127517121970498651f,.0122761545318762767f,
.0118338262398482403f };
static real ex1 = .333333333333333333f;
static real ex2 = .666666666666666667f;
static real hpi = 1.57079632679489662f;
/* System generated locals */
integer i__1, i__2, i__3;
real r__1;
doublereal d__1, d__2;
complex q__1, q__2, q__3, q__4, q__5;
/* Local variables */
static integer j, k, l, m;
static complex p[30], w;
static integer l1, l2;
static complex t2, w2;
static real ac, ap[30];
static complex cr[14], dr[14], za, zb, zc;
static integer is, jr;
static real pp, wi;
static integer ju, ks, lr;
static complex up[14];
static real wr, aw2;
static integer kp1;
static real ang, fn13, fn23;
static integer ias, ibs;
static real zci;
static complex tfn;
static real zcr;
static complex zth;
static integer lrp1;
static complex rfn13, cfnu;
static real atol, btol;
static integer kmax;
static complex zeta, ptfn, suma, sumb;
static real azth, rfnu, zthi, test, tsti;
static complex rzth;
static real zthr, tstr, rfnu2, zetai, asumi, bsumi, zetar, asumr, bsumr;
static complex rtzta, przth;
extern doublereal r1mach_(integer *);
/* ***BEGIN PROLOGUE CUNHJ */
/* ***SUBSIDIARY */
/* ***PURPOSE Subsidiary to CBESI and CBESK */
/* ***LIBRARY SLATEC */
/* ***TYPE ALL (CUNHJ-A, ZUNHJ-A) */
/* ***AUTHOR Amos, D. E., (SNL) */
/* ***DESCRIPTION */
/* 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 */
/* CUNHJ 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. */
/* ***SEE ALSO CBESI, CBESK */
/* ***ROUTINES CALLED R1MACH */
/* ***REVISION HISTORY (YYMMDD) */
/* 830501 DATE WRITTEN */
/* 910415 Prologue converted to Version 4.0 format. (BAB) */
/* ***END PROLOGUE CUNHJ */
/* ***FIRST EXECUTABLE STATEMENT CUNHJ */
rfnu = 1.f / *fnu;
/* ZB = Z*CMPLX(RFNU,0.0E0) */
/* ----------------------------------------------------------------------- */
/* OVERFLOW TEST (Z/FNU TOO SMALL) */
/* ----------------------------------------------------------------------- */
tstr = z__->r;
tsti = r_imag(z__);
test = r1mach_(&c__1) * 1e3f;
ac = *fnu * test;
if (dabs(tstr) > ac || dabs(tsti) > ac) {
goto L15;
}
ac = (r__1 = log(test), dabs(r__1)) * 2.f + *fnu;
q__1.r = ac, q__1.i = 0.f;
zeta1->r = q__1.r, zeta1->i = q__1.i;
q__1.r = *fnu, q__1.i = 0.f;
zeta2->r = q__1.r, zeta2->i = q__1.i;
phi->r = cone.r, phi->i = cone.i;
arg->r = cone.r, arg->i = cone.i;
return 0;
L15:
q__2.r = rfnu, q__2.i = 0.f;
q__1.r = z__->r * q__2.r - z__->i * q__2.i, q__1.i = z__->r * q__2.i +
z__->i * q__2.r;
zb.r = q__1.r, zb.i = q__1.i;
rfnu2 = rfnu * rfnu;
/* ----------------------------------------------------------------------- */
/* COMPUTE IN THE FOURTH QUADRANT */
/* ----------------------------------------------------------------------- */
d__1 = (doublereal) (*fnu);
d__2 = (doublereal) ex1;
fn13 = pow_dd(&d__1, &d__2);
fn23 = fn13 * fn13;
r__1 = 1.f / fn13;
q__1.r = r__1, q__1.i = 0.f;
rfn13.r = q__1.r, rfn13.i = q__1.i;
q__2.r = zb.r * zb.r - zb.i * zb.i, q__2.i = zb.r * zb.i + zb.i * zb.r;
q__1.r = cone.r - q__2.r, q__1.i = cone.i - q__2.i;
w2.r = q__1.r, w2.i = q__1.i;
aw2 = c_abs(&w2);
if (aw2 > .25f) {
goto L130;
}
/* ----------------------------------------------------------------------- */
/* POWER SERIES FOR ABS(W2).LE.0.25E0 */
/* ----------------------------------------------------------------------- */
k = 1;
p[0].r = cone.r, p[0].i = cone.i;
q__1.r = gama[0], q__1.i = 0.f;
suma.r = q__1.r, suma.i = q__1.i;
ap[0] = 1.f;
if (aw2 < *tol) {
goto L20;
}
for (k = 2; k <= 30; ++k) {
i__1 = k - 1;
i__2 = k - 2;
q__1.r = p[i__2].r * w2.r - p[i__2].i * w2.i, q__1.i = p[i__2].r *
w2.i + p[i__2].i * w2.r;
p[i__1].r = q__1.r, p[i__1].i = q__1.i;
i__1 = k - 1;
i__2 = k - 1;
q__3.r = gama[i__2], q__3.i = 0.f;
q__2.r = p[i__1].r * q__3.r - p[i__1].i * q__3.i, q__2.i = p[i__1].r *
q__3.i + p[i__1].i * q__3.r;
q__1.r = suma.r + q__2.r, q__1.i = suma.i + q__2.i;
suma.r = q__1.r, suma.i = q__1.i;
ap[k - 1] = ap[k - 2] * aw2;
if (ap[k - 1] < *tol) {
goto L20;
}
/* L10: */
}
k = 30;
L20:
kmax = k;
q__1.r = w2.r * suma.r - w2.i * suma.i, q__1.i = w2.r * suma.i + w2.i *
suma.r;
zeta.r = q__1.r, zeta.i = q__1.i;
q__2.r = fn23, q__2.i = 0.f;
q__1.r = zeta.r * q__2.r - zeta.i * q__2.i, q__1.i = zeta.r * q__2.i +
zeta.i * q__2.r;
arg->r = q__1.r, arg->i = q__1.i;
c_sqrt(&q__1, &suma);
za.r = q__1.r, za.i = q__1.i;
c_sqrt(&q__2, &w2);
q__3.r = *fnu, q__3.i = 0.f;
q__1.r = q__2.r * q__3.r - q__2.i * q__3.i, q__1.i = q__2.r * q__3.i +
q__2.i * q__3.r;
zeta2->r = q__1.r, zeta2->i = q__1.i;
q__4.r = zeta.r * za.r - zeta.i * za.i, q__4.i = zeta.r * za.i + zeta.i *
za.r;
q__5.r = ex2, q__5.i = 0.f;
q__3.r = q__4.r * q__5.r - q__4.i * q__5.i, q__3.i = q__4.r * q__5.i +
q__4.i * q__5.r;
q__2.r = cone.r + q__3.r, q__2.i = cone.i + q__3.i;
q__1.r = zeta2->r * q__2.r - zeta2->i * q__2.i, q__1.i = zeta2->r *
q__2.i + zeta2->i * q__2.r;
zeta1->r = q__1.r, zeta1->i = q__1.i;
q__1.r = za.r + za.r, q__1.i = za.i + za.i;
za.r = q__1.r, za.i = q__1.i;
c_sqrt(&q__2, &za);
q__1.r = q__2.r * rfn13.r - q__2.i * rfn13.i, q__1.i = q__2.r * rfn13.i +
q__2.i * rfn13.r;
phi->r = q__1.r, phi->i = q__1.i;
if (*ipmtr == 1) {
goto L120;
}
/* ----------------------------------------------------------------------- */
/* SUM SERIES FOR ASUM AND BSUM */
/* ----------------------------------------------------------------------- */
sumb.r = czero.r, sumb.i = czero.i;
i__1 = kmax;
for (k = 1; k <= i__1; ++k) {
i__2 = k - 1;
i__3 = k - 1;
q__3.r = beta[i__3], q__3.i = 0.f;
q__2.r = p[i__2].r * q__3.r - p[i__2].i * q__3.i, q__2.i = p[i__2].r *
q__3.i + p[i__2].i * q__3.r;
q__1.r = sumb.r + q__2.r, q__1.i = sumb.i + q__2.i;
sumb.r = q__1.r, sumb.i = q__1.i;
/* L30: */
}
asum->r = czero.r, asum->i = czero.i;
bsum->r = sumb.r, bsum->i = sumb.i;
l1 = 0;
l2 = 30;
btol = *tol * c_abs(bsum);
atol = *tol;
pp = 1.f;
ias = 0;
ibs = 0;
if (rfnu2 < *tol) {
goto L110;
}
for (is = 2; is <= 7; ++is) {
atol /= rfnu2;
pp *= rfnu2;
if (ias == 1) {
goto L60;
}
suma.r = czero.r, suma.i = czero.i;
i__1 = kmax;
for (k = 1; k <= i__1; ++k) {
m = l1 + k;
i__2 = k - 1;
i__3 = m - 1;
q__3.r = alfa[i__3], q__3.i = 0.f;
q__2.r = p[i__2].r * q__3.r - p[i__2].i * q__3.i, q__2.i = p[i__2]
.r * q__3.i + p[i__2].i * q__3.r;
q__1.r = suma.r + q__2.r, q__1.i = suma.i + q__2.i;
suma.r = q__1.r, suma.i = q__1.i;
if (ap[k - 1] < atol) {
goto L50;
}
/* L40: */
}
L50:
q__3.r = pp, q__3.i = 0.f;
q__2.r = suma.r * q__3.r - suma.i * q__3.i, q__2.i = suma.r * q__3.i
+ suma.i * q__3.r;
q__1.r = asum->r + q__2.r, q__1.i = asum->i + q__2.i;
asum->r = q__1.r, asum->i = q__1.i;
if (pp < *tol) {
ias = 1;
}
L60:
if (ibs == 1) {
goto L90;
}
sumb.r = czero.r, sumb.i = czero.i;
i__1 = kmax;
for (k = 1; k <= i__1; ++k) {
m = l2 + k;
i__2 = k - 1;
i__3 = m - 1;
q__3.r = beta[i__3], q__3.i = 0.f;
q__2.r = p[i__2].r * q__3.r - p[i__2].i * q__3.i, q__2.i = p[i__2]
.r * q__3.i + p[i__2].i * q__3.r;
q__1.r = sumb.r + q__2.r, q__1.i = sumb.i + q__2.i;
sumb.r = q__1.r, sumb.i = q__1.i;
if (ap[k - 1] < atol) {
goto L80;
}
/* L70: */
}
L80:
q__3.r = pp, q__3.i = 0.f;
q__2.r = sumb.r * q__3.r - sumb.i * q__3.i, q__2.i = sumb.r * q__3.i
+ sumb.i * q__3.r;
q__1.r = bsum->r + q__2.r, q__1.i = bsum->i + q__2.i;
bsum->r = q__1.r, bsum->i = q__1.i;
if (pp < btol) {
ibs = 1;
}
L90:
if (ias == 1 && ibs == 1) {
goto L110;
}
l1 += 30;
l2 += 30;
/* L100: */
}
L110:
q__1.r = asum->r + cone.r, q__1.i = asum->i + cone.i;
asum->r = q__1.r, asum->i = q__1.i;
pp = rfnu * rfn13.r;
q__2.r = pp, q__2.i = 0.f;
q__1.r = bsum->r * q__2.r - bsum->i * q__2.i, q__1.i = bsum->r * q__2.i +
bsum->i * q__2.r;
bsum->r = q__1.r, bsum->i = q__1.i;
L120:
return 0;
/* ----------------------------------------------------------------------- */
/* ABS(W2).GT.0.25E0 */
/* ----------------------------------------------------------------------- */
L130:
c_sqrt(&q__1, &w2);
w.r = q__1.r, w.i = q__1.i;
wr = w.r;
wi = r_imag(&w);
if (wr < 0.f) {
wr = 0.f;
}
if (wi < 0.f) {
wi = 0.f;
}
q__1.r = wr, q__1.i = wi;
w.r = q__1.r, w.i = q__1.i;
q__2.r = cone.r + w.r, q__2.i = cone.i + w.i;
c_div(&q__1, &q__2, &zb);
za.r = q__1.r, za.i = q__1.i;
c_log(&q__1, &za);
zc.r = q__1.r, zc.i = q__1.i;
zcr = zc.r;
zci = r_imag(&zc);
if (zci < 0.f) {
zci = 0.f;
}
if (zci > hpi) {
zci = hpi;
}
if (zcr < 0.f) {
zcr = 0.f;
}
q__1.r = zcr, q__1.i = zci;
zc.r = q__1.r, zc.i = q__1.i;
q__2.r = zc.r - w.r, q__2.i = zc.i - w.i;
q__1.r = q__2.r * 1.5f - q__2.i * 0.f, q__1.i = q__2.r * 0.f + q__2.i *
1.5f;
zth.r = q__1.r, zth.i = q__1.i;
q__1.r = *fnu, q__1.i = 0.f;
cfnu.r = q__1.r, cfnu.i = q__1.i;
q__1.r = zc.r * cfnu.r - zc.i * cfnu.i, q__1.i = zc.r * cfnu.i + zc.i *
cfnu.r;
zeta1->r = q__1.r, zeta1->i = q__1.i;
q__1.r = w.r * cfnu.r - w.i * cfnu.i, q__1.i = w.r * cfnu.i + w.i *
cfnu.r;
zeta2->r = q__1.r, zeta2->i = q__1.i;
azth = c_abs(&zth);
zthr = zth.r;
zthi = r_imag(&zth);
ang = thpi;
if (zthr >= 0.f && zthi < 0.f) {
goto L140;
}
ang = hpi;
if (zthr == 0.f) {
goto L140;
}
ang = atan(zthi / zthr);
if (zthr < 0.f) {
ang += pi;
}
L140:
d__1 = (doublereal) azth;
d__2 = (doublereal) ex2;
pp = pow_dd(&d__1, &d__2);
ang *= ex2;
zetar = pp * cos(ang);
zetai = pp * sin(ang);
if (zetai < 0.f) {
zetai = 0.f;
}
q__1.r = zetar, q__1.i = zetai;
zeta.r = q__1.r, zeta.i = q__1.i;
q__2.r = fn23, q__2.i = 0.f;
q__1.r = zeta.r * q__2.r - zeta.i * q__2.i, q__1.i = zeta.r * q__2.i +
zeta.i * q__2.r;
arg->r = q__1.r, arg->i = q__1.i;
c_div(&q__1, &zth, &zeta);
rtzta.r = q__1.r, rtzta.i = q__1.i;
c_div(&q__1, &rtzta, &w);
za.r = q__1.r, za.i = q__1.i;
q__3.r = za.r + za.r, q__3.i = za.i + za.i;
c_sqrt(&q__2, &q__3);
q__1.r = q__2.r * rfn13.r - q__2.i * rfn13.i, q__1.i = q__2.r * rfn13.i +
q__2.i * rfn13.r;
phi->r = q__1.r, phi->i = q__1.i;
if (*ipmtr == 1) {
goto L120;
}
q__2.r = rfnu, q__2.i = 0.f;
c_div(&q__1, &q__2, &w);
tfn.r = q__1.r, tfn.i = q__1.i;
q__2.r = rfnu, q__2.i = 0.f;
c_div(&q__1, &q__2, &zth);
rzth.r = q__1.r, rzth.i = q__1.i;
q__2.r = ar[1], q__2.i = 0.f;
q__1.r = rzth.r * q__2.r - rzth.i * q__2.i, q__1.i = rzth.r * q__2.i +
rzth.i * q__2.r;
zc.r = q__1.r, zc.i = q__1.i;
c_div(&q__1, &cone, &w2);
t2.r = q__1.r, t2.i = q__1.i;
q__4.r = c__[1], q__4.i = 0.f;
q__3.r = t2.r * q__4.r - t2.i * q__4.i, q__3.i = t2.r * q__4.i + t2.i *
q__4.r;
q__5.r = c__[2], q__5.i = 0.f;
q__2.r = q__3.r + q__5.r, q__2.i = q__3.i + q__5.i;
q__1.r = q__2.r * tfn.r - q__2.i * tfn.i, q__1.i = q__2.r * tfn.i +
q__2.i * tfn.r;
up[1].r = q__1.r, up[1].i = q__1.i;
q__1.r = up[1].r + zc.r, q__1.i = up[1].i + zc.i;
bsum->r = q__1.r, bsum->i = q__1.i;
asum->r = czero.r, asum->i = czero.i;
if (rfnu < *tol) {
goto L220;
}
przth.r = rzth.r, przth.i = rzth.i;
ptfn.r = tfn.r, ptfn.i = tfn.i;
up[0].r = cone.r, up[0].i = cone.i;
pp = 1.f;
bsumr = bsum->r;
bsumi = r_imag(bsum);
btol = *tol * (dabs(bsumr) + dabs(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;
i__2 = l - 1;
q__1.r = c__[i__2], q__1.i = 0.f;
za.r = q__1.r, za.i = q__1.i;
i__2 = kp1;
for (j = 2; j <= i__2; ++j) {
++l;
q__2.r = za.r * t2.r - za.i * t2.i, q__2.i = za.r * t2.i +
za.i * t2.r;
i__3 = l - 1;
q__3.r = c__[i__3], q__3.i = 0.f;
q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
za.r = q__1.r, za.i = q__1.i;
/* L150: */
}
q__1.r = ptfn.r * tfn.r - ptfn.i * tfn.i, q__1.i = ptfn.r * tfn.i
+ ptfn.i * tfn.r;
ptfn.r = q__1.r, ptfn.i = q__1.i;
i__2 = kp1 - 1;
q__1.r = ptfn.r * za.r - ptfn.i * za.i, q__1.i = ptfn.r * za.i +
ptfn.i * za.r;
up[i__2].r = q__1.r, up[i__2].i = q__1.i;
i__2 = ks - 1;
i__3 = ks;
q__2.r = br[i__3], q__2.i = 0.f;
q__1.r = przth.r * q__2.r - przth.i * q__2.i, q__1.i = przth.r *
q__2.i + przth.i * q__2.r;
cr[i__2].r = q__1.r, cr[i__2].i = q__1.i;
q__1.r = przth.r * rzth.r - przth.i * rzth.i, q__1.i = przth.r *
rzth.i + przth.i * rzth.r;
przth.r = q__1.r, przth.i = q__1.i;
i__2 = ks - 1;
i__3 = ks + 1;
q__2.r = ar[i__3], q__2.i = 0.f;
q__1.r = przth.r * q__2.r - przth.i * q__2.i, q__1.i = przth.r *
q__2.i + przth.i * q__2.r;
dr[i__2].r = q__1.r, dr[i__2].i = q__1.i;
/* L160: */
}
pp *= rfnu2;
if (ias == 1) {
goto L180;
}
i__1 = lrp1 - 1;
suma.r = up[i__1].r, suma.i = up[i__1].i;
ju = lrp1;
i__1 = lr;
for (jr = 1; jr <= i__1; ++jr) {
--ju;
i__2 = jr - 1;
i__3 = ju - 1;
q__2.r = cr[i__2].r * up[i__3].r - cr[i__2].i * up[i__3].i,
q__2.i = cr[i__2].r * up[i__3].i + cr[i__2].i * up[i__3]
.r;
q__1.r = suma.r + q__2.r, q__1.i = suma.i + q__2.i;
suma.r = q__1.r, suma.i = q__1.i;
/* L170: */
}
q__1.r = asum->r + suma.r, q__1.i = asum->i + suma.i;
asum->r = q__1.r, asum->i = q__1.i;
asumr = asum->r;
asumi = r_imag(asum);
test = dabs(asumr) + dabs(asumi);
if (pp < *tol && test < *tol) {
ias = 1;
}
L180:
if (ibs == 1) {
goto L200;
}
i__1 = lr + 1;
i__2 = lrp1 - 1;
q__2.r = up[i__2].r * zc.r - up[i__2].i * zc.i, q__2.i = up[i__2].r *
zc.i + up[i__2].i * zc.r;
q__1.r = up[i__1].r + q__2.r, q__1.i = up[i__1].i + q__2.i;
sumb.r = q__1.r, sumb.i = q__1.i;
ju = lrp1;
i__1 = lr;
for (jr = 1; jr <= i__1; ++jr) {
--ju;
i__2 = jr - 1;
i__3 = ju - 1;
q__2.r = dr[i__2].r * up[i__3].r - dr[i__2].i * up[i__3].i,
q__2.i = dr[i__2].r * up[i__3].i + dr[i__2].i * up[i__3]
.r;
q__1.r = sumb.r + q__2.r, q__1.i = sumb.i + q__2.i;
sumb.r = q__1.r, sumb.i = q__1.i;
/* L190: */
}
q__1.r = bsum->r + sumb.r, q__1.i = bsum->i + sumb.i;
bsum->r = q__1.r, bsum->i = q__1.i;
bsumr = bsum->r;
bsumi = r_imag(bsum);
test = dabs(bsumr) + dabs(bsumi);
if (pp < btol && test < *tol) {
ibs = 1;
}
L200:
if (ias == 1 && ibs == 1) {
goto L220;
}
/* L210: */
}
L220:
q__1.r = asum->r + cone.r, q__1.i = asum->i + cone.i;
asum->r = q__1.r, asum->i = q__1.i;
q__3.r = -bsum->r, q__3.i = -bsum->i;
q__2.r = q__3.r * rfn13.r - q__3.i * rfn13.i, q__2.i = q__3.r * rfn13.i +
q__3.i * rfn13.r;
c_div(&q__1, &q__2, &rtzta);
bsum->r = q__1.r, bsum->i = q__1.i;
goto L120;
} /* cunhj_ */
/*
* function [lp]=gaussmixp(y,m,v,w)
* y = cat(1, testSamples(1).mfcc{:});
* m = gmm.M;
* v = gmm.V;
* w = gmm.W;
*/
void gaussmixp(const real_T y[2004], const real_T m[108], const real_T v[108],
const real_T w[9], real_T lp[167])
{
real_T b[108];
real_T dv0[108];
real_T b_b[9];
real_T lvm[9];
int32_T ix;
real_T mx[167];
real_T kk[1503];
real_T km[1503];
static real_T b_y[18036];
int32_T iy;
real_T dv1[18036];
real_T x[1503];
int32_T i;
int32_T ixstart;
int32_T ixstop;
real_T mtmp;
int32_T b_ix;
boolean_T exitg1;
real_T ps[167];
/* GAUSSMIXP calculate probability densities from a Gaussian mixture model */
/* */
/* Inputs: n data values, k mixtures, p parameters, q data vector size */
/* */
/* Y(n,q) = input data */
/* M(k,p) = mixture means for x(p) */
/* V(k,p) or V(p,p,k) variances (diagonal or full) */
/* W(k,1) = weights */
/* A(q,p), B(q) = transformation: y=x*a'+b' (where y and x are row vectors) */
/* if A is omitted, it is assumed to be the first q rows of the */
/* identity matrix. B defaults to zero. */
/* Note that most commonly, q=p and A and B are omitted entirely. */
/* */
/* Outputs */
/* */
/* LP(n,1) = log probability of each data point */
/* RP(n,k) = relative probability of each mixture */
/* KH(n,1) = highest probability mixture */
/* KP(n,1) = relative probability of highest probability mixture */
/* Copyright (C) Mike Brookes 2000-2009 */
/* Version: $Id: gaussmixp.m,v 1.3 2009/04/08 07:51:21 dmb Exp $ */
/* */
/* VOICEBOX is a MATLAB toolbox for speech processing. */
/* Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html */
/* */
/* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
/* This program is free software; you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* the Free Software Foundation; either version 2 of the License, or */
/* (at your option) any later version. */
/* */
/* This program is distributed in the hope that it will be useful, */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
/* GNU General Public License for more details. */
/* */
/* You can obtain a copy of the GNU General Public License from */
/* http://www.gnu.org/copyleft/gpl.html or by writing to */
/* Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA. */
/* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% */
/* 'gaussmixp:49' [n,q]=size(y); */
/* 'gaussmixp:50' [k,p]=size(m); */
/* 'gaussmixp:51' memsize=voicebox('memsize'); */
voicebox();
/* set memory size to use */
/* 'gaussmixp:53' lp=zeros(n,1); */
memset((void *)&lp[0], 0, 167U * sizeof(real_T));
/* 'gaussmixp:54' wk=ones(k,1); */
/* 'gaussmixp:56' vi=-0.5*v.^(-1); */
power(v, b);
/* data-independent scale factor in exponent */
/* 'gaussmixp:57' lvm=log(w)-0.5*sum(log(v),2); */
memcpy((void *)&dv0[0], (void *)&v[0], 108U * sizeof(real_T));
c_log(dv0);
sum(dv0, b_b);
memcpy((void *)&lvm[0], (void *)&w[0], 9U * sizeof(real_T));
b_log(lvm);
for (ix = 0; ix < 9; ix++) {
lvm[ix] -= 0.5 * b_b[ix];
}
/* log of external scale factor (excluding -0.5*q*log(2pi) term) */
/* 'gaussmixp:58' ii=1:n; */
/* 'gaussmixp:59' wnj=ones(1,n); */
/* 'gaussmixp:60' kk=repmat(ii,k,1); */
for (ix = 0; ix < 167; ix++) {
mx[ix] = 1.0 + (real_T)ix;
}
repmat(mx, kk);
/* 'gaussmixp:61' km=repmat(1:k,1,n); */
for (ix = 0; ix < 9; ix++) {
b_b[ix] = 1.0 + (real_T)ix;
}
b_repmat(b_b, km);
/* 'gaussmixp:62' py=reshape(sum((y(kk(:),:)-m(km(:),:)).^2.*vi(km(:),:),2),k,n)+lvm(:,wnj); */
for (ix = 0; ix < 12; ix++) {
for (iy = 0; iy < 1503; iy++) {
b_y[iy + 1503 * ix] = y[((int32_T)kk[iy] + 167 * ix) - 1] - m[((int32_T)
km[iy] + 9 * ix) - 1];
}
}
b_power(b_y, dv1);
for (ix = 0; ix < 12; ix++) {
for (iy = 0; iy < 1503; iy++) {
b_y[iy + 1503 * ix] = dv1[iy + 1503 * ix] * (-0.5 * b[((int32_T)km[iy] + 9
* ix) - 1]);
}
}
b_sum(b_y, x);
memcpy((void *)&kk[0], (void *)&x[0], 1503U * sizeof(real_T));
for (ix = 0; ix < 167; ix++) {
for (iy = 0; iy < 9; iy++) {
km[iy + 9 * ix] = kk[iy + 9 * ix] + lvm[iy];
}
}
/* 'gaussmixp:63' mx=max(py,[],1); */
ix = -8;
iy = -1;
for (i = 0; i < 167; i++) {
ix += 9;
ixstart = ix;
ixstop = ix + 8;
mtmp = km[ix - 1];
if (rtIsNaN(km[ix - 1])) {
b_ix = ix;
exitg1 = 0U;
while ((exitg1 == 0U) && (b_ix + 1 <= ixstop)) {
ixstart = b_ix + 1;
if (!rtIsNaN(km[b_ix])) {
mtmp = km[b_ix];
exitg1 = 1U;
} else {
b_ix++;
}
}
}
if (ixstart < ixstop) {
while (ixstart + 1 <= ixstop) {
if (km[ixstart] > mtmp) {
mtmp = km[ixstart];
}
ixstart++;
}
}
iy++;
mx[iy] = mtmp;
}
/* find normalizing factor for each data point to prevent underflow when using exp() */
/* 'gaussmixp:64' px=exp(py-mx(wk,:)); */
for (ix = 0; ix < 167; ix++) {
for (iy = 0; iy < 9; iy++) {
kk[iy + 9 * ix] = km[iy + 9 * ix] - mx[ix];
}
}
b_exp(kk);
/* find normalized probability of each mixture for each datapoint */
/* 'gaussmixp:65' ps=sum(px,1); */
c_sum(kk, ps);
/* total normalized likelihood of each data point */
/* 'gaussmixp:66' lp(ii)=log(ps)+mx; */
d_log(ps);
for (ix = 0; ix < 167; ix++) {
/* 'gaussmixp:67' lp=lp-0.5*q*log(2*pi); */
lp[ix] = (ps[ix] + mx[ix]) - 11.027262398456072;
}
}
/* DECK CLNGAM */
/* Complex */ void clngam_(complex * ret_val, complex *zin)
{
/* Initialized data */
static real pi = 3.14159265358979324f;
static real sq2pil = .91893853320467274f;
static logical first = TRUE_;
/* System generated locals */
integer i__1;
real r__1, r__2;
doublereal d__1, d__2;
complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8, q__9, q__10,
q__11, q__12, q__13, q__14, q__15, q__16;
/* Local variables */
static integer i__, n;
static real x, y;
static complex z__;
extern doublereal carg_(complex *);
static complex corr;
static real cabsz, bound, dxrel;
extern doublereal r1mach_(integer *);
extern /* Complex */ void c9lgmc_(complex *, complex *), clnrel_(complex *
, complex *);
static real argsum;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* ***BEGIN PROLOGUE CLNGAM */
/* ***PURPOSE Compute the logarithm of the absolute value of the Gamma */
/* function. */
/* ***LIBRARY SLATEC (FNLIB) */
/* ***CATEGORY C7A */
/* ***TYPE COMPLEX (ALNGAM-S, DLNGAM-D, CLNGAM-C) */
/* ***KEYWORDS ABSOLUTE VALUE, COMPLETE GAMMA FUNCTION, FNLIB, LOGARITHM, */
/* SPECIAL FUNCTIONS */
/* ***AUTHOR Fullerton, W., (LANL) */
/* ***DESCRIPTION */
/* CLNGAM computes the natural log of the complex valued gamma function */
/* at ZIN, where ZIN is a complex number. This is a preliminary version, */
/* which is not accurate. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED C9LGMC, CARG, CLNREL, R1MACH, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 780401 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890531 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
/* ***END PROLOGUE CLNGAM */
/* ***FIRST EXECUTABLE STATEMENT CLNGAM */
if (first) {
n = log(r1mach_(&c__3)) * -.3f;
/* BOUND = N*(0.1*EPS)**(-1/(2*N-1))/(PI*EXP(1)) */
d__1 = (doublereal) (r1mach_(&c__3) * .1f);
d__2 = (doublereal) (-1.f / ((n << 1) - 1));
bound = n * .1171f * pow_dd(&d__1, &d__2);
dxrel = sqrt(r1mach_(&c__4));
}
first = FALSE_;
z__.r = zin->r, z__.i = zin->i;
x = zin->r;
y = r_imag(zin);
corr.r = 0.f, corr.i = 0.f;
cabsz = c_abs(&z__);
if (x >= 0.f && cabsz > bound) {
goto L50;
}
if (x < 0.f && dabs(y) > bound) {
goto L50;
}
if (cabsz < bound) {
goto L20;
}
/* USE THE REFLECTION FORMULA FOR REAL(Z) NEGATIVE, ABS(Z) LARGE, AND */
/* ABS(AIMAG(Y)) SMALL. */
if (y > 0.f) {
r_cnjg(&q__1, &z__);
z__.r = q__1.r, z__.i = q__1.i;
}
r__1 = pi * 2.f;
q__4.r = 0.f, q__4.i = r__1;
q__3.r = -q__4.r, q__3.i = -q__4.i;
q__2.r = q__3.r * z__.r - q__3.i * z__.i, q__2.i = q__3.r * z__.i +
q__3.i * z__.r;
c_exp(&q__1, &q__2);
corr.r = q__1.r, corr.i = q__1.i;
if (corr.r == 1.f && r_imag(&corr) == 0.f) {
xermsg_("SLATEC", "CLNGAM", "Z IS A NEGATIVE INTEGER", &c__3, &c__2, (
ftnlen)6, (ftnlen)6, (ftnlen)23);
}
r__1 = sq2pil + 1.f;
q__7.r = 0.f, q__7.i = pi;
q__8.r = z__.r - .5f, q__8.i = z__.i;
q__6.r = q__7.r * q__8.r - q__7.i * q__8.i, q__6.i = q__7.r * q__8.i +
q__7.i * q__8.r;
q__5.r = r__1 - q__6.r, q__5.i = -q__6.i;
q__10.r = -corr.r, q__10.i = -corr.i;
clnrel_(&q__9, &q__10);
q__4.r = q__5.r - q__9.r, q__4.i = q__5.i - q__9.i;
q__12.r = z__.r - .5f, q__12.i = z__.i;
q__14.r = 1.f - z__.r, q__14.i = -z__.i;
c_log(&q__13, &q__14);
q__11.r = q__12.r * q__13.r - q__12.i * q__13.i, q__11.i = q__12.r *
q__13.i + q__12.i * q__13.r;
q__3.r = q__4.r + q__11.r, q__3.i = q__4.i + q__11.i;
q__2.r = q__3.r - z__.r, q__2.i = q__3.i - z__.i;
q__16.r = 1.f - z__.r, q__16.i = -z__.i;
c9lgmc_(&q__15, &q__16);
q__1.r = q__2.r - q__15.r, q__1.i = q__2.i - q__15.i;
ret_val->r = q__1.r, ret_val->i = q__1.i;
if (y > 0.f) {
r_cnjg(&q__1, ret_val);
ret_val->r = q__1.r, ret_val->i = q__1.i;
}
return ;
/* USE THE RECURSION RELATION FOR ABS(Z) SMALL. */
L20:
if (x >= -.5f || dabs(y) > dxrel) {
goto L30;
}
r__2 = x - .5f;
r__1 = r_int(&r__2);
q__2.r = z__.r - r__1, q__2.i = z__.i;
q__1.r = q__2.r / x, q__1.i = q__2.i / x;
if (c_abs(&q__1) < dxrel) {
xermsg_("SLATEC", "CLNGAM", "ANSWER LT HALF PRECISION BECAUSE Z TOO "
"NEAR NEGATIVE INTEGER", &c__1, &c__1, (ftnlen)6, (ftnlen)6, (
ftnlen)60);
}
L30:
/* Computing 2nd power */
r__1 = bound;
/* Computing 2nd power */
r__2 = y;
n = sqrt(r__1 * r__1 - r__2 * r__2) - x + 1.f;
argsum = 0.f;
corr.r = 1.f, corr.i = 0.f;
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
argsum += carg_(&z__);
q__1.r = z__.r * corr.r - z__.i * corr.i, q__1.i = z__.r * corr.i +
z__.i * corr.r;
corr.r = q__1.r, corr.i = q__1.i;
q__1.r = z__.r + 1.f, q__1.i = z__.i;
z__.r = q__1.r, z__.i = q__1.i;
/* L40: */
}
if (corr.r == 0.f && r_imag(&corr) == 0.f) {
xermsg_("SLATEC", "CLNGAM", "Z IS A NEGATIVE INTEGER", &c__3, &c__2, (
ftnlen)6, (ftnlen)6, (ftnlen)23);
}
r__1 = log(c_abs(&corr));
q__2.r = r__1, q__2.i = argsum;
q__1.r = -q__2.r, q__1.i = -q__2.i;
corr.r = q__1.r, corr.i = q__1.i;
/* USE STIRLING-S APPROXIMATION FOR LARGE Z. */
L50:
q__6.r = z__.r - .5f, q__6.i = z__.i;
c_log(&q__7, &z__);
q__5.r = q__6.r * q__7.r - q__6.i * q__7.i, q__5.i = q__6.r * q__7.i +
q__6.i * q__7.r;
q__4.r = sq2pil + q__5.r, q__4.i = q__5.i;
q__3.r = q__4.r - z__.r, q__3.i = q__4.i - z__.i;
q__2.r = q__3.r + corr.r, q__2.i = q__3.i + corr.i;
c9lgmc_(&q__8, &z__);
q__1.r = q__2.r + q__8.r, q__1.i = q__2.i + q__8.i;
ret_val->r = q__1.r, ret_val->i = q__1.i;
return ;
} /* clngam_ */
/* DECK CPSI */
/* Complex */ void cpsi_(complex * ret_val, complex *zin)
{
/* Initialized data */
static real bern[13] = { .083333333333333333f,-.0083333333333333333f,
.0039682539682539683f,-.0041666666666666667f,
.0075757575757575758f,-.021092796092796093f,.083333333333333333f,
-.44325980392156863f,3.0539543302701197f,-26.456212121212121f,
281.46014492753623f,-3454.8853937728938f,54827.583333333333f };
static real pi = 3.141592653589793f;
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
real r__1, r__2;
doublereal d__1, d__2;
complex q__1, q__2, q__3, q__4, q__5, q__6;
/* Local variables */
static integer i__, n;
static real x, y;
static complex z__;
static integer ndx;
static real rbig;
extern /* Complex */ void ccot_(complex *, complex *);
static complex corr;
static real rmin;
static complex z2inv;
static real cabsz, bound, dxrel;
static integer nterm;
extern doublereal r1mach_(integer *);
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* ***BEGIN PROLOGUE CPSI */
/* ***PURPOSE Compute the Psi (or Digamma) function. */
/* ***LIBRARY SLATEC (FNLIB) */
/* ***CATEGORY C7C */
/* ***TYPE COMPLEX (PSI-S, DPSI-D, CPSI-C) */
/* ***KEYWORDS DIGAMMA FUNCTION, FNLIB, PSI FUNCTION, SPECIAL FUNCTIONS */
/* ***AUTHOR Fullerton, W., (LANL) */
/* ***DESCRIPTION */
/* PSI(X) calculates the psi (or digamma) function of X. PSI(X) */
/* is the logarithmic derivative of the gamma function of X. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED CCOT, R1MACH, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 780501 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890531 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
/* 900727 Added EXTERNAL statement. (WRB) */
/* ***END PROLOGUE CPSI */
/* ***FIRST EXECUTABLE STATEMENT CPSI */
if (first) {
nterm = log(r1mach_(&c__3)) * -.3f;
/* MAYBE BOUND = N*(0.1*EPS)**(-1/(2*N-1)) / (PI*EXP(1)) */
d__1 = (doublereal) (r1mach_(&c__3) * .1f);
d__2 = (doublereal) (-1.f / ((nterm << 1) - 1));
bound = nterm * .1171f * pow_dd(&d__1, &d__2);
dxrel = sqrt(r1mach_(&c__4));
/* Computing MAX */
r__1 = log(r1mach_(&c__1)), r__2 = -log(r1mach_(&c__2));
rmin = exp(dmax(r__1,r__2) + .011f);
rbig = 1.f / r1mach_(&c__3);
}
first = FALSE_;
z__.r = zin->r, z__.i = zin->i;
x = z__.r;
y = r_imag(&z__);
if (y < 0.f) {
r_cnjg(&q__1, &z__);
z__.r = q__1.r, z__.i = q__1.i;
}
corr.r = 0.f, corr.i = 0.f;
cabsz = c_abs(&z__);
if (x >= 0.f && cabsz > bound) {
goto L50;
}
if (x < 0.f && dabs(y) > bound) {
goto L50;
}
if (cabsz < bound) {
goto L20;
}
/* USE THE REFLECTION FORMULA FOR REAL(Z) NEGATIVE, ABS(Z) LARGE, AND */
/* ABS(AIMAG(Y)) SMALL. */
r__1 = -pi;
q__3.r = pi * z__.r, q__3.i = pi * z__.i;
ccot_(&q__2, &q__3);
q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
corr.r = q__1.r, corr.i = q__1.i;
q__1.r = 1.f - z__.r, q__1.i = -z__.i;
z__.r = q__1.r, z__.i = q__1.i;
goto L50;
/* USE THE RECURSION RELATION FOR ABS(Z) SMALL. */
L20:
if (cabsz < rmin) {
xermsg_("SLATEC", "CPSI", "CPSI CALLED WITH Z SO NEAR 0 THAT CPSI OV"
"ERFLOWS", &c__2, &c__2, (ftnlen)6, (ftnlen)4, (ftnlen)48);
}
if (x >= -.5f || dabs(y) > dxrel) {
goto L30;
}
r__2 = x - .5f;
r__1 = r_int(&r__2);
q__2.r = z__.r - r__1, q__2.i = z__.i;
q__1.r = q__2.r / x, q__1.i = q__2.i / x;
if (c_abs(&q__1) < dxrel) {
xermsg_("SLATEC", "CPSI", "ANSWER LT HALF PRECISION BECAUSE Z TOO NE"
"AR NEGATIVE INTEGER", &c__1, &c__1, (ftnlen)6, (ftnlen)4, (
ftnlen)60);
}
if (y == 0.f && x == r_int(&x)) {
xermsg_("SLATEC", "CPSI", "Z IS A NEGATIVE INTEGER", &c__3, &c__2, (
ftnlen)6, (ftnlen)4, (ftnlen)23);
}
L30:
/* Computing 2nd power */
r__1 = bound;
/* Computing 2nd power */
r__2 = y;
n = sqrt(r__1 * r__1 - r__2 * r__2) - x + 1.f;
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
c_div(&q__2, &c_b28, &z__);
q__1.r = corr.r - q__2.r, q__1.i = corr.i - q__2.i;
corr.r = q__1.r, corr.i = q__1.i;
q__1.r = z__.r + 1.f, q__1.i = z__.i;
z__.r = q__1.r, z__.i = q__1.i;
/* L40: */
}
/* NOW EVALUATE THE ASYMPTOTIC SERIES FOR SUITABLY LARGE Z. */
L50:
if (cabsz > rbig) {
c_log(&q__2, &z__);
q__1.r = q__2.r + corr.r, q__1.i = q__2.i + corr.i;
ret_val->r = q__1.r, ret_val->i = q__1.i;
}
if (cabsz > rbig) {
goto L70;
}
ret_val->r = 0.f, ret_val->i = 0.f;
pow_ci(&q__2, &z__, &c__2);
c_div(&q__1, &c_b28, &q__2);
z2inv.r = q__1.r, z2inv.i = q__1.i;
i__1 = nterm;
for (i__ = 1; i__ <= i__1; ++i__) {
ndx = nterm + 1 - i__;
i__2 = ndx - 1;
q__2.r = z2inv.r * ret_val->r - z2inv.i * ret_val->i, q__2.i =
z2inv.r * ret_val->i + z2inv.i * ret_val->r;
q__1.r = bern[i__2] + q__2.r, q__1.i = q__2.i;
ret_val->r = q__1.r, ret_val->i = q__1.i;
/* L60: */
}
c_log(&q__4, &z__);
c_div(&q__5, &c_b34, &z__);
q__3.r = q__4.r - q__5.r, q__3.i = q__4.i - q__5.i;
q__6.r = ret_val->r * z2inv.r - ret_val->i * z2inv.i, q__6.i =
ret_val->r * z2inv.i + ret_val->i * z2inv.r;
q__2.r = q__3.r - q__6.r, q__2.i = q__3.i - q__6.i;
q__1.r = q__2.r + corr.r, q__1.i = q__2.i + corr.i;
ret_val->r = q__1.r, ret_val->i = q__1.i;
L70:
if (y < 0.f) {
r_cnjg(&q__1, ret_val);
ret_val->r = q__1.r, ret_val->i = q__1.i;
}
return ;
} /* cpsi_ */
complex c_pow(complex x, complex y) /* 累乗 $x^y$ */
{
return c_exp(c_mul(y, c_log(x)));
}
