static void
aran_multipole_translate_vertical (const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n;
gdouble rpow[dst->negdeg];
gdouble pow;
gcomplex128 *srcterm, *dstterm;
gint d = MAX (src->negdeg, dst->negdeg) - 1;
if (src->negdeg > dst->negdeg)
g_warning ("could loose precision in \"%s\"\n", __PRETTY_FUNCTION__);
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
pow = 1.;
for (l = 0; l < dst->negdeg; l++)
{
rpow[l] = pow;
pow *= r;
for (m = 0; m <= l; m++)
{
dstterm = _spherical_seriesd_get_neg_term (dst, l, m);
for (n = m; n <= MIN (l, src->negdeg - 1); n++)
{
gdouble normaliz = aran_spherical_seriesd_beta (l) /
aran_spherical_seriesd_beta (n);
gdouble factor;
gdouble h;
srcterm = _spherical_seriesd_get_neg_term (src, n, 0);
/* m-o = 0 */
factor =
aran_spherical_seriesd_alpha (l - n, 0) *
aran_spherical_seriesd_alpha (n, m) /
aran_spherical_seriesd_alpha (l, m);
/* h= Y_(l-n)^(m-o) */
/*
* in this case, h=Y_(l-n)^0, which simplifies with "normaliz"
* removing beta(l-n)
* and then becomes h = P_(l-n)^0 = (cost)^(l-n)
*/
h = ((l-n)%2 == 0)? 1. : cost;
*dstterm += h * srcterm[m] * factor * normaliz *
rpow[l - n];
}
}
}
}
/**
* aran_spherical_seriesd_rotate_inverse:
* @src: source #AranSphericalSeriesd.
* @alpha: 1st Euler angle.
* @beta: 2nd Euler angle. Condition 0 <= /theta < pi must hold.
* @gamma: 3rd Euler angle.
* @dst: destination #AranSphericalSeriesd.
*
* Computes the inverse rotation of @src and accumulates the result into
* @dst. Angles are in the Euler ZYZ convention. The term inverse means that
* performing aran_spherical_seriesd_rotate_inverse to the result of a call to
* aran_spherical_seriesd_rotate() is equivalent to identity.
*/
void aran_spherical_seriesd_rotate_inverse (const AranSphericalSeriesd * src,
gdouble alpha, gdouble beta,
gdouble gamma,
AranSphericalSeriesd * dst)
{
gint l;
guint8 nd = MIN (dst->negdeg, src->negdeg);
guint8 pd = MIN (dst->posdeg, src->posdeg);
guint8 lmax = MAX (pd+1, nd);
gcomplex128 expma[lmax];
gcomplex128 expmg[lmax];
gcomplex128 expa = cos (alpha) - G_I * sin (alpha);
gcomplex128 expg = cos (gamma) - G_I * sin (gamma);
AranWigner *aw = aran_wigner_repo_lookup (beta);
aran_wigner_require (aw, lmax);
expma[0] = 1.;
expmg[0] = 1.;
for (l = 1; l < lmax; l++)
{
expma[l] = expma[l - 1] * expa;
expmg[l] = expmg[l - 1] * expg;
}
_buffer_rotate_inverse (aw, pd, expma, expmg,
_spherical_seriesd_get_pos_term (src, 0, 0),
_spherical_seriesd_get_pos_term (dst, 0, 0));
if (nd > 0)
{
_buffer_rotate_inverse (aw, nd - 1, expma, expmg,
_spherical_seriesd_get_neg_term (src, 0, 0),
_spherical_seriesd_get_neg_term (dst, 0, 0));
}
}
/**
* aran_spherical_seriesd_translate_rotate:
* @src: source expansion series.
* @xsrc: @src center.
* @dst: destination expansion series.
* @xdst: @dst center.
*
* Performs the same operation as aran_spherical_seriesd_translate() but
* with the "Point and Shoot" algorithm which achieves O(p^3) complexity.
*/
void aran_spherical_seriesd_translate_rotate (const AranSphericalSeriesd *src,
const VsgVector3d *xsrc,
AranSphericalSeriesd *dst,
const VsgVector3d *xdst)
{
gint l;
guint8 nd = MAX (dst->negdeg, src->negdeg);
guint8 pd = MAX (dst->posdeg, src->posdeg);
guint8 lmax = MAX (pd+1, nd);
gcomplex128 expma[lmax];
gcomplex128 expa;
AranWigner *aw;
VsgVector3d dir;
gdouble r, theta, phi;
gdouble cost = 1.;
AranSphericalSeriesd *rot = (AranSphericalSeriesd *)
g_alloca (ARAN_SPHERICAL_SERIESD_SIZE (src->posdeg, src->negdeg));
AranSphericalSeriesd *trans = (AranSphericalSeriesd *)
g_alloca (ARAN_SPHERICAL_SERIESD_SIZE (dst->posdeg, dst->negdeg));
/* create work AranSphericalSeriesd */
memcpy (rot, src, sizeof (AranSphericalSeriesd));
memcpy (trans, dst, sizeof (AranSphericalSeriesd));
aran_spherical_seriesd_set_zero (rot);
aran_spherical_seriesd_set_zero (trans);
/* get translation vector */
vsg_vector3d_sub (xdst, xsrc, &dir);
if (dir.z < 0.)
{
cost = -1.;
vsg_vector3d_scalp (&dir, -1., &dir);
}
/* get rotation angles */
vsg_vector3d_to_spherical (&dir, &r, &theta, &phi);
/* prepare rotation tools: AranWigner + complex exponentials arrays */
aw = aran_wigner_repo_lookup (theta);
aran_wigner_require (aw, lmax);
expa = cos (-phi) - G_I * sin (-phi);
expma[0] = 1.;
for (l = 1; l < lmax; l++)
{
expma[l] = expma[l - 1] * expa;
}
/* rotate src */
_buffer_rotate_ab (aw, src->posdeg, expma,
_spherical_seriesd_get_pos_term (src, 0, 0),
_spherical_seriesd_get_pos_term (rot, 0, 0));
if (src->negdeg > 0)
{
_buffer_rotate_ab (aw, src->negdeg - 1, expma,
_spherical_seriesd_get_neg_term (src, 0, 0),
_spherical_seriesd_get_neg_term (rot, 0, 0));
}
/* aran_spherical_seriesd_rotate (src, -phi, theta, 0., rot); */
/* translate src to dst center */
aran_spherical_seriesd_translate_vertical (rot, trans,
r, cost,
1., 0.);
/* rotate back and accumulate into dst */
_buffer_rotate_ab_inverse (aw, dst->posdeg, expma,
_spherical_seriesd_get_pos_term (trans, 0, 0),
_spherical_seriesd_get_pos_term (dst, 0, 0));
if (dst->negdeg > 0)
{
_buffer_rotate_ab_inverse (aw, dst->negdeg - 1, expma,
_spherical_seriesd_get_neg_term (trans, 0, 0),
_spherical_seriesd_get_neg_term (dst, 0, 0));
}
/* aran_spherical_seriesd_rotate_inverse (trans, -phi, theta, 0., dst); */
}
static void aran_multipole_to_local (const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost, gdouble sint,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n, o;
gint d = dst->posdeg + src->negdeg;
gdouble rpow[d + 1];
gdouble pow, inv_r;
gcomplex128 *srcterm, *dstterm, *hterm;
gcomplex128 harmonics[((d + 1) * (d + 2)) / 2];
gcomplex128 expp = cosp + G_I * sinp;
gdouble sign;
/* if ((src->negdeg-1) > dst->posdeg) */
/* g_warning ("could loose precision in \"%s\"\n", __PRETTY_FUNCTION__); */
/* vertical translation */
if (ABS (sint) < 1.e-5) /* sint in m2l translation is zero or high values */
{
aran_spherical_seriesd_multipole_to_local_vertical (src, dst, r,
cost, cosp, sinp);
return;
}
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
aran_spherical_harmonic_evaluate_multiple_internal (d, cost, sint, expp,
harmonics);
inv_r = 1. / r;
pow = 1.;
for (l = 0; l <= d; l++)
{
rpow[l] = pow;
pow *= inv_r;
}
sign = 1.;
for (l = 0; l <= dst->posdeg; l++)
{
for (m = 0; m <= l; m++)
{
dstterm = _spherical_seriesd_get_pos_term (dst, l, m);
for (n = 0; n < src->negdeg; n++)
{
gdouble normaliz = aran_spherical_seriesd_beta (l + n) *
aran_spherical_seriesd_beta (l) /
aran_spherical_seriesd_beta (n);
gcomplex128 sum = 0.;
srcterm = _spherical_seriesd_get_neg_term (src, n, 0);
hterm = aran_spherical_harmonic_multiple_get_term (l + n, 0,
harmonics);
sum = aran_spherical_seriesd_alpha (l, m) *
aran_spherical_seriesd_alpha (n, 0) /
aran_spherical_seriesd_alpha (l + n, m) * hterm[m] *
srcterm[0];
for (o = 1; o <= n; o++)
{
guint m_p_o = m + o;
gdouble factor = aran_spherical_seriesd_alpha (l, m) *
aran_spherical_seriesd_alpha (n, o);
/* h= Y_(l+n)^(m+o) */
gcomplex128 h = hterm[m_p_o];
sum += h * srcterm[o] * factor /
aran_spherical_seriesd_alpha (l + n, m_p_o);
m_p_o = ABS (m - o);
/* h= Y_(l+n)^(m-o) */
h = hterm[m_p_o];
if ((m - o) < 0)
h = _sph_sym (h, m_p_o);
sum += h * _sph_sym (srcterm[o], o) * factor /
aran_spherical_seriesd_alpha (l + n, m_p_o);
}
*dstterm += conj (sum) * sign * normaliz * rpow[l + n + 1];
}
}
sign = -sign;
}
}
void
aran_spherical_seriesd_multipole_to_local_vertical
(const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n;
gint d = dst->posdeg + src->negdeg;
gdouble rpow[d + 1];
gdouble pow, inv_r;
gcomplex128 *srcterm, *dstterm, *hterm;
gcomplex128 harmonics[((d + 1) * (d + 2)) / 2];
gcomplex128 expp = cosp + G_I * sinp;
gdouble sign;
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
aran_spherical_harmonic_evaluate_multiple_internal (d, cost, 0, expp,
harmonics);
inv_r = 1. / r;
pow = 1.;
for (l = 0; l <= d; l++)
{
rpow[l] = pow;
pow *= inv_r;
}
sign = 1.;
for (l = 0; l <= dst->posdeg; l++)
{
for (m = 0; m <= l; m++)
{
dstterm = _spherical_seriesd_get_pos_term (dst, l, m);
for (n = m; n < src->negdeg; n++)
{
gdouble normaliz = aran_spherical_seriesd_beta (l + n) *
aran_spherical_seriesd_beta (l) /
aran_spherical_seriesd_beta (n);
gcomplex128 sum;
gdouble factor;
gcomplex128 h;
srcterm = _spherical_seriesd_get_neg_term (src, n, 0);
hterm = aran_spherical_harmonic_multiple_get_term (l + n, 0,
harmonics);
/* o == -m */
factor = aran_spherical_seriesd_alpha (l, m) *
aran_spherical_seriesd_alpha (n, m);
/* h= Y_(l+n)^(m+o) */
h = hterm[0];
sum = h * _sph_sym (srcterm[m], m) * factor /
aran_spherical_seriesd_alpha (l + n, 0);
*dstterm += conj (sum) * sign * normaliz * rpow[l + n + 1];
}
}
sign = -sign;
}
}
static void aran_multipole_translate (const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost, gdouble sint,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n, o;
gdouble rpow[dst->negdeg];
gdouble pow;
gcomplex128 *srcterm, *dstterm, *hterm;
gint d = MAX (src->negdeg, dst->negdeg) - 1;
gcomplex128 harmonics[((d + 1) * (d + 2)) / 2];
gcomplex128 expp = cosp + G_I * sinp;
if (src->negdeg > dst->negdeg)
g_warning ("could loose precision in \"%s\"\n", __PRETTY_FUNCTION__);
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
aran_spherical_harmonic_evaluate_multiple_internal (dst->negdeg - 1, cost,
sint, expp, harmonics);
pow = 1.;
for (l = 0; l < dst->negdeg; l++)
{
rpow[l] = pow;
pow *= r;
for (m = 0; m <= l; m++)
{
dstterm = _spherical_seriesd_get_neg_term (dst, l, m);
for (n = 0; n <= MIN (l, src->negdeg - 1); n++)
{
gdouble normaliz = aran_spherical_seriesd_beta (l - n) *
aran_spherical_seriesd_beta (l) /
aran_spherical_seriesd_beta (n);
gcomplex128 sum = 0.;
srcterm = _spherical_seriesd_get_neg_term (src, n, 0);
hterm = aran_spherical_harmonic_multiple_get_term (l - n, 0,
harmonics);
for (o = MAX (-n, m + n - l); o <= MIN (n, l + m - n); o++)
{
guint abs_m_m_o = ABS (m - o);
gdouble factor =
aran_spherical_seriesd_alpha (l - n, abs_m_m_o) *
aran_spherical_seriesd_alpha (n, ABS (o)) /
aran_spherical_seriesd_alpha (l, ABS (m));
gcomplex128 h = conj (hterm[abs_m_m_o]);
/* h=conj ( Y_(l-n)^(m-o) ) */
if ((m - o) < 0)
h = _sph_sym (h, abs_m_m_o);
if (o >= 0)
h *= srcterm[o];
else
h *= _sph_sym (srcterm[-o], -o);
sum += h * factor;
}
*dstterm += sum * normaliz * rpow[l - n];
}
}
}
}
void
aran_spherical_seriesd_multipole_to_local_vertical
(const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n;
gint d = dst->posdeg + src->negdeg;
gdouble rpow[d + 1];
gdouble pow, inv_r;
gcomplex128 *srcterm, *dstterm;
gdouble sign;
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
inv_r = 1. / r;
pow = 1.;
for (l = 0; l <= d; l++)
{
rpow[l] = pow;
pow *= inv_r;
}
sign = 1.;
for (l = 0; l <= dst->posdeg; l++)
{
for (m = 0; m <= l; m++)
{
dstterm = _spherical_seriesd_get_pos_term (dst, l, m);
for (n = m; n < src->negdeg; n++)
{
gdouble normaliz = aran_spherical_seriesd_beta (l) /
aran_spherical_seriesd_beta (n);
gcomplex128 sum;
gdouble factor;
gcomplex128 h;
srcterm = _spherical_seriesd_get_neg_term (src, n, 0);
/* o == -m */
factor = aran_spherical_seriesd_alpha (l, m) *
aran_spherical_seriesd_alpha (n, m);
/* h= Y_(l+n)^(m+o) */
/*
* in this case, h=Y_(l+n)^0, which simplifies with "normaliz"
* removing beta(l+n)
* and then becomes h = P_(l+n)^0 = (cost)^(l+n)
*/
h = ((l+n)%2 == 0)? 1. : cost;
sum = h * _sph_sym (srcterm[m], m) * factor /
aran_spherical_seriesd_alpha (l + n, 0);
*dstterm += conj (sum) * sign * normaliz * rpow[l + n + 1];
}
}
sign = -sign;
}
}
/*
* Compute M2L translation in a vertical direction, positive or negative,
* depending on the value of cost (+1. or -1.)
*
* Formula:
* \check{Y}_l^m (\vec{r_0'}) =
* (-1)^l \sum_{n=m}^{\infty}
* \frac{1}{|\vec{r_0'}-\vec{r_0}|^{l+n+1}}
* \frac{\beta_l \beta_{l+n}}{\beta_n}
* \frac{\alpha_l^m \alpha_n^{-m}}{\alpha_{l+n}^{0}}
* \overline{Y_{l+n}^{0}(\theta, \phi_{\vec{r_0'}-\vec{r_0}})}
* \overline{\hat{Y}_{n}^{-m}(\vec{r_0})}
*/
void
aran_spherical_seriesd_multipole_to_local_vertical
(const AranSphericalSeriesd * src,
AranSphericalSeriesd * dst,
gdouble r,
gdouble cost,
gdouble cosp, gdouble sinp)
{
gint l, m;
gint n;
gint d = dst->posdeg + src->negdeg;
gdouble rpow[d + 1];
gdouble pow, inv_r;
gcomplex128 *dstterm;
aran_spherical_seriesd_alpha_require (d);
aran_spherical_seriesd_beta_require (d);
_betal_over_betan_require (MAX(dst->posdeg, src->negdeg));
_precomputed_translate_vertical_require(MAX(dst->posdeg, src->negdeg));
inv_r = 1. / r;
pow = 1.;
for (l = 0; l <= d; l++)
{
rpow[l] = pow;
/* o == -m */
/* h= Y_(l+n)^(m+o) */
/*
* in this case, h=Y_(l+n)^0, which simplifies with beta(l+n)
* and then becomes h = P_(l+n)^0 = (cost)^(l+n)
* we integrate (cost)^(l+n) within rpow[l+n+1]
*/
if (l%2 == 0) rpow[l] *= cost;
pow *= inv_r;
}
for (l = 0; l <= dst->posdeg; l++)
{
for (m = 0; m <= l; m++)
{
gcomplex128 sum = 0.;
dstterm = _spherical_seriesd_get_pos_term (dst, l, m);
for (n = m; n < src->negdeg; n++)
{
gcomplex128 srcterm;
gdouble translate_factor;
srcterm = *_spherical_seriesd_get_neg_term (src, n, m);
/* translate_factor = beta(l)/beta(n) * alpha(l,m) * alpha(n,m) /
* alpha (l + n, 0);
*/
translate_factor = _precomputed_translate_vertical (l, m, n);
sum += srcterm * (rpow[l + n + 1] * translate_factor);
}
/* combination of (-1)^l and Y_n^(-m)*/
sum = ((l+m)%2 == 0)? sum : -sum;
*dstterm += sum;
}
}
}
