int main()
{
int t;
int e,f;
scanf("%d",&t);
while(t--)
{
scanf("%d%d",&e,&f);
int *arr=(int*)calloc(sizeof(int),f-e+1);
int n;
scanf("%d",&n);
int p[n],w[n];
int i,j;
for(i=0;i<n;i++)
{
scanf("%d%d",&p[i],&w[i]);
if(w[i]<=f-e)
arr[w[i]]=min0(arr[w[i]],p[i]);
}
for(i=1;i<=f-e;i++)
{
int min=arr[i];
for(j=1;j<=i/2;j++)
{
if(arr[j]!=0&&arr[i-j]!=0)
min=min0(min,arr[j]+arr[i-j]);
}
arr[i]=min;
}
if(arr[f-e])
printf("The minimum amount of money in the piggy-bank is %d.\n",arr[f-e]);
else
printf("This is impossible.\n");
}
return 0;
}
static void grid_init(CellManager& cman, Dyn3DArr<std::atomic<int>>& aindx, Dyn4DArr<Cell*>& area) { //DO NOT RESTRICT ptrs in area
aindx.all_memset(0);
cman.all_foreach_parallel_native([&](Cell*const c) {//cannot restrict
//auto&c = cman[i];
int aix, aiy, aiz;
aix = (int)((real(0.5)*pm->LX - p_diff_x(real(0.5)*pm->LX, c->x())) / pm->AREA_GRID);
aiy = (int)((real(0.5)*pm->LY - p_diff_y(real(0.5)*pm->LY, c->y())) / pm->AREA_GRID);
aiz = (int)((min0(c->z())) / pm->AREA_GRID);
if ((aix >= (int)pm->ANX || aiy >= (int)pm->ANY || aiz >= (int)pm->ANZ || aix < 0 || aiy < 0 || aiz < 0)) {
throw std::logic_error(
"Bad cell position(on grid)\nRaw cell position: x=" + std::to_string(c->x()) + " y=" + std::to_string(c->y()) + " z=" + std::to_string(c->z()) + "\n"
+ "Grid cell position: x=" + std::to_string(aix) + " y=" + std::to_string(aiy) + " z=" + std::to_string(aiz) + "\n"
+ "Grid size: X=" + std::to_string(pm->ANX) + " Y=" + std::to_string(pm->ANY) + " Z=" + std::to_string(pm->ANZ) + "\n"
+ "Grid unit size:" + std::to_string(pm->AREA_GRID));
}
area.at(aix,aiy,aiz,aindx.at(aix,aiy,aiz)++) = c;
c->connected_cell.force_set_count(c->state == MEMB ? pm->MEMB_ADJ_CONN_NUM : 0);
});
}
/*
* **********
*
* subroutine qrfac
*
* this subroutine uses householder transformations with column
* pivoting (optional) to compute a qr factorization of the
* m by n matrix a. that is, qrfac determines an orthogonal
* matrix q, a permutation matrix p, and an upper trapezoidal
* matrix r with diagonal elements of nonincreasing magnitude,
* such that a*p = q*r. the householder transformation for
* column k, k = 1,2,...,min(m,n), is of the form
*
* t
* i - (1/u(k))*u*u
*
* where u has zeros in the first k-1 positions. the form of
* this transformation and the method of pivoting first
* appeared in the corresponding linpack subroutine.
*
* the subroutine statement is
*
* subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa)
*
* where
*
* m is a positive integer input variable set to the number
* of rows of a.
*
* n is a positive integer input variable set to the number
* of columns of a.
*
* a is an m by n array. on input a contains the matrix for
* which the qr factorization is to be computed. on output
* the strict upper trapezoidal part of a contains the strict
* upper trapezoidal part of r, and the lower trapezoidal
* part of a contains a factored form of q (the non-trivial
* elements of the u vectors described above).
*
* lda is a positive integer input variable not less than m
* which specifies the leading dimension of the array a.
*
* pivot is a logical input variable. if pivot is set true,
* then column pivoting is enforced. if pivot is set false,
* then no column pivoting is done.
*
* ipvt is an integer output array of length lipvt. ipvt
* defines the permutation matrix p such that a*p = q*r.
* column j of p is column ipvt(j) of the identity matrix.
* if pivot is false, ipvt is not referenced.
*
* lipvt is a positive integer input variable. if pivot is false,
* then lipvt may be as small as 1. if pivot is true, then
* lipvt must be at least n.
*
* rdiag is an output array of length n which contains the
* diagonal elements of r.
*
* acnorm is an output array of length n which contains the
* norms of the corresponding columns of the input matrix a.
* if this information is not needed, then acnorm can coincide
* with rdiag.
*
* wa is a work array of length n. if pivot is false, then wa
* can coincide with rdiag.
*
* subprograms called
*
* minpack-supplied ... dpmpar,enorm
*
* fortran-supplied ... dmax1,dsqrt,min0
*
* argonne national laboratory. minpack project. march 1980.
* burton s. garbow, kenneth e. hillstrom, jorge j. more
*
* **********
*/
void qrfac(int m,
int n,
double a[],
int lda,
int pivot,
int ipvt[],
int lipvt,
double rdiag[],
double acnorm[],
double wa[])
{
int i;
int ij;
int jj;
int j;
int jp1;
int k;
int kmax;
int minmn;
double ajnorm;
double sum;
double temp;
static double zero = 0.0;
static double one = 1.0;
static double p05 = 0.05;
/* compute the initial column norms and initialize several arrays. */
//printf("\nqrfac\n");
ij = 0;
for (j=0; j<n; j++)
{
acnorm[j] = enorm(m,&a[ij]);
rdiag[j] = acnorm[j];
wa[j] = rdiag[j];
if (pivot != 0)
ipvt[j] = j;
ij += m; /* m*j */
// printf("acnorm[%d] = %e\n", j, acnorm[j]);
// printf("rdiag[%d] = %e\n", j, rdiag[j]);
}
#ifdef BUG
printf( "qrfac\n" );
#endif
/* reduce a to r with householder transformations. */
minmn = min0(m,n);
for (j=0; j<minmn; j++)
{
if (pivot == 0)
goto L40;
/* bring the column of largest norm into the pivot position. */
kmax = j;
for (k=j; k<n; k++)
{
if (rdiag[k] > rdiag[kmax])
kmax = k;
}
if (kmax == j)
goto L40;
ij = m * j;
jj = m * kmax;
for (i=0; i<m; i++)
{
temp = a[ij]; /* [i+m*j] */
a[ij] = a[jj]; /* [i+m*kmax] */
a[jj] = temp;
ij += 1;
jj += 1;
}
rdiag[kmax] = rdiag[j];
wa[kmax] = wa[j];
k = ipvt[j];
ipvt[j] = ipvt[kmax];
ipvt[kmax] = k;
L40:
/* compute the householder transformation to reduce the
* j-th column of a to a multiple of the j-th unit vector.
*/
jj = j + m*j;
ajnorm = enorm(m-j,&a[jj]);
if (ajnorm == zero)
goto L100;
if (a[jj] < zero)
ajnorm = -ajnorm;
ij = jj;
for (i=j; i<m; i++)
{
a[ij] /= ajnorm;
ij += 1; /* [i+m*j] */
}
a[jj] += one;
/* apply the transformation to the remaining columns
* and update the norms.
*/
jp1 = j + 1;
if (jp1 < n)
{
for (k=jp1; k<n; k++)
{
sum = zero;
ij = j + m*k;
jj = j + m*j;
for (i=j; i<m; i++)
{
sum += a[jj]*a[ij];
ij += 1; /* [i+m*k] */
jj += 1; /* [i+m*j] */
}
temp = sum/a[j+m*j];
ij = j + m*k;
jj = j + m*j;
for (i=j; i<m; i++)
{
a[ij] -= temp*a[jj];
ij += 1; /* [i+m*k] */
jj += 1; /* [i+m*j] */
}
if ((pivot != 0) && (rdiag[k] != zero))
{
temp = a[j+m*k]/rdiag[k];
temp = dmax1(zero, one-temp*temp);
rdiag[k] *= sqrt(temp);
temp = rdiag[k]/wa[k];
if ((p05*temp*temp) <= MACHEP)
{
rdiag[k] = enorm(m-j-1,&a[jp1+m*k]);
wa[k] = rdiag[k];
}
}
}
}
L100:
rdiag[j] = -ajnorm;
}
}
static void K_bessel(double *x, double *alpha, long *nb,
long *ize, double *bk, long *ncalc)
{
/*-------------------------------------------------------------------
This routine calculates modified Bessel functions
of the third kind, K_(N+ALPHA) (X), for non-negative
argument X, and non-negative order N+ALPHA, with or without
exponential scaling.
Explanation of variables in the calling sequence
X - Non-negative argument for which
K's or exponentially scaled K's (K*EXP(X))
are to be calculated. If K's are to be calculated,
X must not be greater than XMAX_BESS_K.
ALPHA - Fractional part of order for which
K's or exponentially scaled K's (K*EXP(X)) are
to be calculated. 0 <= ALPHA < 1.0.
NB - Number of functions to be calculated, NB > 0.
The first function calculated is of order ALPHA, and the
last is of order (NB - 1 + ALPHA).
IZE - Type. IZE = 1 if unscaled K's are to be calculated,
= 2 if exponentially scaled K's are to be calculated.
BK - Output vector of length NB. If the
routine terminates normally (NCALC=NB), the vector BK
contains the functions K(ALPHA,X), ... , K(NB-1+ALPHA,X),
or the corresponding exponentially scaled functions.
If (0 < NCALC < NB), BK(I) contains correct function
values for I <= NCALC, and contains the ratios
K(ALPHA+I-1,X)/K(ALPHA+I-2,X) for the rest of the array.
NCALC - Output variable indicating possible errors.
Before using the vector BK, the user should check that
NCALC=NB, i.e., all orders have been calculated to
the desired accuracy. See error returns below.
*******************************************************************
Error returns
In case of an error, NCALC != NB, and not all K's are
calculated to the desired accuracy.
NCALC < -1: An argument is out of range. For example,
NB <= 0, IZE is not 1 or 2, or IZE=1 and ABS(X) >= XMAX_BESS_K.
In this case, the B-vector is not calculated,
and NCALC is set to MIN0(NB,0)-2 so that NCALC != NB.
NCALC = -1: Either K(ALPHA,X) >= XINF or
K(ALPHA+NB-1,X)/K(ALPHA+NB-2,X) >= XINF. In this case,
the B-vector is not calculated. Note that again
NCALC != NB.
0 < NCALC < NB: Not all requested function values could
be calculated accurately. BK(I) contains correct function
values for I <= NCALC, and contains the ratios
K(ALPHA+I-1,X)/K(ALPHA+I-2,X) for the rest of the array.
Intrinsic functions required are:
ABS, AINT, EXP, INT, LOG, MAX, MIN, SINH, SQRT
Acknowledgement
This program is based on a program written by J. B. Campbell
(2) that computes values of the Bessel functions K of float
argument and float order. Modifications include the addition
of non-scaled functions, parameterization of machine
dependencies, and the use of more accurate approximations
for SINH and SIN.
References: "On Temme's Algorithm for the Modified Bessel
Functions of the Third Kind," Campbell, J. B.,
TOMS 6(4), Dec. 1980, pp. 581-586.
"A FORTRAN IV Subroutine for the Modified Bessel
Functions of the Third Kind of Real Order and Real
Argument," Campbell, J. B., Report NRC/ERB-925,
National Research Council, Canada.
Latest modification: May 30, 1989
Modified by: W. J. Cody and L. Stoltz
Applied Mathematics Division
Argonne National Laboratory
Argonne, IL 60439
-------------------------------------------------------------------
*/
/*---------------------------------------------------------------------
* Mathematical constants
* A = LOG(2) - Euler's constant
* D = SQRT(2/PI)
---------------------------------------------------------------------*/
const static double a = .11593151565841244881;
/*---------------------------------------------------------------------
P, Q - Approximation for LOG(GAMMA(1+ALPHA))/ALPHA + Euler's constant
Coefficients converted from hex to decimal and modified
by W. J. Cody, 2/26/82 */
const static double p[8] = { .805629875690432845,20.4045500205365151,
157.705605106676174,536.671116469207504,900.382759291288778,
730.923886650660393,229.299301509425145,.822467033424113231 };
const static double q[7] = { 29.4601986247850434,277.577868510221208,
1206.70325591027438,2762.91444159791519,3443.74050506564618,
2210.63190113378647,572.267338359892221 };
/* R, S - Approximation for (1-ALPHA*PI/SIN(ALPHA*PI))/(2.D0*ALPHA) */
const static double r[5] = { -.48672575865218401848,13.079485869097804016,
-101.96490580880537526,347.65409106507813131,
3.495898124521934782e-4 };
const static double s[4] = { -25.579105509976461286,212.57260432226544008,
-610.69018684944109624,422.69668805777760407 };
/* T - Approximation for SINH(Y)/Y */
const static double t[6] = { 1.6125990452916363814e-10,
2.5051878502858255354e-8,2.7557319615147964774e-6,
1.9841269840928373686e-4,.0083333333333334751799,
.16666666666666666446 };
/*---------------------------------------------------------------------*/
const static double estm[6] = { 52.0583,5.7607,2.7782,14.4303,185.3004, 9.3715 };
const static double estf[7] = { 41.8341,7.1075,6.4306,42.511,1.35633,84.5096,20.};
/* Local variables */
long iend, i, j, k, m, ii, mplus1;
double x2by4, twox, c, blpha, ratio, wminf;
double d1, d2, d3, f0, f1, f2, p0, q0, t1, t2, twonu;
double dm, ex, bk1, bk2, nu;
ii = 0; /* -Wall */
ex = *x;
nu = *alpha;
*ncalc = min0(*nb,0) - 2;
if (*nb > 0 && (0. <= nu && nu < 1.) && (1 <= *ize && *ize <= 2)) {
if(ex <= 0 || (*ize == 1 && ex > xmax_BESS_K)) {
if(ex <= 0) {
if(ex < 0) ML_ERROR(ME_RANGE, "K_bessel");
for(i=0; i < *nb; i++)
bk[i] = ML_POSINF;
} else /* would only have underflow */
for(i=0; i < *nb; i++)
bk[i] = 0.;
*ncalc = *nb;
return;
}
k = 0;
if (nu < sqxmin_BESS_K) {
nu = 0.;
} else if (nu > .5) {
k = 1;
nu -= 1.;
}
twonu = nu + nu;
iend = *nb + k - 1;
c = nu * nu;
d3 = -c;
if (ex <= 1.) {
/* ------------------------------------------------------------
Calculation of P0 = GAMMA(1+ALPHA) * (2/X)**ALPHA
Q0 = GAMMA(1-ALPHA) * (X/2)**ALPHA
------------------------------------------------------------ */
d1 = 0.; d2 = p[0];
t1 = 1.; t2 = q[0];
for (i = 2; i <= 7; i += 2) {
d1 = c * d1 + p[i - 1];
d2 = c * d2 + p[i];
t1 = c * t1 + q[i - 1];
t2 = c * t2 + q[i];
}
d1 = nu * d1;
t1 = nu * t1;
f1 = log(ex);
f0 = a + nu * (p[7] - nu * (d1 + d2) / (t1 + t2)) - f1;
q0 = exp(-nu * (a - nu * (p[7] + nu * (d1-d2) / (t1-t2)) - f1));
f1 = nu * f0;
p0 = exp(f1);
/* -----------------------------------------------------------
Calculation of F0 =
----------------------------------------------------------- */
d1 = r[4];
t1 = 1.;
for (i = 0; i < 4; ++i) {
d1 = c * d1 + r[i];
t1 = c * t1 + s[i];
}
/* d2 := sinh(f1)/ nu = sinh(f1)/(f1/f0)
* = f0 * sinh(f1)/f1 */
if (fabs(f1) <= .5) {
f1 *= f1;
d2 = 0.;
for (i = 0; i < 6; ++i) {
d2 = f1 * d2 + t[i];
}
d2 = f0 + f0 * f1 * d2;
} else {
d2 = sinh(f1) / nu;
}
f0 = d2 - nu * d1 / (t1 * p0);
if (ex <= 1e-10) {
/* ---------------------------------------------------------
X <= 1.0E-10
Calculation of K(ALPHA,X) and X*K(ALPHA+1,X)/K(ALPHA,X)
--------------------------------------------------------- */
bk[0] = f0 + ex * f0;
if (*ize == 1) {
bk[0] -= ex * bk[0];
}
ratio = p0 / f0;
c = ex * DBL_MAX;
if (k != 0) {
/* ---------------------------------------------------
Calculation of K(ALPHA,X)
and X*K(ALPHA+1,X)/K(ALPHA,X), ALPHA >= 1/2
--------------------------------------------------- */
*ncalc = -1;
if (bk[0] >= c / ratio) {
return;
}
bk[0] = ratio * bk[0] / ex;
twonu += 2.;
ratio = twonu;
}
*ncalc = 1;
if (*nb == 1)
return;
/* -----------------------------------------------------
Calculate K(ALPHA+L,X)/K(ALPHA+L-1,X),
L = 1, 2, ... , NB-1
----------------------------------------------------- */
*ncalc = -1;
for (i = 1; i < *nb; ++i) {
if (ratio >= c)
return;
bk[i] = ratio / ex;
twonu += 2.;
ratio = twonu;
}
*ncalc = 1;
goto L420;
} else {
/* ------------------------------------------------------
10^-10 < X <= 1.0
------------------------------------------------------ */
c = 1.;
x2by4 = ex * ex / 4.;
p0 = .5 * p0;
q0 = .5 * q0;
d1 = -1.;
d2 = 0.;
bk1 = 0.;
bk2 = 0.;
f1 = f0;
f2 = p0;
do {
d1 += 2.;
d2 += 1.;
d3 = d1 + d3;
c = x2by4 * c / d2;
f0 = (d2 * f0 + p0 + q0) / d3;
p0 /= d2 - nu;
q0 /= d2 + nu;
t1 = c * f0;
t2 = c * (p0 - d2 * f0);
bk1 += t1;
bk2 += t2;
} while (fabs(t1 / (f1 + bk1)) > DBL_EPSILON ||
fabs(t2 / (f2 + bk2)) > DBL_EPSILON);
bk1 = f1 + bk1;
bk2 = 2. * (f2 + bk2) / ex;
if (*ize == 2) {
d1 = exp(ex);
bk1 *= d1;
bk2 *= d1;
}
wminf = estf[0] * ex + estf[1];
}
} else if (DBL_EPSILON * ex > 1.) {
/* -------------------------------------------------
X > 1./EPS
------------------------------------------------- */
*ncalc = *nb;
bk1 = 1. / (M_SQRT_2dPI * sqrt(ex));
for (i = 0; i < *nb; ++i)
bk[i] = bk1;
return;
} else {
/* -------------------------------------------------------
X > 1.0
------------------------------------------------------- */
twox = ex + ex;
blpha = 0.;
ratio = 0.;
if (ex <= 4.) {
/* ----------------------------------------------------------
Calculation of K(ALPHA+1,X)/K(ALPHA,X), 1.0 <= X <= 4.0
----------------------------------------------------------*/
d2 = ftrunc(estm[0] / ex + estm[1]);
m = (long) d2;
d1 = d2 + d2;
d2 -= .5;
d2 *= d2;
for (i = 2; i <= m; ++i) {
d1 -= 2.;
d2 -= d1;
ratio = (d3 + d2) / (twox + d1 - ratio);
}
/* -----------------------------------------------------------
Calculation of I(|ALPHA|,X) and I(|ALPHA|+1,X) by backward
recurrence and K(ALPHA,X) from the wronskian
-----------------------------------------------------------*/
d2 = ftrunc(estm[2] * ex + estm[3]);
m = (long) d2;
c = fabs(nu);
d3 = c + c;
d1 = d3 - 1.;
f1 = DBL_MIN;
f0 = (2. * (c + d2) / ex + .5 * ex / (c + d2 + 1.)) * DBL_MIN;
for (i = 3; i <= m; ++i) {
d2 -= 1.;
f2 = (d3 + d2 + d2) * f0;
blpha = (1. + d1 / d2) * (f2 + blpha);
f2 = f2 / ex + f1;
f1 = f0;
f0 = f2;
}
f1 = (d3 + 2.) * f0 / ex + f1;
d1 = 0.;
t1 = 1.;
for (i = 1; i <= 7; ++i) {
d1 = c * d1 + p[i - 1];
t1 = c * t1 + q[i - 1];
}
p0 = exp(c * (a + c * (p[7] - c * d1 / t1) - log(ex))) / ex;
f2 = (c + .5 - ratio) * f1 / ex;
bk1 = p0 + (d3 * f0 - f2 + f0 + blpha) / (f2 + f1 + f0) * p0;
if (*ize == 1) {
bk1 *= exp(-ex);
}
wminf = estf[2] * ex + estf[3];
} else {
/* ---------------------------------------------------------
Calculation of K(ALPHA,X) and K(ALPHA+1,X)/K(ALPHA,X), by
backward recurrence, for X > 4.0
----------------------------------------------------------*/
dm = ftrunc(estm[4] / ex + estm[5]);
m = (long) dm;
d2 = dm - .5;
d2 *= d2;
d1 = dm + dm;
for (i = 2; i <= m; ++i) {
dm -= 1.;
d1 -= 2.;
d2 -= d1;
ratio = (d3 + d2) / (twox + d1 - ratio);
blpha = (ratio + ratio * blpha) / dm;
}
bk1 = 1. / ((M_SQRT_2dPI + M_SQRT_2dPI * blpha) * sqrt(ex));
if (*ize == 1)
bk1 *= exp(-ex);
wminf = estf[4] * (ex - fabs(ex - estf[6])) + estf[5];
}
/* ---------------------------------------------------------
Calculation of K(ALPHA+1,X)
from K(ALPHA,X) and K(ALPHA+1,X)/K(ALPHA,X)
--------------------------------------------------------- */
bk2 = bk1 + bk1 * (nu + .5 - ratio) / ex;
}
/*--------------------------------------------------------------------
Calculation of 'NCALC', K(ALPHA+I,X), I = 0, 1, ... , NCALC-1,
& K(ALPHA+I,X)/K(ALPHA+I-1,X), I = NCALC, NCALC+1, ... , NB-1
-------------------------------------------------------------------*/
*ncalc = *nb;
bk[0] = bk1;
if (iend == 0)
return;
j = 1 - k;
if (j >= 0)
bk[j] = bk2;
if (iend == 1)
return;
m = min0((long) (wminf - nu),iend);
for (i = 2; i <= m; ++i) {
t1 = bk1;
bk1 = bk2;
twonu += 2.;
if (ex < 1.) {
if (bk1 >= DBL_MAX / twonu * ex)
break;
} else {
if (bk1 / ex >= DBL_MAX / twonu)
break;
}
bk2 = twonu / ex * bk1 + t1;
ii = i;
++j;
if (j >= 0) {
bk[j] = bk2;
}
}
m = ii;
if (m == iend) {
return;
}
ratio = bk2 / bk1;
mplus1 = m + 1;
*ncalc = -1;
for (i = mplus1; i <= iend; ++i) {
twonu += 2.;
ratio = twonu / ex + 1./ratio;
++j;
if (j >= 1) {
bk[j] = ratio;
} else {
if (bk2 >= DBL_MAX / ratio)
return;
bk2 *= ratio;
}
}
*ncalc = max0(1, mplus1 - k);
if (*ncalc == 1)
bk[0] = bk2;
if (*nb == 1)
return;
L420:
for (i = *ncalc; i < *nb; ++i) { /* i == *ncalc */
#ifndef IEEE_754
if (bk[i-1] >= DBL_MAX / bk[i])
return;
#endif
bk[i] *= bk[i-1];
(*ncalc)++;
}
}
}
int add_icon_app(char *name, int save)
{
struct _icons_spec_app *tmp_icon=NULL;
char *mono_mask, *mono_data, *col_mask, *col_data;
CICONBLK *icon=NULL;
if(icons_spec_app==NULL)
tmp_icon = icons_spec_app = calloc(1,sizeof(struct _icons_spec_app));
else
{
tmp_icon = calloc(1,sizeof(struct _icons_spec_app)*(icons_spec_app->no+1L));
memcpy(tmp_icon, icons_spec_app, sizeof(struct _icons_spec_app) * icons_spec_app->no);
free(icons_spec_app);
icons_spec_app = tmp_icon;
tmp_icon = &icons_spec_app[icons_spec_app->no];
}
memset(tmp_icon, 0, sizeof(struct _icons_spec_app));
tmp_icon->name = calloc(1,strlen(name)+1L);
memset(tmp_icon->name, 0, strlen(name)+1);
strcpy(tmp_icon->name, name);
icons_app.how_many++;
if(options.stic && stic)
{
OBJECT *tmp=NULL;
int i=(int)strlen(name);
for(; i>0, name[i]!='\\'; i--)
;
tmp = stic->str_icon(&name[++i], STIC_SMALL);
if(tmp)
icon = (CICONBLK*)(tmp->ob_spec.ciconblk);
else
{
tmp = stic->str_icon("*.APP", STIC_SMALL|DEFAULT_APP);
if(tmp)
icon = (CICONBLK*)(tmp->ob_spec.ciconblk);
else
{
tmp_icon->obj_no = dialog(mini_icons, 1);
icon = (CICONBLK*)(mini_icons[tmp_icon->obj_no].ob_spec.ciconblk);
}
}
}
else if(mini_icons!=NULL)
{
tmp_icon->obj_no = dialog(mini_icons, 1);
icon = (CICONBLK*)(mini_icons[tmp_icon->obj_no].ob_spec.ciconblk);
}
mono_data = (char*)icon->monoblk.ib_pdata;
mono_mask = (char*)icon->monoblk.ib_pmask;
col_data = (char*)icon->mainlist->col_data;
col_mask = (char*)icon->mainlist->col_mask;
if(add_icon((void *)icons_spec_app, APP_TRAY, icons_app.how_many, mono_data, mono_mask, col_data, col_mask)==0)
return(0);
fix_width();
move_applications(1);
_redraw_.type |= RED_ICON_APP;
_redraw_.x = min0(_redraw_.x, bigbutton[SEPARATOR_1].ob_x);
_redraw_.y = min0(_redraw_.y, bigbutton->ob_y);
_redraw_.w = min0(_redraw_.w, bigbutton[SEPARATOR_2].ob_x+10);
_redraw_.h = min0(_redraw_.h, bigbutton->ob_height);
SendAV(ap_id, WM_REDRAW, ap_id, RED_ICON, MyTask.whandle, bigbutton[SEPARATOR_1].ob_x, bigbutton->ob_y, bigbutton[SEPARATOR_2].ob_x+10, bigbutton->ob_height);
if(save==1)
save_app_icon();
return(1);
}
static void J_bessel(double *x, double *alpha, int *nb,
double *b, int *ncalc)
{
/*
Calculates Bessel functions J_{n+alpha} (x)
for non-negative argument x, and non-negative order n+alpha, n = 0,1,..,nb-1.
Explanation of variables in the calling sequence.
X - Non-negative argument for which J's are to be calculated.
ALPHA - Fractional part of order for which
J's are to be calculated. 0 <= ALPHA < 1.
NB - Number of functions to be calculated, NB >= 1.
The first function calculated is of order ALPHA, and the
last is of order (NB - 1 + ALPHA).
B - Output vector of length NB. If RJBESL
terminates normally (NCALC=NB), the vector B contains the
functions J/ALPHA/(X) through J/NB-1+ALPHA/(X).
NCALC - Output variable indicating possible errors.
Before using the vector B, the user should check that
NCALC=NB, i.e., all orders have been calculated to
the desired accuracy. See the following
****************************************************************
Error return codes
In case of an error, NCALC != NB, and not all J's are
calculated to the desired accuracy.
NCALC < 0: An argument is out of range. For example,
NBES <= 0, ALPHA < 0 or > 1, or X is too large.
In this case, b[1] is set to zero, the remainder of the
B-vector is not calculated, and NCALC is set to
MIN(NB,0)-1 so that NCALC != NB.
NB > NCALC > 0: Not all requested function values could
be calculated accurately. This usually occurs because NB is
much larger than ABS(X). In this case, b[N] is calculated
to the desired accuracy for N <= NCALC, but precision
is lost for NCALC < N <= NB. If b[N] does not vanish
for N > NCALC (because it is too small to be represented),
and b[N]/b[NCALC] = 10^(-K), then only the first NSIG - K
significant figures of b[N] can be trusted.
Acknowledgement
This program is based on a program written by David J. Sookne
(2) that computes values of the Bessel functions J or I of float
argument and long order. Modifications include the restriction
of the computation to the J Bessel function of non-negative float
argument, the extension of the computation to arbitrary positive
order, and the elimination of most underflow.
References:
Olver, F.W.J., and Sookne, D.J. (1972)
"A Note on Backward Recurrence Algorithms";
Math. Comp. 26, 941-947.
Sookne, D.J. (1973)
"Bessel Functions of Real Argument and Integer Order";
NBS Jour. of Res. B. 77B, 125-132.
Latest modification: March 19, 1990
Author: W. J. Cody
Applied Mathematics Division
Argonne National Laboratory
Argonne, IL 60439
*******************************************************************
*/
/* ---------------------------------------------------------------------
Mathematical constants
PI2 = 2 / PI
TWOPI1 = first few significant digits of 2 * PI
TWOPI2 = (2*PI - TWOPI1) to working precision, i.e.,
TWOPI1 + TWOPI2 = 2 * PI to extra precision.
--------------------------------------------------------------------- */
const static double pi2 = .636619772367581343075535;
const static double twopi1 = 6.28125;
const static double twopi2 = .001935307179586476925286767;
/*---------------------------------------------------------------------
* Factorial(N)
*--------------------------------------------------------------------- */
const static double fact[25] = { 1.,1.,2.,6.,24.,120.,720.,5040.,40320.,
362880.,3628800.,39916800.,479001600.,6227020800.,87178291200.,
1.307674368e12,2.0922789888e13,3.55687428096e14,6.402373705728e15,
1.21645100408832e17,2.43290200817664e18,5.109094217170944e19,
1.12400072777760768e21,2.585201673888497664e22,
6.2044840173323943936e23 };
/* Local variables */
int nend, intx, nbmx, i, j, k, l, m, n, nstart;
double nu, twonu, capp, capq, pold, vcos, test, vsin;
double p, s, t, z, alpem, halfx, aa, bb, cc, psave, plast;
double tover, t1, alp2em, em, en, xc, xk, xm, psavel, gnu, xin, sum;
/* Parameter adjustment */
--b;
nu = *alpha;
twonu = nu + nu;
/*-------------------------------------------------------------------
Check for out of range arguments.
-------------------------------------------------------------------*/
if (*nb > 0 && *x >= 0. && 0. <= nu && nu < 1.) {
*ncalc = *nb;
if(*x > xlrg_BESS_IJ) {
ML_ERROR(ME_RANGE, "J_bessel");
/* indeed, the limit is 0,
* but the cutoff happens too early */
for(i=1; i <= *nb; i++)
b[i] = 0.; /*was ML_POSINF (really nonsense) */
return;
}
intx = (int) (*x);
/* Initialize result array to zero. */
for (i = 1; i <= *nb; ++i)
b[i] = 0.;
/*===================================================================
Branch into 3 cases :
1) use 2-term ascending series for small X
2) use asymptotic form for large X when NB is not too large
3) use recursion otherwise
===================================================================*/
if (*x < rtnsig_BESS) {
/* ---------------------------------------------------------------
Two-term ascending series for small X.
--------------------------------------------------------------- */
alpem = 1. + nu;
halfx = (*x > enmten_BESS) ? .5 * *x : 0.;
aa = (nu != 0.) ? pow(halfx, nu) / (nu * Rf_gamma_cody(nu)) : 1.;
bb = (*x + 1. > 1.)? -halfx * halfx : 0.;
b[1] = aa + aa * bb / alpem;
if (*x != 0. && b[1] == 0.)
*ncalc = 0;
if (*nb != 1) {
if (*x <= 0.) {
for (n = 2; n <= *nb; ++n)
b[n] = 0.;
}
else {
/* ----------------------------------------------
Calculate higher order functions.
---------------------------------------------- */
if (bb == 0.)
tover = (enmten_BESS + enmten_BESS) / *x;
else
tover = enmten_BESS / bb;
cc = halfx;
for (n = 2; n <= *nb; ++n) {
aa /= alpem;
alpem += 1.;
aa *= cc;
if (aa <= tover * alpem)
aa = 0.;
b[n] = aa + aa * bb / alpem;
if (b[n] == 0. && *ncalc > n)
*ncalc = n - 1;
}
}
}
} else if (*x > 25. && *nb <= intx + 1) {
/* ------------------------------------------------------------
Asymptotic series for X > 25 (and not too large nb)
------------------------------------------------------------ */
xc = sqrt(pi2 / *x);
xin = 1 / (64 * *x * *x);
if (*x >= 130.) m = 4;
else if (*x >= 35.) m = 8;
else m = 11;
xm = 4. * (double) m;
/* ------------------------------------------------
Argument reduction for SIN and COS routines.
------------------------------------------------ */
t = trunc(*x / (twopi1 + twopi2) + .5);
z = (*x - t * twopi1) - t * twopi2 - (nu + .5) / pi2;
vsin = sin(z);
vcos = cos(z);
gnu = twonu;
for (i = 1; i <= 2; ++i) {
s = (xm - 1. - gnu) * (xm - 1. + gnu) * xin * .5;
t = (gnu - (xm - 3.)) * (gnu + (xm - 3.));
t1= (gnu - (xm + 1.)) * (gnu + (xm + 1.));
k = m + m;
capp = s * t / fact[k];
capq = s * t1/ fact[k + 1];
xk = xm;
for (; k >= 4; k -= 2) {/* k + 2(j-2) == 2m */
xk -= 4.;
s = (xk - 1. - gnu) * (xk - 1. + gnu);
t1 = t;
t = (gnu - (xk - 3.)) * (gnu + (xk - 3.));
capp = (capp + 1. / fact[k - 2]) * s * t * xin;
capq = (capq + 1. / fact[k - 1]) * s * t1 * xin;
}
capp += 1.;
capq = (capq + 1.) * (gnu * gnu - 1.) * (.125 / *x);
b[i] = xc * (capp * vcos - capq * vsin);
if (*nb == 1)
return;
/* vsin <--> vcos */ t = vsin; vsin = -vcos; vcos = t;
gnu += 2.;
}
/* -----------------------------------------------
If NB > 2, compute J(X,ORDER+I) for I = 2, NB-1
----------------------------------------------- */
if (*nb > 2)
for (gnu = twonu + 2., j = 3; j <= *nb; j++, gnu += 2.)
b[j] = gnu * b[j - 1] / *x - b[j - 2];
}
else {
/* rtnsig_BESS <= x && ( x <= 25 || intx+1 < *nb ) :
--------------------------------------------------------
Use recurrence to generate results.
First initialize the calculation of P*S.
-------------------------------------------------------- */
nbmx = *nb - intx;
n = intx + 1;
en = (double)(n + n) + twonu;
plast = 1.;
p = en / *x;
/* ---------------------------------------------------
Calculate general significance test.
--------------------------------------------------- */
test = ensig_BESS + ensig_BESS;
if (nbmx >= 3) {
/* ------------------------------------------------------------
Calculate P*S until N = NB-1. Check for possible overflow.
---------------------------------------------------------- */
tover = enten_BESS / ensig_BESS;
nstart = intx + 2;
nend = *nb - 1;
en = (double) (nstart + nstart) - 2. + twonu;
for (k = nstart; k <= nend; ++k) {
n = k;
en += 2.;
pold = plast;
plast = p;
p = en * plast / *x - pold;
if (p > tover) {
/* -------------------------------------------
To avoid overflow, divide P*S by TOVER.
Calculate P*S until ABS(P) > 1.
-------------------------------------------*/
tover = enten_BESS;
p /= tover;
plast /= tover;
psave = p;
psavel = plast;
nstart = n + 1;
do {
++n;
en += 2.;
pold = plast;
plast = p;
p = en * plast / *x - pold;
} while (p <= 1.);
bb = en / *x;
/* -----------------------------------------------
Calculate backward test and find NCALC,
the highest N such that the test is passed.
----------------------------------------------- */
test = pold * plast * (.5 - .5 / (bb * bb));
test /= ensig_BESS;
p = plast * tover;
--n;
en -= 2.;
nend = min0(*nb,n);
for (l = nstart; l <= nend; ++l) {
pold = psavel;
psavel = psave;
psave = en * psavel / *x - pold;
if (psave * psavel > test) {
*ncalc = l - 1;
goto L190;
}
}
*ncalc = nend;
goto L190;
}
}
n = nend;
en = (double) (n + n) + twonu;
/* -----------------------------------------------------
Calculate special significance test for NBMX > 2.
-----------------------------------------------------*/
test = fmax2(test, sqrt(plast * ensig_BESS) * sqrt(p + p));
}
/* ------------------------------------------------
Calculate P*S until significance test passes. */
do {
++n;
en += 2.;
pold = plast;
plast = p;
p = en * plast / *x - pold;
} while (p < test);
L190:
/*---------------------------------------------------------------
Initialize the backward recursion and the normalization sum.
--------------------------------------------------------------- */
++n;
en += 2.;
bb = 0.;
aa = 1. / p;
m = n / 2;
em = (double)m;
m = (n << 1) - (m << 2);/* = 2 n - 4 (n/2)
= 0 for even, 2 for odd n */
if (m == 0)
sum = 0.;
else {
alpem = em - 1. + nu;
alp2em = em + em + nu;
sum = aa * alpem * alp2em / em;
}
nend = n - *nb;
/* if (nend > 0) */
/* --------------------------------------------------------
Recur backward via difference equation, calculating
(but not storing) b[N], until N = NB.
-------------------------------------------------------- */
for (l = 1; l <= nend; ++l) {
--n;
en -= 2.;
cc = bb;
bb = aa;
aa = en * bb / *x - cc;
m = m ? 0 : 2; /* m = 2 - m failed on gcc4-20041019 */
if (m != 0) {
em -= 1.;
alp2em = em + em + nu;
if (n == 1)
break;
alpem = em - 1. + nu;
if (alpem == 0.)
alpem = 1.;
sum = (sum + aa * alp2em) * alpem / em;
}
}
/*--------------------------------------------------
Store b[NB].
--------------------------------------------------*/
b[n] = aa;
if (nend >= 0) {
if (*nb <= 1) {
if (nu + 1. == 1.)
alp2em = 1.;
else
alp2em = nu;
sum += b[1] * alp2em;
goto L250;
}
else {/*-- nb >= 2 : ---------------------------
Calculate and store b[NB-1].
----------------------------------------*/
--n;
en -= 2.;
b[n] = en * aa / *x - bb;
if (n == 1)
goto L240;
m = m ? 0 : 2; /* m = 2 - m failed on gcc4-20041019 */
if (m != 0) {
em -= 1.;
alp2em = em + em + nu;
alpem = em - 1. + nu;
if (alpem == 0.)
alpem = 1.;
sum = (sum + b[n] * alp2em) * alpem / em;
}
}
}
/* if (n - 2 != 0) */
/* --------------------------------------------------------
Calculate via difference equation and store b[N],
until N = 2.
-------------------------------------------------------- */
for (n = n-1; n >= 2; n--) {
en -= 2.;
b[n] = en * b[n + 1] / *x - b[n + 2];
m = m ? 0 : 2; /* m = 2 - m failed on gcc4-20041019 */
if (m != 0) {
em -= 1.;
alp2em = em + em + nu;
alpem = em - 1. + nu;
if (alpem == 0.)
alpem = 1.;
sum = (sum + b[n] * alp2em) * alpem / em;
}
}
/* ---------------------------------------
Calculate b[1].
-----------------------------------------*/
b[1] = 2. * (nu + 1.) * b[2] / *x - b[3];
L240:
em -= 1.;
alp2em = em + em + nu;
if (alp2em == 0.)
alp2em = 1.;
sum += b[1] * alp2em;
L250:
/* ---------------------------------------------------
Normalize. Divide all b[N] by sum.
---------------------------------------------------*/
/* if (nu + 1. != 1.) poor test */
if(fabs(nu) > 1e-15)
sum *= (Rf_gamma_cody(nu) * pow(.5* *x, -nu));
aa = enmten_BESS;
if (sum > 1.)
aa *= sum;
for (n = 1; n <= *nb; ++n) {
if (fabs(b[n]) < aa)
b[n] = 0.;
else
b[n] /= sum;
}
}
}
else {
/* Error return -- X, NB, or ALPHA is out of range : */
b[1] = 0.;
*ncalc = min0(*nb,0) - 1;
}
}
