int
mfield_green_ext(const double r, const double theta, const double phi,
mfield_green_workspace *w)
{
int s = 0;
size_t n;
int m;
const double sint = sin(theta);
const double cost = cos(theta);
double ratio = r / w->R;
double term = 1.0; /* (r/a)^{n-1} */
/* precompute cos(m phi) and sin(m phi) */
for (n = 0; n <= w->nmax; ++n)
{
w->cosmphi[n] = cos(n * phi);
w->sinmphi[n] = sin(n * phi);
}
/* compute associated legendres */
gsl_sf_legendre_deriv_alt_array(GSL_SF_LEGENDRE_SCHMIDT, w->nmax, cost,
w->Plm, w->dPlm);
for (n = 1; n <= w->nmax; ++n)
{
int ni = (int) n;
for (m = -ni; m <= ni; ++m)
{
int mabs = abs(m);
size_t cidx = mfield_green_nmidx(n, m);
size_t pidx = gsl_sf_legendre_array_index(n, mabs);
if (m < 0)
{
/* h_{nm} */
w->dX_ext[cidx] = term * w->sinmphi[mabs] * w->dPlm[pidx];
w->dY_ext[cidx] = -term / sint * mabs * w->cosmphi[mabs] * w->Plm[pidx];
w->dZ_ext[cidx] = (double) n * term * w->sinmphi[mabs] * w->Plm[pidx];
}
else
{
/* g_{nm} */
w->dX_ext[cidx] = term * w->cosmphi[mabs] * w->dPlm[pidx];
w->dY_ext[cidx] = term / sint * mabs * w->sinmphi[mabs] * w->Plm[pidx];
w->dZ_ext[cidx] = (double) n * term * w->cosmphi[mabs] * w->Plm[pidx];
}
}
/* (r/a)^{n-1} */
term *= ratio;
}
return s;
} /* mfield_green_ext() */
int
green_calc(const double r, const double theta, const double phi,
const double R, green_workspace *w)
{
int s = 0;
size_t n;
int m;
const double sint = sin(theta);
const double cost = cos(theta);
double ratio = R / r;
double term = ratio * ratio; /* (R/r)^{n+2} */
/* precompute cos(m phi) and sin(m phi) */
for (n = 0; n <= w->nmax; ++n)
{
w->cosmphi[n] = cos(n * phi);
w->sinmphi[n] = sin(n * phi);
}
/* compute associated legendres */
gsl_sf_legendre_deriv_alt_array(GSL_SF_LEGENDRE_SCHMIDT, w->nmax, cost,
w->Plm, w->dPlm);
for (n = 1; n <= w->nmax; ++n)
{
int ni = (int) n;
/* (a/r)^{n+2} */
term *= ratio;
for (m = -ni; m <= ni; ++m)
{
int mabs = abs(m);
size_t cidx = green_nmidx(n, m);
size_t pidx = gsl_sf_legendre_array_index(n, mabs);
if (m < 0)
{
/* h_{nm} */
w->dX[cidx] = term * w->sinmphi[mabs] * w->dPlm[pidx];
w->dY[cidx] = -term / sint * mabs * w->cosmphi[mabs] * w->Plm[pidx];
w->dZ[cidx] = -(n + 1.0) * term * w->sinmphi[mabs] * w->Plm[pidx];
}
else
{
/* g_{nm} */
w->dX[cidx] = term * w->cosmphi[mabs] * w->dPlm[pidx];
w->dY[cidx] = term / sint * mabs * w->sinmphi[mabs] * w->Plm[pidx];
w->dZ[cidx] = -(n + 1.0) * term * w->cosmphi[mabs] * w->Plm[pidx];
}
}
}
return s;
} /* green_calc() */
static double
chi_ext(const double b, const double phi, const gsl_vector *k,
const green_workspace *green_p)
{
const double mu0 = 400.0 * M_PI; /* units of nT / (kA km^{-1}) */
const size_t nmax = green_p->nmax;
const double *Plm = green_p->Plm;
const double ratio = b / R_EARTH_KM;
size_t n;
double chi = 0.0;
double rfac = 1.0;
for (n = 1; n <= nmax; ++n)
{
int M = (int) GSL_MIN(n, green_p->mmax);
int m;
double nfac = (2.0 * n + 1.0) / (n + 1.0);
for (m = -M; m <= M; ++m)
{
int mabs = abs(m);
size_t cidx = green_nmidx(n, m, green_p);
double knm = gsl_vector_get(k, cidx);
double qnm = nfac * rfac * knm;
size_t pidx = gsl_sf_legendre_array_index(n, mabs);
double Snm = Plm[pidx];
if (m < 0)
Snm *= sin(mabs * phi);
else
Snm *= cos(mabs * phi);
chi += qnm * Snm;
}
/* (b/R)^{n-2} */
rfac *= ratio;
}
/* units of kA */
chi *= -(b / mu0);
return chi;
}
int
FUNCTION (gsl_sf_legendre, array_e)
(const gsl_sf_legendre_t norm, const size_t lmax, const double x,
const double csphase, OUTPUT_ARG)
{
int s;
const size_t nlm = gsl_sf_legendre_nlm(lmax);
#if !defined(LEGENDRE_DERIV_ALT)
size_t i;
#if defined(LEGENDRE_DERIV) || defined(LEGENDRE_DERIV2)
const double u = sqrt((1.0 - x) * (1.0 + x));
const double uinv = 1.0 / u;
#endif
#if defined(LEGENDRE_DERIV2)
const double uinv2 = uinv * uinv;
#endif
#endif
double fac1 = 0.0, fac2 = 0.0; /* normalization factors */
if (norm == GSL_SF_LEGENDRE_NONE)
{
/* compute P_{lm}(x) */
s = FUNCTION(legendre,array_none_e)(lmax, x, csphase, OUTPUT);
}
else
{
/* compute S_{lm}(x) */
s = FUNCTION(legendre,array_schmidt_e)(lmax, x, csphase, OUTPUT);
}
#if !defined(LEGENDRE_DERIV_ALT)
/* scale derivative arrays to recover P'(x) and P''(x) */
for (i = 0; i < nlm; ++i)
{
#if defined(LEGENDRE_DERIV2)
double dp = result_deriv_array[i];
double d2p = result_deriv2_array[i];
result_deriv2_array[i] = (d2p - x * uinv * dp) * uinv2;
#endif
#if defined(LEGENDRE_DERIV)
result_deriv_array[i] *= -uinv;
#endif
}
#endif
/* apply scaling for requested normalization */
if (norm == GSL_SF_LEGENDRE_SCHMIDT || norm == GSL_SF_LEGENDRE_NONE)
{
return s;
}
else if (norm == GSL_SF_LEGENDRE_SPHARM)
{
fac1 = 1.0 / sqrt(4.0 * M_PI);
fac2 = 1.0 / sqrt(8.0 * M_PI);
}
else if (norm == GSL_SF_LEGENDRE_FULL)
{
fac1 = 1.0 / sqrt(2.0);
fac2 = 1.0 / sqrt(4.0);
}
/*
* common code for different normalizations
* P_{l0} = fac1 * sqrt(2l + 1) * S_{l0}
* P_{lm} = fac2 * sqrt(2l + 1) * S_{lm}, m > 0
*/
{
size_t l, m;
size_t twoellp1 = 1; /* 2l + 1 */
double *sqrts = &(result_array[nlm]);
for (l = 0; l <= lmax; ++l)
{
result_array[gsl_sf_legendre_array_index(l, 0)] *=
sqrts[twoellp1] * fac1;
#if defined(LEGENDRE_DERIV)
result_deriv_array[gsl_sf_legendre_array_index(l, 0)] *=
sqrts[twoellp1] * fac1;
#endif
#if defined(LEGENDRE_DERIV2)
result_deriv2_array[gsl_sf_legendre_array_index(l, 0)] *=
sqrts[twoellp1] * fac1;
#endif
for (m = 1; m <= l; ++m)
{
result_array[gsl_sf_legendre_array_index(l, m)] *=
sqrts[twoellp1] * fac2;
#if defined(LEGENDRE_DERIV)
result_deriv_array[gsl_sf_legendre_array_index(l, m)] *=
sqrts[twoellp1] * fac2;
#endif
#if defined(LEGENDRE_DERIV2)
result_deriv2_array[gsl_sf_legendre_array_index(l, m)] *=
sqrts[twoellp1] * fac2;
#endif
}
twoellp1 += 2;
}
}
return s;
}
