/*
* Recalling a stored split time and converting it for display
*/
static void recall_memory(int index) {
decNumber memory, s, hms;
unsigned long previous;
int sign;
StopWatchMemoryFirstDigit=-1;
RclMemory=index;
StopWatchStatus.rcl_mode=0;
StopWatchStatus.sigma_display_mode=0;
RclMemoryRemanentDisplay=0;
getRegister(&memory, index);
// Converting HMS format to tick count
decNumberHMS2HR(&hms, &memory);
dn_multiply(&s, &hms, &const_36000);
previous=(unsigned long) dn_to_ull(&s, &sign);
FirstTicker=getTicker()-previous;
StopWatch=previous;
}
// a = a + b * k -- generalised matrix add and subtract
decNumber *matrix_genadd(decNumber *r, const decNumber *k, const decNumber *b, const decNumber *a) {
int arows, acols, brows, bcols;
decNumber s, t, u;
int i;
decimal64 *abase = matrix_decomp(a, &arows, &acols);
decimal64 *bbase = matrix_decomp(b, &brows, &bcols);
if (abase == NULL || bbase == NULL)
return NULL;
if (arows != brows || acols != bcols) {
err(ERR_MATRIX_DIM);
return NULL;
}
for (i=0; i<arows*acols; i++) {
decimal64ToNumber(bbase + i, &s);
dn_multiply(&t, &s, k);
decimal64ToNumber(abase + i, &s);
dn_add(&u, &t, &s);
packed_from_number(abase + i, &u);
}
return decNumberCopy(r, a);
}
// DN(a + i b, c + i d) = dn(u, k) . cn(v, ki) . dn(v, ki) / denom
// - i . k^2 . sn(u, k) . cn(u, k) . sn(v, ki) / denom
// where
// denom = 1 - dn(u, k)^2 * sn(v, ki)^2
void cmplxDN(decNumber *rx, decNumber *ry,
const decNumber *u, const decNumber *v,
const decNumber *k, const decNumber *ki) {
decNumber denom, snuk, cnuk, dnuk, snvki, cnvki, dnvki;
decNumber a, b;
elliptic_setup(&denom, &snuk, &cnuk, &dnuk,
&snvki, &cnvki, &dnvki,
u, v, k, ki);
dn_multiply(&a, &dnuk, &cnvki);
dn_multiply(&b, &a, &dnvki);
dn_multiply(rx, &b, &denom);
decNumberSquare(&a, k);
dn_minus(&b, &a);
dn_multiply(&a, &b, &snuk);
dn_multiply(&b, &a, &cnuk);
dn_multiply(&a, &b, &snvki);
dn_multiply(ry, &a, &denom);
}
void dn_elliptic(decNumber *sn, decNumber *cn, decNumber *dn, const decNumber *u, const decNumber *m) {
decNumber a, b, e, f, g;
decNumber s_n, c_n, d_n;
decNumber MU[ELLIPTIC_N], NU[ELLIPTIC_N], C[ELLIPTIC_N], D[ELLIPTIC_N];
decNumber sin_umu, cos_umu, t, r;
int n = 0;
#define mu(n) (MU + (n))
#define nu(n) (NU + (n))
#define c(n) (C + (n))
#define d(n) (D + (n))
if (sn == NULL) sn = &s_n;
if (cn == NULL) cn = &c_n;
if (dn == NULL) dn = &d_n;
dn_abs(&a, m);
if (dn_lt(&const_1, &a)) {
cmplx_NaN(sn, cn);
set_NaN(dn);
return;
}
if (dn_lt(&a, &const_1e_32)) {
dn_sincos(u, sn, cn);
dn_1(dn);
return;
}
dn_m1(&a, m);
if (dn_abs_lt(&a, &const_1e_32)) {
dn_sinhcosh(u, &a, &b);
decNumberRecip(cn, &b);
dn_multiply(sn, &a, cn);
decNumberCopy(dn, cn);
return;
}
dn_1(mu(0));
dn_1m(&a, m);
dn_sqrt(nu(0), &a);
for (;;) {
dn_add(&g, mu(n), nu(n));
dn_abs(&a, &g);
dn_mulpow10(&b, &a, 32);
dn_mul2(&a, &b);
dn_subtract(&e, mu(n), nu(n));
dn_abs(&f, &e);
if (dn_gt(&a, &f))
break;
dn_div2(mu(n+1), &g);
dn_multiply(&a, mu(n), nu(n));
dn_sqrt(nu(n+1), &a);
n++;
if (n >= ELLIPTIC_N-1)
break;
}
dn_multiply(&a, u, mu(n));
dn_sincos(&a, &sin_umu, &cos_umu);
if (dn_abs_lt(&sin_umu, dn_abs(&b, &cos_umu)))
dn_divide(&t, &sin_umu, &cos_umu);
else
dn_divide(&t, &cos_umu, &sin_umu);
dn_multiply(c(n), mu(n), &t);
dn_1(d(n));
while (n > 0) {
n--;
dn_multiply(c(n), d(n+1), c(n+1));
decNumberSquare(&a, c(n+1));
dn_divide(&r, &a, mu(n+1));
dn_add(&a, &r, nu(n));
dn_add(&b, &r, mu(n));
dn_divide(d(n), &a, &b);
}
cmplxAbs(&f, &b, &const_1, c(0));
if (decNumberIsNegative(&e)) {
dn_1m(&a, m);
dn_sqrt(&g, &a);
dn_divide(dn, &g, d(0));
dn_divide(cn, dn, &f);
if (decNumberIsNegative(&cos_umu))
dn_minus(cn, cn);
dn_divide(&a, c(0), &g);
dn_multiply(sn, cn, &a);
} else {
decNumberCopy(dn, d(0));
dn_divide(sn, &const_1, &f);
if (decNumberIsNegative(&sin_umu))
dn_minus(sn, sn);
dn_multiply(cn, c(0), sn);
}
#undef mu
#undef nu
#undef c
#undef d
}
/* Smart CDF helper routine that return three values */
void cdf_Q_helper(enum nilop op) {
decNumber a, b, t, u, x2, d, absx, x;
int i;
getX(&x);
dn_abs(&absx, &x);
if (dn_lt(&absx, &const_2_326)) {
decNumberSquare(&x2, &absx);
decNumberCopy(&t, &absx);
decNumberCopy(&a, &absx);
decNumberCopy(&d, &const_3);
for (i=0;i<500; i++) {
dn_multiply(&u, &t, &x2);
dn_divide(&t, &u, &d);
dn_add(&u, &a, &t);
if (dn_eq(&u, &a))
break;
decNumberCopy(&a, &u);
dn_p2(&d, &d);
}
decNumberCopy(&b, &const_0_5);
if (decNumberIsNegative(&x))
dn_minus(&a, &a);
} else {
const decNumber *nom, *extra, *sub;
//dn_minus(&x2, &absx);
//n = ceil(extra + nom / (|x| - sub))
if (is_usrdblmode()) {
sub = &const_1_5;
nom = &const_300;
extra = &const_8;
}
else {
sub = &const_1_3;
nom = &const_100;
extra = &const_4;
}
dn_subtract(&b, &absx, sub);
dn_divide(&t, nom, &b);
dn_add(&u, &t, extra);
decNumberCeil(&b, &u);
decNumberZero(&t);
do {
dn_add(&u, &x, &t);
dn_divide(&t, &b, &u);
dn_dec(&b);
} while (! dn_eq0(&b));
dn_add(&u, &t, &x);
decNumberRecip(&a, &u);
if (decNumberIsNegative(&a)) {
dn_minus(&a, &a);
decNumberZero(&b);
} else {
dn_1(&b);
dn_minus(&a, &a);
}
}
pdf_Q(&t, &x);
setXYZ(&t, &a, &b);
}
/* Perform a LU decomposition of the specified matrix in-situ.
* Return the pivot rows in pivots if not null and return the parity
* of the number of pivots or zero if the matrix is singular
*/
static int LU_decomposition(decimal128 *A, unsigned char *pivots, const int n) {
int i, j, k;
int pvt, spvt = 1;
decimal128 *p1, *p2;
decNumber max, t, u;
busy();
for (k=0; k<n; k++) {
/* Find the pivot row */
pvt = k;
matrix_get128(&u, A, k, k, n);
dn_abs(&max, &u);
for (j=k+1; j<n; j++) {
matrix_get128(&t, A, j, k, n);
dn_abs(&u, &t);
if (dn_gt(&u, &max)) {
decNumberCopy(&max, &u);
pvt = j;
}
}
if (pivots != NULL)
*pivots++ = pvt;
/* pivot if required */
if (pvt != k) {
spvt = -spvt;
p1 = A + (n * k);
p2 = A + (n * pvt);
for (j=0; j<n; j++) {
decimal128 t = *p1;
*p1 = *p2;
*p2 = t;
p1++;
p2++;
//swap_reg(p1++, p2++);
}
}
/* Check for singular */
matrix_get128(&t, A, k, k, n);
if (dn_eq0(&t))
return 0;
/* Find the lower triangular elements for column k */
for (i=k+1; i<n; i++) {
matrix_get128(&t, A, k, k, n);
matrix_get128(&u, A, i, k, n);
dn_divide(&max, &u, &t);
matrix_put128(&max, A, i, k, n);
}
/* Update the upper triangular elements */
for (i=k+1; i<n; i++)
for (j=k+1; j<n; j++) {
matrix_get128(&t, A, i, k, n);
matrix_get128(&u, A, k, j, n);
dn_multiply(&max, &t, &u);
matrix_get128(&t, A, i, j, n);
dn_subtract(&u, &t, &max);
matrix_put128(&u, A, i, j, n);
}
}
return spvt;
}
