int sbig_ccd_set_partial_frame (sbig_ccd_t *ccd, double part)
{
int ro_index = lookup_roinfo (ccd, ccd->readout_mode);
double top, left;
ccd->height = cfe (ccd->info0.readoutInfo[ro_index].height, part, &top);
ccd->top = top;
ccd->width = cfe (ccd->info0.readoutInfo[ro_index].width, part, &left);
ccd->left = left;
if (ccd->color_bayer)
align_bayer_matrix (ccd);
realloc_frame (ccd);
return CE_NO_ERROR;
}
double qfc(double* lb1, double* nc1, int* n1, int *r1in, double *sigmain,
double *c1in, int *lim1in, double *accin, double* trace, int* ifault)
/* distribution function of a linear combination of non-central
chi-squared random variables :
input:
lb[j] coefficient of j-th chi-squared variable
nc[j] non-centrality parameter
n[j] degrees of freedom
j = 0, 2 ... r-1
sigma coefficient of standard normal variable
c point at which df is to be evaluated
lim maximum number of terms in integration
acc maximum error
output:
ifault = 1 required accuracy NOT achieved
2 round-off error possibly significant
3 invalid parameters
4 unable to locate integration parameters
5 out of memory
trace[0] absolute sum
trace[1] total number of integration terms
trace[2] number of integrations
trace[3] integration interval in final integration
trace[4] truncation point in initial integration
trace[5] s.d. of initial convergence factor
trace[6] cycles to locate integration parameters */
{
int r1 = r1in[0], lim1 = lim1in[0];
double sigma = sigmain[0], c1 = c1in[0], acc = accin[0];
int j, nj, nt, ntm; double acc1, almx, xlim, xnt, xntm;
double utx, tausq, sd, intv, intv1, x, up, un, d1, d2, lj, ncj;
double qfval = 0;
static int rats[]={1,2,4,8};
if (setjmp(env) != 0) { *ifault=4; goto endofproc; }
r=r1; lim=lim1; c=c1;
n=n1; lb=lb1; nc=nc1;
for ( j = 0; j<7; j++ ) trace[j] = 0.0;
*ifault = 0; count = 0;
intl = 0.0; ersm = 0.0;
qfval = -1.0; acc1 = acc; ndtsrt = TRUE; fail = FALSE;
xlim = (double)lim;
th=(int*)malloc(r*(sizeof(int)));
if (! th) { *ifault=5; goto endofproc; }
/* find mean, sd, max and min of lb,
check that parameter values are valid */
sigsq = square(sigma); sd = sigsq;
lmax = 0.0; lmin = 0.0; mean = 0.0;
for (j=0; j<r; j++ )
{
nj = n[j]; lj = lb[j]; ncj = nc[j];
if ( nj < 0 || ncj < 0.0 ) { *ifault = 3; goto endofproc; }
sd = sd + square(lj) * (2 * nj + 4.0 * ncj);
mean = mean + lj * (nj + ncj);
if (lmax < lj) lmax = lj ; else if (lmin > lj) lmin = lj;
}
if ( sd == 0.0 )
{ qfval = (c > 0.0) ? 1.0 : 0.0; goto endofproc; }
if ( lmin == 0.0 && lmax == 0.0 && sigma == 0.0 )
{ *ifault = 3; goto endofproc; }
sd = sqrt(sd);
almx = (lmax < - lmin) ? - lmin : lmax;
/* starting values for findu, ctff */
utx = 16.0 / sd; up = 4.5 / sd; un = - up;
/* truncation point with no convergence factor */
findu(&utx, .5 * acc1);
/* does convergence factor help */
if (c != 0.0 && (almx > 0.07 * sd))
{
tausq = .25 * acc1 / cfe(c);
if (fail) fail = FALSE ;
else if (truncation(utx, tausq) < .2 * acc1)
{
sigsq = sigsq + tausq;
findu(&utx, .25 * acc1);
trace[5] = sqrt(tausq);
}
}
trace[4] = utx; acc1 = 0.5 * acc1;
/* find RANGE of distribution, quit if outside this */
l1:
d1 = ctff(acc1, &up) - c;
if (d1 < 0.0) { qfval = 1.0; goto endofproc; }
d2 = c - ctff(acc1, &un);
if (d2 < 0.0) { qfval = 0.0; goto endofproc; }
/* find integration interval */
intv = 2.0 * pi / ((d1 > d2) ? d1 : d2);
/* calculate number of terms required for main and
auxillary integrations */
xnt = utx / intv; xntm = 3.0 / sqrt(acc1);
if (xnt > xntm * 1.5)
{
/* parameters for auxillary integration */
if (xntm > xlim) { *ifault = 1; goto endofproc; }
ntm = (int)floor(xntm+0.5);
intv1 = utx / ntm; x = 2.0 * pi / intv1;
if (x <= fabs(c)) goto l2;
/* calculate convergence factor */
tausq = .33 * acc1 / (1.1 * (cfe(c - x) + cfe(c + x)));
if (fail) goto l2;
acc1 = .67 * acc1;
/* auxillary integration */
integrate(ntm, intv1, tausq, FALSE );
xlim = xlim - xntm; sigsq = sigsq + tausq;
trace[2] = trace[2] + 1; trace[1] = trace[1] + ntm + 1;
/* find truncation point with new convergence factor */
findu(&utx, .25 * acc1); acc1 = 0.75 * acc1;
goto l1;
}
/* main integration */
l2:
trace[3] = intv;
if (xnt > xlim) { *ifault = 1; goto endofproc; }
nt = (int)floor(xnt+0.5);
integrate(nt, intv, 0.0, TRUE );
trace[2] = trace[2] + 1; trace[1] = trace[1] + nt + 1;
qfval = 0.5 - intl;
trace[0] = ersm;
/* test whether round-off error could be significant
allow for radix 8 or 16 machines */
up=ersm; x = up + acc / 10.0;
for (j=0;j<4;j++) { if (rats[j] * x == rats[j] * up) *ifault = 2; }
endofproc :
free((char*)th);
trace[6] = (double)count;
return qfval;
}
