QPMS
/
qpms
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

indent 

Former-commit-id: a56647c77be3363a71248e7ade21dd52b1d515a8
This commit is contained in:
Marek Nečada 2018-05-06 19:13:10 +00:00
parent f943cc0cdb
commit 5e45afad38
8 changed files with 1408 additions and 1475 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
qpms/bessel.c
View File

@ -12,110 +12,110 @@
#endif #endif
static inline complex double ipow(int x) { static inline complex double ipow(int x) {
return cpow(I,x); return cpow(I,x);
} }
// There is a big issue with gsl's precision of spherical bessel function; these have to be implemented differently // There is a big issue with gsl's precision of spherical bessel function; these have to be implemented differently
qpms_errno_t qpms_sph_bessel_fill(qpms_bessel_t typ, qpms_l_t lmax, double x, complex double *result_array) { qpms_errno_t qpms_sph_bessel_fill(qpms_bessel_t typ, qpms_l_t lmax, double x, complex double *result_array) {
int retval; int retval;
double tmparr[lmax+1]; double tmparr[lmax+1];
switch(typ) { switch(typ) {
case QPMS_BESSEL_REGULAR: case QPMS_BESSEL_REGULAR:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr); retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l]; for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval; return retval;
break; break;
case QPMS_BESSEL_SINGULAR: //FIXME: is this precise enough? Would it be better to do it one-by-one? case QPMS_BESSEL_SINGULAR: //FIXME: is this precise enough? Would it be better to do it one-by-one?
retval = gsl_sf_bessel_yl_array(lmax,x,tmparr); retval = gsl_sf_bessel_yl_array(lmax,x,tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l]; for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval; return retval;
break; break;
case QPMS_HANKEL_PLUS: case QPMS_HANKEL_PLUS:
case QPMS_HANKEL_MINUS: case QPMS_HANKEL_MINUS:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr); retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l]; for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
if(retval) return retval; if(retval) return retval;
retval = gsl_sf_bessel_yl_array(lmax, x, tmparr); retval = gsl_sf_bessel_yl_array(lmax, x, tmparr);
if (typ==QPMS_HANKEL_PLUS) if (typ==QPMS_HANKEL_PLUS)
for (int l = 0; l <= lmax; ++l) result_array[l] += I * tmparr[l]; for (int l = 0; l <= lmax; ++l) result_array[l] += I * tmparr[l];
else else
for (int l = 0; l <= lmax; ++l) result_array[l] +=-I * tmparr[l]; for (int l = 0; l <= lmax; ++l) result_array[l] +=-I * tmparr[l];
return retval; return retval;
break; break;
default: default:
abort(); abort();
//return GSL_EDOM; //return GSL_EDOM;
} }
assert(0); assert(0);
} }
static inline ptrdiff_t akn_index(qpms_l_t n, qpms_l_t k) { static inline ptrdiff_t akn_index(qpms_l_t n, qpms_l_t k) {
assert(k <= n); assert(k <= n);
return ((ptrdiff_t) n + 1) * n / 2 + k; return ((ptrdiff_t) n + 1) * n / 2 + k;
} }
static inline ptrdiff_t bkn_index(qpms_l_t n, qpms_l_t k) { static inline ptrdiff_t bkn_index(qpms_l_t n, qpms_l_t k) {
assert(k <= n+1); assert(k <= n+1);
return ((ptrdiff_t) n + 2) * (n + 1) / 2 - 1 + k; return ((ptrdiff_t) n + 2) * (n + 1) / 2 - 1 + k;
} }
static inline qpms_errno_t qpms_sbessel_calculator_ensure_lMax(qpms_sbessel_calculator_t *c, qpms_l_t lMax) { static inline qpms_errno_t qpms_sbessel_calculator_ensure_lMax(qpms_sbessel_calculator_t *c, qpms_l_t lMax) {
if (lMax <= c->lMax) if (lMax <= c->lMax)
return QPMS_SUCCESS; return QPMS_SUCCESS;
else { else {
if ( NULL == (c->akn = realloc(c->akn, sizeof(double) * akn_index(lMax + 2, 0)))) if ( NULL == (c->akn = realloc(c->akn, sizeof(double) * akn_index(lMax + 2, 0))))
abort(); abort();
//if ( NULL == (c->bkn = realloc(c->bkn, sizeof(complex double) * bkn_index(lMax + 1, 0)))) //if ( NULL == (c->bkn = realloc(c->bkn, sizeof(complex double) * bkn_index(lMax + 1, 0))))
// abort(); // abort();
for(qpms_l_t n = c->lMax+1; n <= lMax + 1; ++n) for(qpms_l_t n = c->lMax+1; n <= lMax + 1; ++n)
for(qpms_l_t k = 0; k <= n; ++k) for(qpms_l_t k = 0; k <= n; ++k)
c->akn[akn_index(n,k)] = exp(lgamma(n + k + 1) - k*M_LN2 - lgamma(k + 1) - lgamma(n - k + 1)); c->akn[akn_index(n,k)] = exp(lgamma(n + k + 1) - k*M_LN2 - lgamma(k + 1) - lgamma(n - k + 1));
// ... TODO derivace // ... TODO derivace
c->lMax = lMax; c->lMax = lMax;
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
} }
complex double qpms_sbessel_calc_h1(qpms_sbessel_calculator_t *c, qpms_l_t n, double x) { complex double qpms_sbessel_calc_h1(qpms_sbessel_calculator_t *c, qpms_l_t n, double x) {
if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, n)) if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, n))
abort(); abort();
complex double z = I/x; // FIXME this should be imaginary double, but gcc is broken? complex double z = I/x; // FIXME this should be imaginary double, but gcc is broken?
complex double result = 0; complex double result = 0;
for (qpms_l_t k = n; k >= 0; --k) for (qpms_l_t k = n; k >= 0; --k)
// can we use fma for complex? // can we use fma for complex?
//result = fma(result, z, c->akn(n, k)); //result = fma(result, z, c->akn(n, k));
result = result * z + c->akn[akn_index(n,k)]; result = result * z + c->akn[akn_index(n,k)];
result *= z * ipow(-n-2) * cexp(I * x); result *= z * ipow(-n-2) * cexp(I * x);
return result; return result;
} }
qpms_errno_t qpms_sbessel_calc_h1_fill(qpms_sbessel_calculator_t * const c, qpms_errno_t qpms_sbessel_calc_h1_fill(qpms_sbessel_calculator_t * const c,
const qpms_l_t lMax, const double x, complex double * const target) { const qpms_l_t lMax, const double x, complex double * const target) {
if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, lMax)) if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, lMax))
abort(); abort();
memset(target, 0, sizeof(complex double) * lMax); memset(target, 0, sizeof(complex double) * lMax);
complex double kahancomp[lMax]; complex double kahancomp[lMax];
memset(kahancomp, 0, sizeof(complex double) * lMax); memset(kahancomp, 0, sizeof(complex double) * lMax);
for(qpms_l_t k = 0; k <= lMax; ++k){ for(qpms_l_t k = 0; k <= lMax; ++k){
double xp = pow(x, -k-1); double xp = pow(x, -k-1);
for(qpms_l_t l = k; l <= lMax; ++l) for(qpms_l_t l = k; l <= lMax; ++l)
ckahanadd(target + l, kahancomp + l, c->akn[akn_index(l,k)] * xp * ipow(k-l-1)); ckahanadd(target + l, kahancomp + l, c->akn[akn_index(l,k)] * xp * ipow(k-l-1));
} }
complex double eix = cexp(I * x); complex double eix = cexp(I * x);
for (qpms_l_t l = 0; l <= lMax; ++l) for (qpms_l_t l = 0; l <= lMax; ++l)
target[l] *= eix; target[l] *= eix;
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
qpms_sbessel_calculator_t *qpms_sbessel_calculator_init() { qpms_sbessel_calculator_t *qpms_sbessel_calculator_init() {
qpms_sbessel_calculator_t *c = malloc(sizeof(qpms_sbessel_calculator_t)); qpms_sbessel_calculator_t *c = malloc(sizeof(qpms_sbessel_calculator_t));
c->akn = NULL; c->akn = NULL;
//c->bkn = NULL; //c->bkn = NULL;
c->lMax = -1; c->lMax = -1;
return c; return c;
} }
void qpms_sbessel_calculator_pfree(qpms_sbessel_calculator_t *c) { void qpms_sbessel_calculator_pfree(qpms_sbessel_calculator_t *c) {
if(c->akn) free(c->akn); if(c->akn) free(c->akn);
//if(c->bkn) free(c->bkn); //if(c->bkn) free(c->bkn);
free(c); free(c);
} }

258
qpms/legendre.c
View File

@ -8,151 +8,151 @@
// Legendre functions also for negative m, see DLMF 14.9.3 // Legendre functions also for negative m, see DLMF 14.9.3
qpms_errno_t qpms_legendre_deriv_y_fill(double *target, double *target_deriv, double x, qpms_l_t lMax, qpms_errno_t qpms_legendre_deriv_y_fill(double *target, double *target_deriv, double x, qpms_l_t lMax,
gsl_sf_legendre_t lnorm, double csphase) gsl_sf_legendre_t lnorm, double csphase)
{ {
size_t n = gsl_sf_legendre_array_n(lMax); size_t n = gsl_sf_legendre_array_n(lMax);
double *legendre_tmp = malloc(n * sizeof(double)); double *legendre_tmp = malloc(n * sizeof(double));
double *legendre_deriv_tmp = malloc(n * sizeof(double)); double *legendre_deriv_tmp = malloc(n * sizeof(double));
int gsl_errno = gsl_sf_legendre_deriv_array_e( int gsl_errno = gsl_sf_legendre_deriv_array_e(
lnorm, (size_t)lMax, x, csphase, legendre_tmp,legendre_deriv_tmp); lnorm, (size_t)lMax, x, csphase, legendre_tmp,legendre_deriv_tmp);
for (qpms_l_t l = 1; l <= lMax; ++l) for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 0; m <= l; ++m) { for (qpms_m_t m = 0; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(m,l); qpms_y_t y = qpms_mn2y(m,l);
size_t i = gsl_sf_legendre_array_index(l,m); size_t i = gsl_sf_legendre_array_index(l,m);
target[y] = legendre_tmp[i]; target[y] = legendre_tmp[i];
target_deriv[y] = legendre_deriv_tmp[i]; target_deriv[y] = legendre_deriv_tmp[i];
} }
switch(lnorm) { switch(lnorm) {
case GSL_SF_LEGENDRE_NONE: case GSL_SF_LEGENDRE_NONE:
for (qpms_l_t l = 1; l <= lMax; ++l) for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 1; m <= l; ++m) { for (qpms_m_t m = 1; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(-m,l); qpms_y_t y = qpms_mn2y(-m,l);
size_t i = gsl_sf_legendre_array_index(l,m); size_t i = gsl_sf_legendre_array_index(l,m);
// viz DLMF 14.9.3, čert ví, jak je to s cs fasí. // viz DLMF 14.9.3, čert ví, jak je to s cs fasí.
double factor = exp(lgamma(l-m+1)-lgamma(l+m+1))*((m%2)?-1:1); double factor = exp(lgamma(l-m+1)-lgamma(l+m+1))*((m%2)?-1:1);
target[y] = factor * legendre_tmp[i]; target[y] = factor * legendre_tmp[i];
target_deriv[y] = factor * legendre_deriv_tmp[i]; target_deriv[y] = factor * legendre_deriv_tmp[i];
}
break;
case GSL_SF_LEGENDRE_SCHMIDT:
case GSL_SF_LEGENDRE_SPHARM:
case GSL_SF_LEGENDRE_FULL:
for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 1; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(-m,l);
size_t i = gsl_sf_legendre_array_index(l,m);
// viz DLMF 14.9.3, čert ví, jak je to s cs fasí.
double factor = ((m%2)?-1:1); // this is the difference from the unnormalised case
target[y] = factor * legendre_tmp[i];
target_deriv[y] = factor * legendre_deriv_tmp[i];
}
break;
default:
abort(); //NI
break;
} }
free(legendre_tmp); break;
free(legendre_deriv_tmp); case GSL_SF_LEGENDRE_SCHMIDT:
return QPMS_SUCCESS; case GSL_SF_LEGENDRE_SPHARM:
case GSL_SF_LEGENDRE_FULL:
for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 1; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(-m,l);
size_t i = gsl_sf_legendre_array_index(l,m);
// viz DLMF 14.9.3, čert ví, jak je to s cs fasí.
double factor = ((m%2)?-1:1); // this is the difference from the unnormalised case
target[y] = factor * legendre_tmp[i];
target_deriv[y] = factor * legendre_deriv_tmp[i];
}
break;
default:
abort(); //NI
break;
}
free(legendre_tmp);
free(legendre_deriv_tmp);
return QPMS_SUCCESS;
} }
qpms_errno_t qpms_legendre_deriv_y_get(double **target, double **dtarget, double x, qpms_l_t lMax, gsl_sf_legendre_t lnorm, qpms_errno_t qpms_legendre_deriv_y_get(double **target, double **dtarget, double x, qpms_l_t lMax, gsl_sf_legendre_t lnorm,
double csphase) double csphase)
{ {
*target = malloc(sizeof(double)*qpms_lMax2nelem(lMax)); *target = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
*dtarget = malloc(sizeof(double)*qpms_lMax2nelem(lMax)); *dtarget = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
return qpms_legendre_deriv_y_fill(*target, *dtarget, x, lMax, lnorm, csphase); return qpms_legendre_deriv_y_fill(*target, *dtarget, x, lMax, lnorm, csphase);
} }
qpms_pitau_t qpms_pitau_get(double theta, qpms_l_t lMax, qpms_normalisation_t norm) qpms_pitau_t qpms_pitau_get(double theta, qpms_l_t lMax, qpms_normalisation_t norm)
{ {
const double csphase = qpms_normalisation_t_csphase(norm); const double csphase = qpms_normalisation_t_csphase(norm);
norm = qpms_normalisation_t_normonly(norm); norm = qpms_normalisation_t_normonly(norm);
qpms_pitau_t res; qpms_pitau_t res;
qpms_y_t nelem = qpms_lMax2nelem(lMax); qpms_y_t nelem = qpms_lMax2nelem(lMax);
res.pi = malloc(nelem * sizeof(double)); res.pi = malloc(nelem * sizeof(double));
res.tau = malloc(nelem * sizeof(double)); res.tau = malloc(nelem * sizeof(double));
double ct = cos(theta), st = sin(theta); double ct = cos(theta), st = sin(theta);
if (1 == fabs(ct)) { // singular case, use DLMF 14.8.2 if (1 == fabs(ct)) { // singular case, use DLMF 14.8.2
memset(res.pi, 0, nelem*sizeof(double)); memset(res.pi, 0, nelem*sizeof(double));
memset(res.tau, 0, nelem*sizeof(double)); memset(res.tau, 0, nelem*sizeof(double));
res.leg = calloc(nelem, sizeof(double)); res.leg = calloc(nelem, sizeof(double));
switch(norm) { switch(norm) {
case QPMS_NORMALISATION_XU: case QPMS_NORMALISATION_XU:
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_l_t l = 1; l <= lMax; ++l) {
res.leg[qpms_mn2y(0, l)] = (l%2)?ct:1.; res.leg[qpms_mn2y(0, l)] = (l%2)?ct:1.;
double p = l*(l+1)/2; double p = l*(l+1)/2;
const double n = 0.5; const double n = 0.5;
int lpar = (l%2)?-1:1; int lpar = (l%2)?-1:1;
res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * p * csphase; res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * p * csphase;
res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * n * csphase; res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * n * csphase;
res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * p * csphase; res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * p * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * n * csphase; res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * n * csphase;
} }
break; break;
case QPMS_NORMALISATION_TAYLOR: case QPMS_NORMALISATION_TAYLOR:
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_l_t l = 1; l <= lMax; ++l) {
res.leg[qpms_mn2y(0, l)] = ((l%2)?ct:1.)*sqrt((2*l+1)*0.25*M_1_PI); res.leg[qpms_mn2y(0, l)] = ((l%2)?ct:1.)*sqrt((2*l+1)*0.25*M_1_PI);
int lpar = (l%2)?-1:1; int lpar = (l%2)?-1:1;
double fl = 0.25 * sqrt((2*l+1)*l*(l+1)*M_1_PI); double fl = 0.25 * sqrt((2*l+1)*l*(l+1)*M_1_PI);
res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase; res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase;
res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase; res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase; res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase; res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase;
} }
break; break;
case QPMS_NORMALISATION_POWER: case QPMS_NORMALISATION_POWER:
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_l_t l = 1; l <= lMax; ++l) {
res.leg[qpms_mn2y(0, l)] = ((l%2)?ct:1.)*sqrt((2*l+1)/(4*M_PI *l*(l+1))); res.leg[qpms_mn2y(0, l)] = ((l%2)?ct:1.)*sqrt((2*l+1)/(4*M_PI *l*(l+1)));
int lpar = (l%2)?-1:1; int lpar = (l%2)?-1:1;
double fl = 0.25 * sqrt((2*l+1)*M_1_PI); double fl = 0.25 * sqrt((2*l+1)*M_1_PI);
res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase; res.pi [qpms_mn2y(+1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase;
res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase; res.pi [qpms_mn2y(-1, l)] = -((ct>0) ? -1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase; res.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase; res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase;
}
break;
default:
abort();
}
} }
else { // cos(theta) in (-1,1), use normal calculation break;
double *legder = malloc(sizeof(double)*qpms_lMax2nelem(lMax)); default:
res.leg = malloc(sizeof(double)*qpms_lMax2nelem(lMax)); abort();
if (qpms_legendre_deriv_y_fill(res.leg, legder, ct, lMax, }
norm == QPMS_NORMALISATION_XU ? GSL_SF_LEGENDRE_NONE }
: GSL_SF_LEGENDRE_SPHARM, csphase)) else { // cos(theta) in (-1,1), use normal calculation
abort(); double *legder = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
if (norm == QPMS_NORMALISATION_POWER) res.leg = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
/* for Xu (=non-normalized) and Taylor (=sph. harm. normalized) if (qpms_legendre_deriv_y_fill(res.leg, legder, ct, lMax,
* the correct normalisation is already obtained from gsl_sf_legendre_deriv_array_e(). norm == QPMS_NORMALISATION_XU ? GSL_SF_LEGENDRE_NONE
* However, Kristensson ("power") normalisation differs from Taylor : GSL_SF_LEGENDRE_SPHARM, csphase))
* by 1/sqrt(l*(l+1)) factor. abort();
*/ if (norm == QPMS_NORMALISATION_POWER)
for (qpms_l_t l = 1; l <= lMax; ++l) { /* for Xu (=non-normalized) and Taylor (=sph. harm. normalized)
double prefac = 1./sqrt(l*(l+1)); * the correct normalisation is already obtained from gsl_sf_legendre_deriv_array_e().
for (qpms_m_t m = -l; m <= l; ++m) { * However, Kristensson ("power") normalisation differs from Taylor
res.leg[qpms_mn2y(m,l)] *= prefac; * by 1/sqrt(l*(l+1)) factor.
legder[qpms_mn2y(m,l)] *= prefac; */
} for (qpms_l_t l = 1; l <= lMax; ++l) {
} double prefac = 1./sqrt(l*(l+1));
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_m_t m = -l; m <= l; ++m) {
for (qpms_m_t m = -l; m <= l; ++m) { res.leg[qpms_mn2y(m,l)] *= prefac;
res.pi [qpms_mn2y(m,l)] = m / st * res.leg[qpms_mn2y(m,l)]; legder[qpms_mn2y(m,l)] *= prefac;
res.tau[qpms_mn2y(m,l)] = - st * legder[qpms_mn2y(m,l)];
}
}
free(legder);
} }
res.lMax = lMax; }
return res; for (qpms_l_t l = 1; l <= lMax; ++l) {
for (qpms_m_t m = -l; m <= l; ++m) {
res.pi [qpms_mn2y(m,l)] = m / st * res.leg[qpms_mn2y(m,l)];
res.tau[qpms_mn2y(m,l)] = - st * legder[qpms_mn2y(m,l)];
}
}
free(legder);
}
res.lMax = lMax;
return res;
} }
void qpms_pitau_free(qpms_pitau_t x) { void qpms_pitau_free(qpms_pitau_t x) {
free(x.leg); free(x.leg);
free(x.pi); free(x.pi);
free(x.tau); free(x.tau);
} }

10
qpms/qpms_types.h
View File

@ -105,10 +105,10 @@ static inline double qpms_normalisation_t_factor_abssquare(qpms_normalisation_t
typedef enum { typedef enum {
QPMS_BESSEL_REGULAR = 1, // regular function j QPMS_BESSEL_REGULAR = 1, // regular function j
QPMS_BESSEL_SINGULAR = 2, // singular function y QPMS_BESSEL_SINGULAR = 2, // singular function y
QPMS_HANKEL_PLUS = 3, // hankel function h1 = j + I*y QPMS_HANKEL_PLUS = 3, // hankel function h1 = j + I*y
QPMS_HANKEL_MINUS = 4, // hankel function h2 = j - I*y QPMS_HANKEL_MINUS = 4, // hankel function h2 = j - I*y
QPMS_BESSEL_UNDEF = 0 QPMS_BESSEL_UNDEF = 0
} qpms_bessel_t; } qpms_bessel_t;
@ -131,7 +131,7 @@ typedef struct {
typedef struct { // Do I really need this??? typedef struct { // Do I really need this???
complex double r; complex double r;
double theta, phi; double theta, phi;
} csph_t; } csph_t;
// complex vector components in local spherical basis // complex vector components in local spherical basis

1851
qpms/translations.c
View File

File diff suppressed because it is too large Load Diff

34
qpms/translations.h
View File

@ -9,10 +9,10 @@
// TODO replace the xplicit "Taylor" functions with general, // TODO replace the xplicit "Taylor" functions with general,
// taking qpms_normalisation_t argument. // taking qpms_normalisation_t argument.
complex double qpms_trans_single_A_Taylor(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj, complex double qpms_trans_single_A_Taylor(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj,
bool r_ge_d, qpms_bessel_t J); bool r_ge_d, qpms_bessel_t J);
complex double qpms_trans_single_B_Taylor(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj, complex double qpms_trans_single_B_Taylor(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj,
bool r_ge_d, qpms_bessel_t J); bool r_ge_d, qpms_bessel_t J);
complex double qpms_trans_single_A_Taylor_ext(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, double kdlj_r, complex double qpms_trans_single_A_Taylor_ext(qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, double kdlj_r,
double kdlj_th, double kdlj_phi, int r_ge_d, int J); double kdlj_th, double kdlj_phi, int r_ge_d, int J);
@ -21,17 +21,17 @@ complex double qpms_trans_single_B_Taylor_ext(qpms_m_t m, qpms_l_t n, qpms_m_t m
double kdlj_th, double kdlj_phi, int r_ge_d, int J); double kdlj_th, double kdlj_phi, int r_ge_d, int J);
complex double qpms_trans_single_A(qpms_normalisation_t norm, qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj, complex double qpms_trans_single_A(qpms_normalisation_t norm, qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj,
bool r_ge_d, qpms_bessel_t J); bool r_ge_d, qpms_bessel_t J);
complex double qpms_trans_single_B(qpms_normalisation_t norm, qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj, complex double qpms_trans_single_B(qpms_normalisation_t norm, qpms_m_t m, qpms_l_t n, qpms_m_t mu, qpms_l_t nu, sph_t kdlj,
bool r_ge_d, qpms_bessel_t J); bool r_ge_d, qpms_bessel_t J);
typedef struct qpms_trans_calculator { typedef struct qpms_trans_calculator {
qpms_normalisation_t normalisation; qpms_normalisation_t normalisation;
qpms_l_t lMax; qpms_l_t lMax;
qpms_y_t nelem; qpms_y_t nelem;
complex double **A_multipliers; complex double **A_multipliers;
complex double **B_multipliers; complex double **B_multipliers;
#if 0 #if 0
// Normalised values of the Legendre functions and derivatives // Normalised values of the Legendre functions and derivatives
// for θ == π/2, i.e. for the 2D case. // for θ == π/2, i.e. for the 2D case.
@ -86,14 +86,14 @@ int qpms_trans_calculator_get_AB_arrays_ext(const qpms_trans_calculator *c,
#include <Python.h> #include <Python.h>
#include <numpy/npy_common.h> #include <numpy/npy_common.h>
int qpms_cython_trans_calculator_get_AB_arrays_loop( int qpms_cython_trans_calculator_get_AB_arrays_loop(
const qpms_trans_calculator *c, qpms_bessel_t J, const int resnd, const qpms_trans_calculator *c, qpms_bessel_t J, const int resnd,
int daxis, int saxis, int daxis, int saxis,
char *A_data, const npy_intp *A_shape, const npy_intp *A_strides, char *A_data, const npy_intp *A_shape, const npy_intp *A_strides,
char *B_data, const npy_intp *B_shape, const npy_intp *B_strides, char *B_data, const npy_intp *B_shape, const npy_intp *B_strides,
const char *r_data, const npy_intp *r_shape, const npy_intp *r_strides, const char *r_data, const npy_intp *r_shape, const npy_intp *r_strides,
const char *theta_data, const npy_intp *theta_shape, const npy_intp *theta_strides, const char *theta_data, const npy_intp *theta_shape, const npy_intp *theta_strides,
const char *phi_data, const npy_intp *phi_shape, const npy_intp *phi_strides, const char *phi_data, const npy_intp *phi_shape, const npy_intp *phi_strides,
const char *r_ge_d_data, const npy_intp *r_ge_d_shape, const npy_intp *r_ge_d_strides); const char *r_ge_d_data, const npy_intp *r_ge_d_shape, const npy_intp *r_ge_d_strides);
#endif //QPMS_COMPILE_PYTHON_EXTENSIONS #endif //QPMS_COMPILE_PYTHON_EXTENSIONS

24
qpms/vecprint.c
View File

@ -5,29 +5,29 @@
void print_csphvec(csphvec_t v) void print_csphvec(csphvec_t v)
{ {
printf("(%g+%gj)r̂ + (%g+%gj)θ̂ + (%g+%gj)φ̂", printf("(%g+%gj)r̂ + (%g+%gj)θ̂ + (%g+%gj)φ̂",
creal(v.rc), cimag(v.rc), creal(v.rc), cimag(v.rc),
creal(v.thetac), cimag(v.thetac), creal(v.thetac), cimag(v.thetac),
creal(v.phic), cimag(v.phic) creal(v.phic), cimag(v.phic)
); );
} }
void print_cart3(cart3_t v) void print_cart3(cart3_t v)
{ {
printf("%gx̂ + %gŷ + %gẑ", v.x, v.y, v.z); printf("%gx̂ + %gŷ + %gẑ", v.x, v.y, v.z);
} }
void print_ccart3(ccart3_t v) void print_ccart3(ccart3_t v)
{ {
printf("(%g+%gj)x̂ + (%g+%gj)ŷ + (%g+%gj)ẑ", printf("(%g+%gj)x̂ + (%g+%gj)ŷ + (%g+%gj)ẑ",
creal(v.x), cimag(v.x), creal(v.x), cimag(v.x),
creal(v.y), cimag(v.y), creal(v.y), cimag(v.y),
creal(v.z), cimag(v.z) creal(v.z), cimag(v.z)
); );
} }
void print_sph(sph_t r) void print_sph(sph_t r)
{ {
printf("(r=%g, θ=%g, φ=%g)", r.r, r.theta, r.phi); printf("(r=%g, θ=%g, φ=%g)", r.r, r.theta, r.phi);
} }

532
qpms/vswf.c
View File

@ -9,314 +9,314 @@
#include <string.h> #include <string.h>
csphvec_t qpms_vswf_single_el(qpms_m_t m, qpms_l_t l, sph_t kdlj, csphvec_t qpms_vswf_single_el(qpms_m_t m, qpms_l_t l, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm) { qpms_bessel_t btyp, qpms_normalisation_t norm) {
lmcheck(l,m); lmcheck(l,m);
csphvec_t N; csphvec_t N;
complex double *bessel = malloc((l+1)*sizeof(complex double)); complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort(); if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm); qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I); complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l); qpms_y_t y = qpms_mn2y(m,l);
N.rc = l*(l+1) * pt.leg[y] * bessel[l] / kdlj.r * eimf; N.rc = l*(l+1) * pt.leg[y] * bessel[l] / kdlj.r * eimf;
complex double besselfac = bessel[l-1] - l * bessel[l] / kdlj.r; complex double besselfac = bessel[l-1] - l * bessel[l] / kdlj.r;
N.thetac = pt.tau[y] * besselfac * eimf; N.thetac = pt.tau[y] * besselfac * eimf;
N.phic = pt.pi[y] * besselfac * I * eimf; N.phic = pt.pi[y] * besselfac * I * eimf;
qpms_pitau_free(pt); qpms_pitau_free(pt);
free(bessel); free(bessel);
return N; return N;
} }
csphvec_t qpms_vswf_single_mg(qpms_m_t m, qpms_l_t l, sph_t kdlj, csphvec_t qpms_vswf_single_mg(qpms_m_t m, qpms_l_t l, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm) { qpms_bessel_t btyp, qpms_normalisation_t norm) {
lmcheck(l,m); lmcheck(l,m);
csphvec_t M; csphvec_t M;
complex double *bessel = malloc((l+1)*sizeof(complex double)); complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort(); if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm); qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I); complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l); qpms_y_t y = qpms_mn2y(m,l);
M.rc = 0.; M.rc = 0.;
M.thetac = pt.pi[y] * bessel[l] * I * eimf; M.thetac = pt.pi[y] * bessel[l] * I * eimf;
M.phic = -pt.tau[y] * bessel[l] * eimf; M.phic = -pt.tau[y] * bessel[l] * eimf;
qpms_pitau_free(pt); qpms_pitau_free(pt);
free(bessel); free(bessel);
return M; return M;
} }
qpms_vswfset_sph_t *qpms_vswfset_make(qpms_l_t lMax, sph_t kdlj, qpms_vswfset_sph_t *qpms_vswfset_make(qpms_l_t lMax, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm) { qpms_bessel_t btyp, qpms_normalisation_t norm) {
qpms_vswfset_sph_t *res = malloc(sizeof(qpms_vswfset_sph_t)); qpms_vswfset_sph_t *res = malloc(sizeof(qpms_vswfset_sph_t));
res->lMax = lMax; res->lMax = lMax;
qpms_y_t nelem = qpms_lMax2nelem(lMax); qpms_y_t nelem = qpms_lMax2nelem(lMax);
res->el = malloc(sizeof(csphvec_t)*nelem); res->el = malloc(sizeof(csphvec_t)*nelem);
res->mg = malloc(sizeof(csphvec_t)*nelem); res->mg = malloc(sizeof(csphvec_t)*nelem);
if(QPMS_SUCCESS != qpms_vswf_fill(NULL, res->mg, res->el, lMax, kdlj, btyp, norm)) if(QPMS_SUCCESS != qpms_vswf_fill(NULL, res->mg, res->el, lMax, kdlj, btyp, norm))
abort(); // or return NULL? or rather assert? abort(); // or return NULL? or rather assert?
return res; return res;
} }
void qpms_vswfset_sph_pfree(qpms_vswfset_sph_t *w) { void qpms_vswfset_sph_pfree(qpms_vswfset_sph_t *w) {
assert(NULL != w && NULL != w->el && NULL != w->mg); assert(NULL != w && NULL != w->el && NULL != w->mg);
free(w->el); free(w->el);
free(w->mg); free(w->mg);
free(w); free(w);
} }
qpms_errno_t qpms_vswf_fill(csphvec_t *const longtarget, csphvec_t * const mgtarget, csphvec_t * const eltarget, qpms_errno_t qpms_vswf_fill(csphvec_t *const longtarget, csphvec_t * const mgtarget, csphvec_t * const eltarget,
qpms_l_t lMax, sph_t kr, qpms_l_t lMax, sph_t kr,
qpms_bessel_t btyp, qpms_normalisation_t norm) { qpms_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1); assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double)); complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort(); if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kr.theta, lMax, norm); qpms_pitau_t pt = qpms_pitau_get(kr.theta, lMax, norm);
complex double const *pbes = bessel + 1; // starting from l = 1 complex double const *pbes = bessel + 1; // starting from l = 1
double const *pleg = pt.leg; double const *pleg = pt.leg;
double const *ppi = pt.pi; double const *ppi = pt.pi;
double const *ptau = pt.tau; double const *ptau = pt.tau;
csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget; csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget;
for(qpms_l_t l = 1; l <= lMax; ++l) { for(qpms_l_t l = 1; l <= lMax; ++l) {
complex double besfac; complex double besfac;
complex double besderfac; complex double besderfac;
if (kr.r) { if (kr.r) {
besfac = *pbes / kr.r; besfac = *pbes / kr.r;
} else { } else {
besfac = (1 == l) ? 1/3. : 0; besfac = (1 == l) ? 1/3. : 0;
} }
besderfac = *(pbes-1) - l * besfac; besderfac = *(pbes-1) - l * besfac;
for(qpms_m_t m = -l; m <= l; ++m) { for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * kr.phi * I); complex double eimf = cexp(m * kr.phi * I);
if (longtarget) { if (longtarget) {
complex double longfac = sqrt(l*(l+1)) * eimf; complex double longfac = sqrt(l*(l+1)) * eimf;
plong->rc = // FATAL FIXME: I get wrong result here for plane wave re-expansion plong->rc = // FATAL FIXME: I get wrong result here for plane wave re-expansion
// whenever kr.r > 0 (for waves with longitudinal component, ofcoz) // whenever kr.r > 0 (for waves with longitudinal component, ofcoz)
/*(*(pbes-1) - (l+1)/kr.r* *pbes)*/ /*(*(pbes-1) - (l+1)/kr.r* *pbes)*/
(besderfac-besfac) (besderfac-besfac)
* (*pleg) * longfac; * (*pleg) * longfac;
plong->thetac = *ptau * besfac * longfac; plong->thetac = *ptau * besfac * longfac;
plong->phic = *ppi * I * besfac * longfac; plong->phic = *ppi * I * besfac * longfac;
++plong; ++plong;
} }
if (eltarget) { if (eltarget) {
pel->rc = l*(l+1) * (*pleg) * besfac * eimf; pel->rc = l*(l+1) * (*pleg) * besfac * eimf;
pel->thetac = *ptau * besderfac * eimf; pel->thetac = *ptau * besderfac * eimf;
pel->phic = *ppi * besderfac * I * eimf; pel->phic = *ppi * besderfac * I * eimf;
++pel; ++pel;
} }
if (mgtarget) { if (mgtarget) {
pmg->rc = 0.; pmg->rc = 0.;
pmg->thetac = *ppi * (*pbes) * I * eimf; pmg->thetac = *ppi * (*pbes) * I * eimf;
pmg->phic = - *ptau * (*pbes) * eimf; pmg->phic = - *ptau * (*pbes) * eimf;
++pmg; ++pmg;
} }
++pleg; ++ppi; ++ptau; ++pleg; ++ppi; ++ptau;
} }
++pbes; ++pbes;
} }
free(bessel); free(bessel);
qpms_pitau_free(pt); qpms_pitau_free(pt);
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
// consistency check: this should give the same results as the above function (up to rounding errors) // consistency check: this should give the same results as the above function (up to rounding errors)
qpms_errno_t qpms_vswf_fill_alternative(csphvec_t *const longtarget, csphvec_t * const mgtarget, csphvec_t * const eltarget, qpms_errno_t qpms_vswf_fill_alternative(csphvec_t *const longtarget, csphvec_t * const mgtarget, csphvec_t * const eltarget,
qpms_l_t lMax, sph_t kr, qpms_l_t lMax, sph_t kr,
qpms_bessel_t btyp, qpms_normalisation_t norm) { qpms_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1); assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double)); complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort(); if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
complex double const *pbes = bessel + 1; // starting from l = 1 complex double const *pbes = bessel + 1; // starting from l = 1
qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t * const a1 = malloc(3*nelem*sizeof(csphvec_t)), * const a2 = a1 + nelem, * const a3 = a2 + nelem;
if(qpms_vecspharm_fill(a1, a2, a3, lMax, kr, norm)) abort();
const csphvec_t *p1 = a1;
const csphvec_t *p2 = a2;
const csphvec_t *p3 = a3;
csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget; qpms_y_t nelem = qpms_lMax2nelem(lMax);
for(qpms_l_t l = 1; l <= lMax; ++l) { csphvec_t * const a1 = malloc(3*nelem*sizeof(csphvec_t)), * const a2 = a1 + nelem, * const a3 = a2 + nelem;
complex double besfac = *pbes / kr.r; if(qpms_vecspharm_fill(a1, a2, a3, lMax, kr, norm)) abort();
complex double besderfac = *(pbes-1) - l * besfac; const csphvec_t *p1 = a1;
double sqrtlfac = sqrt(l*(l+1)); const csphvec_t *p2 = a2;
for(qpms_m_t m = -l; m <= l; ++m) { const csphvec_t *p3 = a3;
complex double eimf = cexp(m * kr.phi * I);
if (longtarget) { csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget;
*plong = csphvec_add(csphvec_scale(besderfac-besfac, *p3), for(qpms_l_t l = 1; l <= lMax; ++l) {
csphvec_scale(sqrtlfac * besfac, *p2)); complex double besfac = *pbes / kr.r;
++plong; complex double besderfac = *(pbes-1) - l * besfac;
} double sqrtlfac = sqrt(l*(l+1));
if (eltarget) { for(qpms_m_t m = -l; m <= l; ++m) {
*pel = csphvec_add(csphvec_scale(besderfac, *p2), complex double eimf = cexp(m * kr.phi * I);
csphvec_scale(sqrtlfac * besfac, *p3)); if (longtarget) {
++pel; *plong = csphvec_add(csphvec_scale(besderfac-besfac, *p3),
} csphvec_scale(sqrtlfac * besfac, *p2));
if (mgtarget) { ++plong;
*pmg = csphvec_scale(*pbes, *p1); }
++pmg; if (eltarget) {
} *pel = csphvec_add(csphvec_scale(besderfac, *p2),
++p1; ++p2; ++p3; csphvec_scale(sqrtlfac * besfac, *p3));
} ++pel;
++pbes; }
} if (mgtarget) {
free(a1); *pmg = csphvec_scale(*pbes, *p1);
free(bessel); ++pmg;
return QPMS_SUCCESS; }
++p1; ++p2; ++p3;
}
++pbes;
}
free(a1);
free(bessel);
return QPMS_SUCCESS;
} }
qpms_errno_t qpms_vecspharm_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target, qpms_errno_t qpms_vecspharm_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target,
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) { qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) {
assert(lMax >= 1); assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm); qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg; double const *pleg = pt.leg;
double const *ppi = pt.pi; double const *ppi = pt.pi;
double const *ptau = pt.tau; double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target; csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_l_t l = 1; l <= lMax; ++l) {
for(qpms_m_t m = -l; m <= l; ++m) { for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * dir.phi * I); complex double eimf = cexp(m * dir.phi * I);
if (a1target) { if (a1target) {
p1->rc = 0; p1->rc = 0;
p1->thetac = *ppi * I * eimf; p1->thetac = *ppi * I * eimf;
p1->phic = -*ptau * eimf; p1->phic = -*ptau * eimf;
++p1; ++p1;
} }
if (a2target) { if (a2target) {
p2->rc = 0; p2->rc = 0;
p2->thetac = *ptau * eimf; p2->thetac = *ptau * eimf;
p2->phic = *ppi * I * eimf; p2->phic = *ppi * I * eimf;
++p2; ++p2;
} }
if (a3target) { if (a3target) {
p3->rc = sqrt(l*(l+1)) * (*pleg) * eimf; p3->rc = sqrt(l*(l+1)) * (*pleg) * eimf;
p3->thetac = 0; p3->thetac = 0;
p3->phic = 0; p3->phic = 0;
++p3; ++p3;
} }
} }
++pleg; ++ppi; ++ptau; ++pleg; ++ppi; ++ptau;
} }
qpms_pitau_free(pt); qpms_pitau_free(pt);
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
qpms_errno_t qpms_vecspharm_dual_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target, qpms_errno_t qpms_vecspharm_dual_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target,
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) { qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) {
assert(lMax >= 1); assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm); qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg; double const *pleg = pt.leg;
double const *ppi = pt.pi; double const *ppi = pt.pi;
double const *ptau = pt.tau; double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target; csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for(qpms_l_t l = 1; l <= lMax; ++l) { for(qpms_l_t l = 1; l <= lMax; ++l) {
for(qpms_m_t m = -l; m <= l; ++m) { for(qpms_m_t m = -l; m <= l; ++m) {
double normfac = 1./qpms_normalisation_t_factor_abssquare(norm, l, m); // factor w.r.t. Kristensson double normfac = 1./qpms_normalisation_t_factor_abssquare(norm, l, m); // factor w.r.t. Kristensson
complex double eimf = cexp(m * dir.phi * I); complex double eimf = cexp(m * dir.phi * I);
if (a1target) { if (a1target) {
p1->rc = 0; p1->rc = 0;
p1->thetac = conj(*ppi * normfac * I * eimf); p1->thetac = conj(*ppi * normfac * I * eimf);
p1->phic = conj(-*ptau * normfac * eimf); p1->phic = conj(-*ptau * normfac * eimf);
++p1; ++p1;
} }
if (a2target) { if (a2target) {
p2->rc = 0; p2->rc = 0;
p2->thetac = conj(*ptau * normfac * eimf); p2->thetac = conj(*ptau * normfac * eimf);
p2->phic = conj(*ppi * normfac * I * eimf); p2->phic = conj(*ppi * normfac * I * eimf);
++p2; ++p2;
} }
if (a3target) { if (a3target) {
p3->rc = conj(sqrt(l*(l+1)) * (*pleg) * normfac * eimf); p3->rc = conj(sqrt(l*(l+1)) * (*pleg) * normfac * eimf);
p3->thetac = 0; p3->thetac = 0;
p3->phic = 0; p3->phic = 0;
++p3; ++p3;
} }
++pleg; ++ppi; ++ptau; ++pleg; ++ppi; ++ptau;
} }
} }
qpms_pitau_free(pt); qpms_pitau_free(pt);
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
static inline complex double ipowl(qpms_l_t l) { static inline complex double ipowl(qpms_l_t l) {
switch(l % 4) { switch(l % 4) {
case 0: return 1; case 0: return 1;
break; break;
case 1: return I; case 1: return I;
break; break;
case 2: return -1; case 2: return -1;
break; break;
case 3: return -I; case 3: return -I;
break; break;
default: abort(); default: abort();
} }
assert(0); assert(0);
} }
qpms_errno_t qpms_planewave2vswf_fill_sph(sph_t wavedir, csphvec_t amplitude, qpms_errno_t qpms_planewave2vswf_fill_sph(sph_t wavedir, csphvec_t amplitude,
complex double *target_longcoeff, complex double *target_mgcoeff, complex double *target_longcoeff, complex double *target_mgcoeff,
complex double *target_elcoeff, qpms_l_t lMax, qpms_normalisation_t norm) { complex double *target_elcoeff, qpms_l_t lMax, qpms_normalisation_t norm) {
qpms_y_t nelem = qpms_lMax2nelem(lMax); qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t * const dual_A1 = malloc(3*nelem*sizeof(csphvec_t)), *const dual_A2 = dual_A1 + nelem, csphvec_t * const dual_A1 = malloc(3*nelem*sizeof(csphvec_t)), *const dual_A2 = dual_A1 + nelem,
* const dual_A3 = dual_A2 + nelem; * const dual_A3 = dual_A2 + nelem;
if (QPMS_SUCCESS != qpms_vecspharm_dual_fill(dual_A1, dual_A2, dual_A3, lMax, wavedir, norm)) if (QPMS_SUCCESS != qpms_vecspharm_dual_fill(dual_A1, dual_A2, dual_A3, lMax, wavedir, norm))
abort(); abort();
const csphvec_t *pA1 = dual_A1, *pA2 = dual_A2, *pA3 = dual_A3; const csphvec_t *pA1 = dual_A1, *pA2 = dual_A2, *pA3 = dual_A3;
complex double *plong = target_longcoeff, *pmg = target_mgcoeff, *pel = target_elcoeff; complex double *plong = target_longcoeff, *pmg = target_mgcoeff, *pel = target_elcoeff;
for (qpms_l_t l = 1; l <= lMax; ++l) { for (qpms_l_t l = 1; l <= lMax; ++l) {
complex double prefac1 = 4 * M_PI * ipowl(l); complex double prefac1 = 4 * M_PI * ipowl(l);
complex double prefac23 = - 4 * M_PI * ipowl(l+1); complex double prefac23 = - 4 * M_PI * ipowl(l+1);
for (qpms_m_t m = -l; m <= l; ++m) { for (qpms_m_t m = -l; m <= l; ++m) {
*plong = prefac23 * csphvec_dotnc(*pA3, amplitude); *plong = prefac23 * csphvec_dotnc(*pA3, amplitude);
*pmg = prefac1 * csphvec_dotnc(*pA1, amplitude); *pmg = prefac1 * csphvec_dotnc(*pA1, amplitude);
*pel = prefac23 * csphvec_dotnc(*pA2, amplitude); *pel = prefac23 * csphvec_dotnc(*pA2, amplitude);
++pA1; ++pA2; ++pA3; ++plong; ++pmg; ++pel; ++pA1; ++pA2; ++pA3; ++plong; ++pmg; ++pel;
} }
} }
free(dual_A1); free(dual_A1);
return QPMS_SUCCESS; return QPMS_SUCCESS;
} }
qpms_errno_t qpms_planewave2vswf_fill_cart(cart3_t wavedir_cart /*allow complex k?*/, ccart3_t amplitude_cart, qpms_errno_t qpms_planewave2vswf_fill_cart(cart3_t wavedir_cart /*allow complex k?*/, ccart3_t amplitude_cart,
complex double * const longcoeff, complex double * const mgcoeff, complex double * const longcoeff, complex double * const mgcoeff,
complex double * const elcoeff, qpms_l_t lMax, qpms_normalisation_t norm) complex double * const elcoeff, qpms_l_t lMax, qpms_normalisation_t norm)
{ {
sph_t wavedir_sph = cart2sph(wavedir_cart); sph_t wavedir_sph = cart2sph(wavedir_cart);
csphvec_t amplitude_sphvec = ccart2csphvec(amplitude_cart, wavedir_sph); csphvec_t amplitude_sphvec = ccart2csphvec(amplitude_cart, wavedir_sph);
return qpms_planewave2vswf_fill_sph(wavedir_sph, amplitude_sphvec, return qpms_planewave2vswf_fill_sph(wavedir_sph, amplitude_sphvec,
longcoeff, mgcoeff, elcoeff, lMax, norm); longcoeff, mgcoeff, elcoeff, lMax, norm);
} }
csphvec_t qpms_eval_vswf(sph_t kr, csphvec_t qpms_eval_vswf(sph_t kr,
complex double * const lc, complex double *const mc, complex double *const ec, complex double * const lc, complex double *const mc, complex double *const ec,
qpms_l_t lMax, qpms_bessel_t btyp, qpms_normalisation_t norm) qpms_l_t lMax, qpms_bessel_t btyp, qpms_normalisation_t norm)
{ {
qpms_y_t nelem = qpms_lMax2nelem(lMax); qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t lsum, msum, esum, lcomp, mcomp, ecomp; csphvec_t lsum, msum, esum, lcomp, mcomp, ecomp;
csphvec_kahaninit(&lsum, &lcomp); csphvec_kahaninit(&lsum, &lcomp);
csphvec_kahaninit(&msum, &mcomp); csphvec_kahaninit(&msum, &mcomp);
csphvec_kahaninit(&esum, &ecomp); csphvec_kahaninit(&esum, &ecomp);
csphvec_t *lset = NULL, *mset = NULL, *eset = NULL; csphvec_t *lset = NULL, *mset = NULL, *eset = NULL;
if(lc) lset = malloc(nelem * sizeof(csphvec_t)); if(lc) lset = malloc(nelem * sizeof(csphvec_t));
if(mc) mset = malloc(nelem * sizeof(csphvec_t)); if(mc) mset = malloc(nelem * sizeof(csphvec_t));
if(ec) eset = malloc(nelem * sizeof(csphvec_t)); if(ec) eset = malloc(nelem * sizeof(csphvec_t));
qpms_vswf_fill(lset, mset, eset, lMax, kr, btyp, norm); qpms_vswf_fill(lset, mset, eset, lMax, kr, btyp, norm);
if(lc) for(qpms_y_t y = 0; y < nelem; ++y) if(lc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&lsum, &lcomp, csphvec_scale(lc[y], lset[y])); csphvec_kahanadd(&lsum, &lcomp, csphvec_scale(lc[y], lset[y]));
if(mc) for(qpms_y_t y = 0; y < nelem; ++y) if(mc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&msum, &mcomp, csphvec_scale(mc[y], mset[y])); csphvec_kahanadd(&msum, &mcomp, csphvec_scale(mc[y], mset[y]));
if(ec) for(qpms_y_t y = 0; y < nelem; ++y) if(ec) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&esum, &ecomp, csphvec_scale(ec[y], eset[y])); csphvec_kahanadd(&esum, &ecomp, csphvec_scale(ec[y], eset[y]));
if(lc) free(lset); if(lc) free(lset);
if(mc) free(mset); if(mc) free(mset);
if(ec) free(eset); if(ec) free(eset);
//return csphvec_add(esum, csphvec_add(msum, lsum)); //return csphvec_add(esum, csphvec_add(msum, lsum));
csphvec_kahanadd(&esum, &ecomp, msum); csphvec_kahanadd(&esum, &ecomp, msum);
csphvec_kahanadd(&esum, &ecomp, lsum); csphvec_kahanadd(&esum, &ecomp, lsum);
return esum; return esum;
} }

10
qpms/vswf.h
View File

@ -5,10 +5,10 @@
// Electric wave N; NI // Electric wave N; NI
csphvec_t qpms_vswf_single_el(int m, int n, sph_t kdlj, csphvec_t qpms_vswf_single_el(int m, int n, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm); qpms_bessel_t btyp, qpms_normalisation_t norm);
// Magnetic wave M; NI // Magnetic wave M; NI
csphvec_t qpms_vswf_single_mg(int m, int n, sph_t kdlj, csphvec_t qpms_vswf_single_mg(int m, int n, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm); qpms_bessel_t btyp, qpms_normalisation_t norm);
// Set of electric and magnetic VSWF in spherical coordinate basis // Set of electric and magnetic VSWF in spherical coordinate basis
typedef struct { typedef struct {
@ -39,9 +39,9 @@ qpms_errno_t qpms_vswf_fill_alternative(csphvec_t *resultL, csphvec_t *resultM,
qpms_bessel_t btyp, qpms_normalisation_t norm); qpms_bessel_t btyp, qpms_normalisation_t norm);
qpms_errno_t qpms_vecspharm_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target, qpms_errno_t qpms_vecspharm_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target,
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm); qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm);
qpms_errno_t qpms_vecspharm_dual_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target, qpms_errno_t qpms_vecspharm_dual_fill(csphvec_t *const a1target, csphvec_t *const a2target, csphvec_t *const a3target,
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm); qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm);
qpms_errno_t qpms_planewave2vswf_fill_cart(cart3_t wavedir, ccart3_t amplitude, qpms_errno_t qpms_planewave2vswf_fill_cart(cart3_t wavedir, ccart3_t amplitude,
complex double *targt_longcoeff, complex double *target_mgcoeff, complex double *target_elcoeff, complex double *targt_longcoeff, complex double *target_mgcoeff, complex double *target_elcoeff,
@ -57,7 +57,7 @@ csphvec_t qpms_eval_vswf(sph_t where,
qpms_vswfset_sph_t *qpms_vswfset_make(qpms_l_t lMax, sph_t kdlj, qpms_vswfset_sph_t *qpms_vswfset_make(qpms_l_t lMax, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm);//NI qpms_bessel_t btyp, qpms_normalisation_t norm);//NI
void qpms_vswfset_sph_pfree(qpms_vswfset_sph_t *);//NI void qpms_vswfset_sph_pfree(qpms_vswfset_sph_t *);//NI
#endif // QPMS_VSWF_H #endif // QPMS_VSWF_H