Quaternions and Wigner matrix elements; untested.

Former-commit-id: 27dfd620a73f7ec246882863239e96a29c87a867

qpms/wigner.c

@@ -0,0 +1,57 @@
+#include "wigner.h"
+#include "tiny_inlines.h"
+#include "kahansum.h"
+#define WIGNER_ATOL (1e-15)
+
+#define MIN(a,b) ((a)<(b)?(a):b)
+#define MAX(a,b) ((a)>(b)?(a):b)
+
+complex double qpms_wignerD_elem(const qpms_quat_t R,
+    const qpms_l_t l, const qpms_m_t mp, const qpms_m_t m) {
+  // TODO do some optimisations... The combinatoric coeffs could be precomputed.
+  if (abs(m) > l || abs(mp) > l)  abort();//return 0; // It's safer to crash. :D
+  const double mRa = cabs(R.a), mRb = cabs(R.b);
+  if (mRa < WIGNER_ATOL) {
+    if (m != -mp) return 0;
+    else return min1pow(l+m) * cpow(R.b, 2*m);
+  } else if (mRb < WIGNER_ATOL) {
+    if (m != mp) return 0;
+    else return cpow(R.a, 2*m);
+  } else if (mRa >= mRb) {
+    complex double prefac = exp(.5*(lgamma(l+m+1) + lgamma(l-m+1)
+        - lgamma(l+mp+1) - lgamma(l-mp+1))) 
+      * pow(mRa, 2*l-2*m)
+      * cpow(R.a, mp+m)
+      * cpow(R.b, -mp+m);
+    double sum, sumc; kahaninit( &sum, &sumc);
+    // FIXME this is probably quite stupid way to calculate the sum
+    for(int rho=MAX(0, -m+mp); rho <= MIN(l-m, l+mp); ++rho)
+      kahanadd(&sum, &sumc,
+          exp( 
+            lgamma(l+mp+1) - lgamma(rho+1) - lgamma(l+mp-rho+1)
+            + lgamma(l-mp+1) - lgamma(l-rho-m+1) - lgamma(-mp+rho+m+1)
+          )
+          * pow(-mRb*mRb/(mRa*mRa), rho)
+      );
+    return prefac * sum;
+  } else { // (mRa < mRb)
+    complex double prefac = min1pow(l-m) * exp(.5*(lgamma(l+m+1) + lgamma(l-m+1)
+        - lgamma(l+mp+1) - lgamma(l-mp+1))) 
+      * pow(mRb, 2*l-2*m)
+      * cpow(R.a, mp+m)
+      * cpow(R.b, -mp+m);
+    double sum, sumc; kahaninit( &sum, &sumc);
+    // FIXME this is probably quite stupid way to calculate the sum
+    for(int rho=MAX(0, -m-mp); rho <= MIN(l-mp, l-m); ++rho)
+      kahanadd(&sum, &sumc,
+          exp( 
+            lgamma(l+mp+1) - lgamma(l-m-rho+1) - lgamma(mp+m+rho+1)
+            + lgamma(l-mp+1) - lgamma(rho+1) - lgamma(l-mp-rho+1)
+          )
+          * pow(-mRa*mRa/(mRb*mRb), rho)
+      );
+    return prefac * sum;
+  }
+}
+
+

qpms/wigner.h

@@ -0,0 +1,88 @@
+/*! \file wigner.h
+ * \brief Quaternions and Wigner matrices
+ */
+#ifndef QPMS_WIGNER_H
+#define QPMS_WIGNER_H
+
+#include "qpms_types.h"
+
+/// Quaternion type.
+/**
+ * Internaly represented as a pair of complex numbers,
+ * \f$ Q_a = Q_1 + iQ_z, Q_b = Q_y + i Q_x\f$.
+ */
+typedef struct qpms_quat_t {
+	complex double a, b;
+} qpms_quat_t;
+
+/// Quaternion type as four doubles.
+typedef struct qpms_quat4d_t {
+	double c1, ci, cj, ck;
+} qpms_quat4d_t;
+
+/// Conversion from the 4*double to the 2*complex quaternion.
+// TODO is this really correct? 
+// I.e. do the axis from moble's text match this convention?
+static inline qpms_quat_t qpms_quat_2c_from_4d (qpms_quat4d_t q) {
+	qpms_quat_t q2c = {q.c1 + I * q.ck, q.cj + I * q.ci};
+	return q2c;
+}
+
+/// Quaternion multiplication.
+/**
+ * \f[ (P Q)_a = P_a Q_a - \bar P_b Q_b, \f]
+ * \f[ (P Q)_b = P_b Q_a + \bar P_a Q_b. \f]
+ */
+static inline qpms_quat_t qpms_quat_mult(qpms_quat_t p, qpms_quat_t q) {
+	qpms_quat_t r;
+	r.a = p.a * q.a - conj(p.b) * q.b;
+	r.b = p.b * q.a + conj(p.a) * q.b;
+	return r;
+}
+
+/// Quaternion addition.
+static inline qpms_quat_t qpms_quat_add(qpms_quat_t p, qpms_quat_t q) {
+	qpms_quat_t r;
+	r.a = p.a+q.a;
+	r.b = p.b+q.b;
+	return r;
+}
+
+/// Quaternion scaling with a real number.
+static inline qpms_quat_t qpms_quat_rscale(double s, qpms_quat_t q) {
+	qpms_quat_t r = {s * q.a, s * q.b};
+	return r;
+}
+
+// quaternion "basis"
+static const qpms_quat_t qpms_quat_1 = {1, 0};
+static const qpms_quat_t qpms_quat_i = {I, 0};
+static const qpms_quat_t qpms_quat_j = {0, 1};
+static const qpms_quat_t qpms_quat_k = {0, I};
+
+/// Quaternion conjugation.
+static inline qpms_quat_t qpms_quat_conj(qpms_quat_t q) {
+	qpms_quat_t r = {conj(q.a), -q.b};
+	return r;
+}
+
+/// Quaternion norm.
+static inline double qpms_quat_norm(qpms_quat_t q) {
+	return sqrt(creal(q.a * conj(q.a) + q.b * conj(q.b)));
+}
+
+/// Quaternion normalisation to unit norm.
+static inline qpms_quat_t qpms_quat_normalise(qpms_quat_t q) {
+	double n = qpms_quat_norm(q);
+	return qpms_quat_rscale(1/n, q);
+}
+
+/// Wigner D matrix element from a rotator quaternion for integer l.
+/**
+ * The D matrix are calculated using formulae (3), (4), (6), (7) from
+ * http://moble.github.io/spherical_functions/WignerDMatrices.html
+ */
+complex double qpms_wignerD_elem(qpms_quat_t q, qpms_l_t l,
+	       qpms_m_t	mp, qpms_m_t m);
+
+#endif //QPMS_WIGNER_H