/* psi(z) for large |z| in the right half-plane; [Abramowitz + Stegun, 6.3.18] */
static
gsl_complex
psi_complex_asymp(gsl_complex z)
{
/* coefficients in the asymptotic expansion for large z;
* let w = z^(-2) and write the expression in the form
*
* ln(z) - 1/(2z) - 1/12 w (1 + c1 w + c2 w + c3 w + ... )
*/
static const double c1 = -0.1;
static const double c2 = 1.0/21.0;
static const double c3 = -0.05;
gsl_complex zi = gsl_complex_inverse(z);
gsl_complex w = gsl_complex_mul(zi, zi);
gsl_complex cs;
/* Horner method evaluation of term in parentheses */
gsl_complex sum;
sum = gsl_complex_mul_real(w, c3/c2);
sum = gsl_complex_add_real(sum, 1.0);
sum = gsl_complex_mul_real(sum, c2/c1);
sum = gsl_complex_mul(sum, w);
sum = gsl_complex_add_real(sum, 1.0);
sum = gsl_complex_mul_real(sum, c1);
sum = gsl_complex_mul(sum, w);
sum = gsl_complex_add_real(sum, 1.0);
/* correction added to log(z) */
cs = gsl_complex_mul(sum, w);
cs = gsl_complex_mul_real(cs, -1.0/12.0);
cs = gsl_complex_add(cs, gsl_complex_mul_real(zi, -0.5));
return gsl_complex_add(gsl_complex_log(z), cs);
}
/* NOTE: Assumes z is in fundamental parallelogram */
void wP_and_prime(gsl_complex z, gsl_complex tau, const gsl_complex *g, gsl_complex *p, gsl_complex *pp)
{
int N = 6; /* Enough iterations for good P, not so good P' */
int i;
gsl_complex z0;
gsl_complex z02;
gsl_complex pout, ppout;
gsl_complex ppsolve;
z = near_origin(z,tau);
z0 = gsl_complex_div_real(z,(double)(1 << N));
z02 = gsl_complex_mul(z0,z0);
/* Laurent expansion: P \approx 1/z^2 + (g2/20)z^2 + (g3/28) z^4 */
pout = gsl_complex_add(gsl_complex_inverse(z02),
gsl_complex_add(gsl_complex_mul(z02,gsl_complex_mul_real(g[0],0.05)),
gsl_complex_mul(gsl_complex_mul(z02,z02),gsl_complex_mul_real(g[1],_CONST_1_28))));
/* Laurent expansion: P' \approx -2/z^3 + g2/10z + g3/7 z^3 */
ppout = gsl_complex_add(gsl_complex_mul_real(gsl_complex_inverse(gsl_complex_mul(z0,z02)),-2.0),
gsl_complex_add(gsl_complex_mul(z0,gsl_complex_mul_real(g[0],0.1)),
gsl_complex_mul(gsl_complex_mul(z0,z02),gsl_complex_mul_real(g[1],_CONST_1_7))));
for (i=0;i<N;i++) {
P_and_Pprime_doubler(&pout, &ppout, g);
}
/* At this point ppout is a decent but not great approximation of P'(z) */
/* Instead of using it directly, we use it as a guide for which square root of */
/* (4P^3 - g2 P - g3) should be selected. */
ppsolve = gsl_complex_sqrt(
gsl_complex_sub(
gsl_complex_mul_real(gsl_complex_mul(pout,gsl_complex_mul(pout,pout)),4.0),
gsl_complex_add(gsl_complex_mul(g[0],pout),g[1])
)
);
*p = pout;
if (gsl_complex_abs(gsl_complex_sub(ppsolve,ppout)) < gsl_complex_abs(gsl_complex_add(ppsolve,ppout)))
*pp = ppsolve;
else
*pp = gsl_complex_negative(ppsolve);
}
void
gsl_complex_arccot (complex_t const *a, complex_t *res)
{ /* z = arccot(a) */
if (GSL_REAL (a) == 0.0 && GSL_IMAG (a) == 0.0) {
complex_init (res, M_PI_2gnum, 0);
} else {
gsl_complex_inverse (a, res);
gsl_complex_arctan (res, res);
}
}
/* psi(z) for complex z in the right half-plane */
static int
psi_complex_rhp(
gsl_complex z,
gsl_sf_result * result_re,
gsl_sf_result * result_im
)
{
int n_recurse = 0;
int i;
gsl_complex a;
if(GSL_REAL(z) == 0.0 && GSL_IMAG(z) == 0.0)
{
result_re->val = 0.0;
result_im->val = 0.0;
result_re->err = 0.0;
result_im->err = 0.0;
return GSL_EDOM;
}
/* compute the number of recurrences to apply */
if(GSL_REAL(z) < 20.0 && fabs(GSL_IMAG(z)) < 20.0)
{
const double sp = sqrt(20.0 + GSL_IMAG(z));
const double sn = sqrt(20.0 - GSL_IMAG(z));
const double rhs = sp*sn - GSL_REAL(z);
if(rhs > 0.0) n_recurse = ceil(rhs);
}
/* compute asymptotic at the large value z + n_recurse */
a = psi_complex_asymp(gsl_complex_add_real(z, n_recurse));
result_re->err = 2.0 * GSL_DBL_EPSILON * fabs(GSL_REAL(a));
result_im->err = 2.0 * GSL_DBL_EPSILON * fabs(GSL_IMAG(a));
/* descend recursively, if necessary */
for(i = n_recurse; i >= 1; --i)
{
gsl_complex zn = gsl_complex_add_real(z, i - 1.0);
gsl_complex zn_inverse = gsl_complex_inverse(zn);
a = gsl_complex_sub(a, zn_inverse);
/* accumulate the error, to catch cancellations */
result_re->err += 2.0 * GSL_DBL_EPSILON * fabs(GSL_REAL(zn_inverse));
result_im->err += 2.0 * GSL_DBL_EPSILON * fabs(GSL_IMAG(zn_inverse));
}
result_re->val = GSL_REAL(a);
result_im->val = GSL_IMAG(a);
result_re->err += 2.0 * GSL_DBL_EPSILON * fabs(result_re->val);
result_im->err += 2.0 * GSL_DBL_EPSILON * fabs(result_im->val);
return GSL_SUCCESS;
}
gsl_complex gsl_complex_arccot(gsl_complex a)
{ /* z = arccot(a) */
gsl_complex z;
if (GSL_REAL(a) == 0.0 && GSL_IMAG(a) == 0.0) {
GSL_SET_COMPLEX(&z, M_PI_2, 0);
} else {
z = gsl_complex_inverse(a);
z = gsl_complex_arctan(z);
}
return z;
}
static CMATRIX *_divo(CMATRIX *a, void *b, bool invert)
{
bool complex = COMPLEX(a);
CMATRIX *m;
gsl_complex c;
if (!GB.Is(b, CLASS_Complex))
return NULL;
c = ((CCOMPLEX *)b)->number;
if (invert)
{
void *inv = matrix_invert(MAT(a), complex);
if (!inv)
{
GB.Error(GB_ERR_ZERO);
return NULL;
}
m = MATRIX_create_from(inv, complex);
}
else
{
if (GSL_REAL(c) == 0 && GSL_IMAG(c) == 0)
{
GB.Error(GB_ERR_ZERO);
return NULL;
}
c = gsl_complex_inverse(c);
m = MATRIX_make(a);
}
MATRIX_ensure_complex(m);
gsl_matrix_complex_scale(CMAT(m), c);
return m;
}
gsl_complex
gsl_complex_pow (gsl_complex a, gsl_complex b)
{ /* z=a^b */
gsl_complex z;
if (GSL_REAL (a) == 0 && GSL_IMAG (a) == 0.0)
{
if (GSL_REAL (b) == 0 && GSL_IMAG (b) == 0.0)
{
GSL_SET_COMPLEX (&z, 1.0, 0.0);
}
else
{
GSL_SET_COMPLEX (&z, 0.0, 0.0);
}
}
else if (GSL_REAL (b) == 1.0 && GSL_IMAG (b) == 0.0)
{
return a;
}
else if (GSL_REAL (b) == -1.0 && GSL_IMAG (b) == 0.0)
{
return gsl_complex_inverse (a);
}
else
{
double logr = gsl_complex_logabs (a);
double theta = gsl_complex_arg (a);
double br = GSL_REAL (b), bi = GSL_IMAG (b);
double rho = exp (logr * br - bi * theta);
double beta = theta * br + bi * logr;
GSL_SET_COMPLEX (&z, rho * cos (beta), rho * sin (beta));
}
return z;
}
static CVECTOR *_divo(CVECTOR *a, void *b, bool invert)
{
if (!GB.Is(b, CLASS_Complex))
return NULL;
CCOMPLEX *c = (CCOMPLEX *)b;
if (invert)
return NULL;
if (GSL_REAL(c->number) == 0 && GSL_IMAG(c->number) == 0)
{
GB.Error(GB_ERR_ZERO);
return NULL;
}
CVECTOR *v = VECTOR_make(a);
VECTOR_ensure_complex(v);
gsl_vector_complex_scale(CVEC(v), gsl_complex_inverse(c->number));
return v;
}
/* NOTE: Assumes z is in fundamental parallelogram */
gsl_complex wP(gsl_complex z, gsl_complex tau, const gsl_complex *g)
{
int N = 6;
int i;
gsl_complex z0;
gsl_complex z02;
gsl_complex p;
z = near_origin(z,tau);
z0 = gsl_complex_div_real(z,(double)(1 << N));
z02 = gsl_complex_mul(z0,z0);
/* Laurent expansion: P \approx 1/z^2 + (g2/20)z^2 + (g3/28) z^4 */
p = gsl_complex_add(gsl_complex_inverse(z02),
gsl_complex_add(gsl_complex_mul(z02,gsl_complex_mul_real(g[0],0.05)),
gsl_complex_mul(gsl_complex_mul(z02,z02),gsl_complex_mul_real(g[1],_CONST_1_28))));
for (i=0;i<N;i++) {
p = P_doubler(p,g);
}
return p;
}
gsl_complex gsl_complex_arcsech(gsl_complex a)
{ /* z = arcsech(a); */
gsl_complex t = gsl_complex_inverse(a);
return gsl_complex_arccosh(t);
}
gsl_complex gsl_complex_coth(gsl_complex a)
{ /* z = coth(a) */
gsl_complex z = gsl_complex_tanh(a);
return gsl_complex_inverse(z);
}
gsl_complex gsl_complex_csch(gsl_complex a)
{ /* z = csch(a) */
gsl_complex z = gsl_complex_sinh(a);
return gsl_complex_inverse(z);
}
gsl_complex gsl_complex_sech(gsl_complex a)
{ /* z = sech(a) */
gsl_complex z = gsl_complex_cosh(a);
return gsl_complex_inverse(z);
}
gsl_complex gsl_complex_arccsc(gsl_complex a)
{ /* z = arccsc(a) */
gsl_complex z = gsl_complex_inverse(a);
return gsl_complex_arcsin(z);
}
void
gsl_complex_sech (complex_t const *a, complex_t *res)
{ /* z = sech(a) */
gsl_complex_cosh (a, res);
gsl_complex_inverse (res, res);
}
complex complex::inverse() const
{
gsl_complex t = gsl_complex_inverse(_complex);
return complex(t);
}
void smf_filter_mce( smfFilter *filt, int noinverse, int *status ) {
/* Filter parameters */
double B_1_1;
double B_1_2;
double B_2_1;
double B_2_2;
double CLOCK_PERIOD;
double ROW_DWELL;
double NUM_ROWS=41;
double DELTA_TIME;
double SRATE;
double datechange; /* UTC MJD for change in MCE filter parameters */
AstTimeFrame *tf=NULL; /* time frame for date conversion */
size_t i; /* Loop counter */
if( *status != SAI__OK ) return;
if( !filt ) {
*status = SAI__ERROR;
errRep( FUNC_NAME, "NULL smfFilter supplied.", status );
return;
}
if( filt->ndims != 1 ) {
*status = SAI__ERROR;
errRep( "", FUNC_NAME ": function only generates filters for time-series",
status );
return;
}
if( !filt->fdims[0] ) {
*status = SAI__ERROR;
errRep( "", FUNC_NAME ": 0-length smfFilter supplied.",
status );
return;
}
if( filt->dateobs == VAL__BADD ) {
*status = SAI__ERROR;
errRep( "", FUNC_NAME ": dateobs (date of data to which filter will be "
"applied) is not set - can't determine correct MCE filter "
"parameters.", status );
return;
}
/* If filt->real is NULL, create a complex identity filter first. Similarly,
if the filter is currently only real-valued, add an imaginary part. */
if( !filt->real ) {
smf_filter_ident( filt, 1, status );
if( *status != SAI__OK ) return;
} else if( !filt->imag ) {
filt->imag = astCalloc( filt->fdims[0], sizeof(*filt->imag) );
if( *status != SAI__OK ) return;
filt->isComplex = 1;
}
/* Set up filter parameters */
tf = astTimeFrame( " " );
astSet( tf, "TimeScale=UTC" );
astSet( tf, "TimeOrigin=%s", "2011-06-03T00:00:00" );
datechange = astGetD( tf, "TimeOrigin" );
tf = astAnnul( tf );
if( filt->dateobs > datechange ) {
/* Data taken after 20110603 */
B_1_1 = -1.9712524; /* -2.*32297./2.^15. */
B_1_2 = 0.97253418; /* 2.*15934./2.^15. */
B_2_1 = -1.9337769; /* -2.*31683./2.^15. */
B_2_2 = 0.93505859; /* 2.*15320./2.^15. */
ROW_DWELL = 94.; /* time to dwell at each row (in clocks) */
msgOutiff(MSG__DEBUG, "", FUNC_NAME
": filter for data UTC MJD %lf after %lf", status,
filt->dateobs, datechange );
} else {
/* Older data */
B_1_1 = -1.9587402; /* -2.*32092./2.^15. */
B_1_2 = 0.96130371; /* 2.*15750./2.^15. */
B_2_1 = -1.9066162; /* -2.*31238./2.^15. */
B_2_2 = 0.90911865; /* 2.*14895./2.^15. */
ROW_DWELL = 128.; /* time to dwell at each row (in clocks) */
msgOutiff(MSG__DEBUG, "", FUNC_NAME
": filter for data UTC MJD %lf before %lf", status,
filt->dateobs, datechange );
}
CLOCK_PERIOD = 20E-9; /* 50 MHz clock */
NUM_ROWS = 41.; /* number of rows addressed */
DELTA_TIME = (CLOCK_PERIOD*ROW_DWELL*NUM_ROWS); /* sample length */
SRATE = (1./DELTA_TIME); /* sample rate */
/* Loop over all frequencies in the filter */
for( i=0; i<filt->fdims[0]; i++ ) {
double cos_m_o;
double sin_m_o;
double cos_m_2o;
double sin_m_2o;
double f;
gsl_complex den;
gsl_complex h1_omega;
gsl_complex h2_omega;
gsl_complex h_omega;
gsl_complex num;
gsl_complex temp;
double omega;
f = filt->df[0]*i; /* Frequency at this step */
omega = (f / SRATE)*2*AST__DPI; /* Angular frequency */
cos_m_o = cos(-omega);
sin_m_o = sin(-omega);
cos_m_2o = cos(-2*omega);
sin_m_2o = sin(-2*omega);
/*
h1_omega=(1 + 2*complex(cos_m_o,sin_m_o) + complex(cos_m_2o,sin_m_2o)) /
(1 + b_1_1*complex(cos_m_o,sin_m_o) + b_1_2 * complex(cos_m_2o,sin_m_2o))
*/
/* numerator */
GSL_SET_COMPLEX(&num, 1, 0);
GSL_SET_COMPLEX(&temp, cos_m_o, sin_m_o);
num = gsl_complex_add( num, gsl_complex_mul_real(temp, 2) );
GSL_SET_COMPLEX(&temp, cos_m_2o, sin_m_2o);
num = gsl_complex_add( num, temp );
/* denominator */
GSL_SET_COMPLEX(&den, 1, 0);
GSL_SET_COMPLEX(&temp, cos_m_o, sin_m_o);
den = gsl_complex_add( den, gsl_complex_mul_real(temp,B_1_1) );
GSL_SET_COMPLEX(&temp, cos_m_2o, sin_m_2o);
den = gsl_complex_add( den, gsl_complex_mul_real(temp,B_1_2) );
/* quotient */
h1_omega = gsl_complex_div( num, den );
/*
h2_omega=(1 + 2*complex(cos_m_o,sin_m_o) + complex(cos_m_2o,sin_m_2o)) /
(1 + b_2_1*complex(cos_m_o,sin_m_o) + b_2_2*complex(cos_m_2o,sin_m_2o))
note: we can re-use numerator from above
*/
/* denominator */
GSL_SET_COMPLEX(&den, 1, 0);
GSL_SET_COMPLEX(&temp, cos_m_o, sin_m_o);
den = gsl_complex_add( den, gsl_complex_mul_real(temp,B_2_1) );
GSL_SET_COMPLEX(&temp, cos_m_2o, sin_m_2o);
den = gsl_complex_add( den, gsl_complex_mul_real(temp,B_2_2) );
/* quotient */
h2_omega = gsl_complex_div( num, den );
/* And finally...
h_omega=h1_omega*h2_omega/2048.
*/
h_omega = gsl_complex_mul( h1_omega, gsl_complex_div_real(h2_omega,2048.) );
/* Normally we are applying the inverse of the filter to remove
its effect from the time-series. */
if( !noinverse ) {
h_omega = gsl_complex_inverse( h_omega );
}
/* Then apply this factor to the filter. */
GSL_SET_COMPLEX( &temp, filt->real[i], filt->imag[i] );
temp = gsl_complex_mul( temp, h_omega );
filt->real[i] = GSL_REAL( temp );
filt->imag[i] = GSL_IMAG( temp );
}
}
void
gsl_complex_arccoth (complex_t const *a, complex_t *res)
{ /* z = arccoth(a); */
gsl_complex_inverse (a, res);
gsl_complex_arctanh (res, res);
}
void
gsl_complex_coth (complex_t const *a, complex_t *res)
{ /* z = coth(a) */
gsl_complex_tanh (a, res);
gsl_complex_inverse (res, res);
}
gsl_complex gsl_complex_arccsch(gsl_complex a)
{ /* z = arccsch(a) */
gsl_complex t = gsl_complex_inverse(a);
return gsl_complex_arcsinh(t);
}
gsl_complex gsl_complex_arccoth(gsl_complex a)
{ /* z = arccoth(a) */
gsl_complex t = gsl_complex_inverse(a);
return gsl_complex_arctanh(t);
}
void
gsl_complex_arccsc (complex_t const *a, complex_t *res)
{ /* z = arccsc(a) */
gsl_complex_inverse (a, res);
gsl_complex_arcsin (res, res);
}