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
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
qpms_errno_t qpms_sph_bessel_fill(qpms_bessel_t typ, qpms_l_t lmax, double x, complex double *result_array) {
int retval;
double tmparr[lmax+1];
switch(typ) {
case QPMS_BESSEL_REGULAR:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval;
break;
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);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval;
break;
case QPMS_HANKEL_PLUS:
case QPMS_HANKEL_MINUS:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
if(retval) return retval;
retval = gsl_sf_bessel_yl_array(lmax, x, tmparr);
if (typ==QPMS_HANKEL_PLUS)
for (int l = 0; l <= lmax; ++l) result_array[l] += I * tmparr[l];
else
for (int l = 0; l <= lmax; ++l) result_array[l] +=-I * tmparr[l];
return retval;
break;
default:
abort();
//return GSL_EDOM;
}
assert(0);
int retval;
double tmparr[lmax+1];
switch(typ) {
case QPMS_BESSEL_REGULAR:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval;
break;
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);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
return retval;
break;
case QPMS_HANKEL_PLUS:
case QPMS_HANKEL_MINUS:
retval = gsl_sf_bessel_jl_steed_array(lmax, x, tmparr);
for (int l = 0; l <= lmax; ++l) result_array[l] = tmparr[l];
if(retval) return retval;
retval = gsl_sf_bessel_yl_array(lmax, x, tmparr);
if (typ==QPMS_HANKEL_PLUS)
for (int l = 0; l <= lmax; ++l) result_array[l] += I * tmparr[l];
else
for (int l = 0; l <= lmax; ++l) result_array[l] +=-I * tmparr[l];
return retval;
break;
default:
abort();
//return GSL_EDOM;
}
assert(0);
}
static inline ptrdiff_t akn_index(qpms_l_t n, qpms_l_t k) {
assert(k <= n);
return ((ptrdiff_t) n + 1) * n / 2 + k;
assert(k <= n);
return ((ptrdiff_t) n + 1) * n / 2 + k;
}
static inline ptrdiff_t bkn_index(qpms_l_t n, qpms_l_t k) {
assert(k <= n+1);
return ((ptrdiff_t) n + 2) * (n + 1) / 2 - 1 + k;
assert(k <= n+1);
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) {
if (lMax <= c->lMax)
return QPMS_SUCCESS;
else {
if ( NULL == (c->akn = realloc(c->akn, sizeof(double) * akn_index(lMax + 2, 0))))
abort();
//if ( NULL == (c->bkn = realloc(c->bkn, sizeof(complex double) * bkn_index(lMax + 1, 0))))
// abort();
for(qpms_l_t n = c->lMax+1; n <= lMax + 1; ++n)
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));
// ... TODO derivace
c->lMax = lMax;
return QPMS_SUCCESS;
}
if (lMax <= c->lMax)
return QPMS_SUCCESS;
else {
if ( NULL == (c->akn = realloc(c->akn, sizeof(double) * akn_index(lMax + 2, 0))))
abort();
//if ( NULL == (c->bkn = realloc(c->bkn, sizeof(complex double) * bkn_index(lMax + 1, 0))))
// abort();
for(qpms_l_t n = c->lMax+1; n <= lMax + 1; ++n)
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));
// ... TODO derivace
c->lMax = lMax;
return QPMS_SUCCESS;
}
}
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))
abort();
complex double z = I/x; // FIXME this should be imaginary double, but gcc is broken?
complex double result = 0;
for (qpms_l_t k = n; k >= 0; --k)
// can we use fma for complex?
//result = fma(result, z, c->akn(n, k));
result = result * z + c->akn[akn_index(n,k)];
result *= z * ipow(-n-2) * cexp(I * x);
return result;
if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, n))
abort();
complex double z = I/x; // FIXME this should be imaginary double, but gcc is broken?
complex double result = 0;
for (qpms_l_t k = n; k >= 0; --k)
// can we use fma for complex?
//result = fma(result, z, c->akn(n, k));
result = result * z + c->akn[akn_index(n,k)];
result *= z * ipow(-n-2) * cexp(I * x);
return result;
}
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) {
if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, lMax))
abort();
memset(target, 0, sizeof(complex double) * lMax);
complex double kahancomp[lMax];
memset(kahancomp, 0, sizeof(complex double) * lMax);
for(qpms_l_t k = 0; k <= lMax; ++k){
double xp = pow(x, -k-1);
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));
}
complex double eix = cexp(I * x);
for (qpms_l_t l = 0; l <= lMax; ++l)
target[l] *= eix;
return QPMS_SUCCESS;
const qpms_l_t lMax, const double x, complex double * const target) {
if(QPMS_SUCCESS != qpms_sbessel_calculator_ensure_lMax(c, lMax))
abort();
memset(target, 0, sizeof(complex double) * lMax);
complex double kahancomp[lMax];
memset(kahancomp, 0, sizeof(complex double) * lMax);
for(qpms_l_t k = 0; k <= lMax; ++k){
double xp = pow(x, -k-1);
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));
}
complex double eix = cexp(I * x);
for (qpms_l_t l = 0; l <= lMax; ++l)
target[l] *= eix;
return QPMS_SUCCESS;
}
qpms_sbessel_calculator_t *qpms_sbessel_calculator_init() {
qpms_sbessel_calculator_t *c = malloc(sizeof(qpms_sbessel_calculator_t));
c->akn = NULL;
//c->bkn = NULL;
c->lMax = -1;
return c;
qpms_sbessel_calculator_t *c = malloc(sizeof(qpms_sbessel_calculator_t));
c->akn = NULL;
//c->bkn = NULL;
c->lMax = -1;
return c;
}
void qpms_sbessel_calculator_pfree(qpms_sbessel_calculator_t *c) {
if(c->akn) free(c->akn);
//if(c->bkn) free(c->bkn);
free(c);
if(c->akn) free(c->akn);
//if(c->bkn) free(c->bkn);
free(c);
}

258
qpms/legendre.c
View File

@ -8,151 +8,151 @@
// 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,
gsl_sf_legendre_t lnorm, double csphase)
gsl_sf_legendre_t lnorm, double csphase)
{
size_t n = gsl_sf_legendre_array_n(lMax);
double *legendre_tmp = malloc(n * sizeof(double));
double *legendre_deriv_tmp = malloc(n * sizeof(double));
int gsl_errno = gsl_sf_legendre_deriv_array_e(
lnorm, (size_t)lMax, x, csphase, legendre_tmp,legendre_deriv_tmp);
for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 0; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(m,l);
size_t i = gsl_sf_legendre_array_index(l,m);
target[y] = legendre_tmp[i];
target_deriv[y] = legendre_deriv_tmp[i];
}
switch(lnorm) {
case GSL_SF_LEGENDRE_NONE:
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 = exp(lgamma(l-m+1)-lgamma(l+m+1))*((m%2)?-1:1);
target[y] = factor * legendre_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;
size_t n = gsl_sf_legendre_array_n(lMax);
double *legendre_tmp = malloc(n * sizeof(double));
double *legendre_deriv_tmp = malloc(n * sizeof(double));
int gsl_errno = gsl_sf_legendre_deriv_array_e(
lnorm, (size_t)lMax, x, csphase, legendre_tmp,legendre_deriv_tmp);
for (qpms_l_t l = 1; l <= lMax; ++l)
for (qpms_m_t m = 0; m <= l; ++m) {
qpms_y_t y = qpms_mn2y(m,l);
size_t i = gsl_sf_legendre_array_index(l,m);
target[y] = legendre_tmp[i];
target_deriv[y] = legendre_deriv_tmp[i];
}
switch(lnorm) {
case GSL_SF_LEGENDRE_NONE:
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 = exp(lgamma(l-m+1)-lgamma(l+m+1))*((m%2)?-1:1);
target[y] = factor * legendre_tmp[i];
target_deriv[y] = factor * legendre_deriv_tmp[i];
}
free(legendre_tmp);
free(legendre_deriv_tmp);
return QPMS_SUCCESS;
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);
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,
double csphase)
double csphase)
{
*target = 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);
*target = 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);
}
qpms_pitau_t qpms_pitau_get(double theta, qpms_l_t lMax, qpms_normalisation_t norm)
{
const double csphase = qpms_normalisation_t_csphase(norm);
norm = qpms_normalisation_t_normonly(norm);
qpms_pitau_t res;
qpms_y_t nelem = qpms_lMax2nelem(lMax);
res.pi = malloc(nelem * sizeof(double));
res.tau = malloc(nelem * sizeof(double));
double ct = cos(theta), st = sin(theta);
if (1 == fabs(ct)) { // singular case, use DLMF 14.8.2
memset(res.pi, 0, nelem*sizeof(double));
memset(res.tau, 0, nelem*sizeof(double));
res.leg = calloc(nelem, sizeof(double));
switch(norm) {
case QPMS_NORMALISATION_XU:
for (qpms_l_t l = 1; l <= lMax; ++l) {
res.leg[qpms_mn2y(0, l)] = (l%2)?ct:1.;
double p = l*(l+1)/2;
const double n = 0.5;
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) * n * 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;
}
break;
case QPMS_NORMALISATION_TAYLOR:
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);
int lpar = (l%2)?-1:1;
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.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase;
}
break;
case QPMS_NORMALISATION_POWER:
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)));
int lpar = (l%2)?-1:1;
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.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase;
const double csphase = qpms_normalisation_t_csphase(norm);
norm = qpms_normalisation_t_normonly(norm);
qpms_pitau_t res;
qpms_y_t nelem = qpms_lMax2nelem(lMax);
res.pi = malloc(nelem * sizeof(double));
res.tau = malloc(nelem * sizeof(double));
double ct = cos(theta), st = sin(theta);
if (1 == fabs(ct)) { // singular case, use DLMF 14.8.2
memset(res.pi, 0, nelem*sizeof(double));
memset(res.tau, 0, nelem*sizeof(double));
res.leg = calloc(nelem, sizeof(double));
switch(norm) {
case QPMS_NORMALISATION_XU:
for (qpms_l_t l = 1; l <= lMax; ++l) {
res.leg[qpms_mn2y(0, l)] = (l%2)?ct:1.;
double p = l*(l+1)/2;
const double n = 0.5;
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) * n * 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;
}
break;
case QPMS_NORMALISATION_TAYLOR:
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);
int lpar = (l%2)?-1:1;
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.tau[qpms_mn2y(+1, l)] = ((ct>0) ? +1 : lpar) * fl * csphase;
res.tau[qpms_mn2y(-1, l)] = -((ct>0) ? +1 : lpar) * fl * csphase;
}
break;
case QPMS_NORMALISATION_POWER:
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)));
int lpar = (l%2)?-1:1;
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.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
double *legder = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
res.leg = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
if (qpms_legendre_deriv_y_fill(res.leg, legder, ct, lMax,
norm == QPMS_NORMALISATION_XU ? GSL_SF_LEGENDRE_NONE
: GSL_SF_LEGENDRE_SPHARM, csphase))
abort();
if (norm == QPMS_NORMALISATION_POWER)
/* for Xu (=non-normalized) and Taylor (=sph. harm. normalized)
* the correct normalisation is already obtained from gsl_sf_legendre_deriv_array_e().
* However, Kristensson ("power") normalisation differs from Taylor
* by 1/sqrt(l*(l+1)) factor.
*/
for (qpms_l_t l = 1; l <= lMax; ++l) {
double prefac = 1./sqrt(l*(l+1));
for (qpms_m_t m = -l; m <= l; ++m) {
res.leg[qpms_mn2y(m,l)] *= prefac;
legder[qpms_mn2y(m,l)] *= prefac;
}
}
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);
break;
default:
abort();
}
}
else { // cos(theta) in (-1,1), use normal calculation
double *legder = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
res.leg = malloc(sizeof(double)*qpms_lMax2nelem(lMax));
if (qpms_legendre_deriv_y_fill(res.leg, legder, ct, lMax,
norm == QPMS_NORMALISATION_XU ? GSL_SF_LEGENDRE_NONE
: GSL_SF_LEGENDRE_SPHARM, csphase))
abort();
if (norm == QPMS_NORMALISATION_POWER)
/* for Xu (=non-normalized) and Taylor (=sph. harm. normalized)
* the correct normalisation is already obtained from gsl_sf_legendre_deriv_array_e().
* However, Kristensson ("power") normalisation differs from Taylor
* by 1/sqrt(l*(l+1)) factor.
*/
for (qpms_l_t l = 1; l <= lMax; ++l) {
double prefac = 1./sqrt(l*(l+1));
for (qpms_m_t m = -l; m <= l; ++m) {
res.leg[qpms_mn2y(m,l)] *= prefac;
legder[qpms_mn2y(m,l)] *= prefac;
}
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) {
free(x.leg);
free(x.pi);
free(x.tau);
free(x.leg);
free(x.pi);
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 {
QPMS_BESSEL_REGULAR = 1, // regular function j
QPMS_BESSEL_SINGULAR = 2, // singular function y
QPMS_HANKEL_PLUS = 3, // hankel function h1 = j + I*y
QPMS_HANKEL_MINUS = 4, // hankel function h2 = j - I*y
QPMS_BESSEL_REGULAR = 1, // regular function j
QPMS_BESSEL_SINGULAR = 2, // singular function y
QPMS_HANKEL_PLUS = 3, // hankel function h1 = j + I*y
QPMS_HANKEL_MINUS = 4, // hankel function h2 = j - I*y
QPMS_BESSEL_UNDEF = 0
} qpms_bessel_t;
@ -131,7 +131,7 @@ typedef struct {
typedef struct { // Do I really need this???
complex double r;
double theta, phi;
double theta, phi;
} csph_t;
// 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,
// 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,
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,
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,
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);
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,
bool r_ge_d, qpms_bessel_t J);
bool r_ge_d, qpms_bessel_t J);
typedef struct qpms_trans_calculator {
qpms_normalisation_t normalisation;
qpms_l_t lMax;
qpms_y_t nelem;
complex double **A_multipliers;
complex double **B_multipliers;
qpms_normalisation_t normalisation;
qpms_l_t lMax;
qpms_y_t nelem;
complex double **A_multipliers;
complex double **B_multipliers;
#if 0
// Normalised values of the Legendre functions and derivatives
// 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 <numpy/npy_common.h>
int qpms_cython_trans_calculator_get_AB_arrays_loop(
const qpms_trans_calculator *c, qpms_bessel_t J, const int resnd,
int daxis, int saxis,
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,
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 *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 qpms_trans_calculator *c, qpms_bessel_t J, const int resnd,
int daxis, int saxis,
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,
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 *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);
#endif //QPMS_COMPILE_PYTHON_EXTENSIONS

24
qpms/vecprint.c
View File

@ -5,29 +5,29 @@
void print_csphvec(csphvec_t v)
{
printf("(%g+%gj)r̂ + (%g+%gj)θ̂ + (%g+%gj)φ̂",
creal(v.rc), cimag(v.rc),
creal(v.thetac), cimag(v.thetac),
creal(v.phic), cimag(v.phic)
);
printf("(%g+%gj)r̂ + (%g+%gj)θ̂ + (%g+%gj)φ̂",
creal(v.rc), cimag(v.rc),
creal(v.thetac), cimag(v.thetac),
creal(v.phic), cimag(v.phic)
);
}
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)
{
printf("(%g+%gj)x̂ + (%g+%gj)ŷ + (%g+%gj)ẑ",
creal(v.x), cimag(v.x),
creal(v.y), cimag(v.y),
creal(v.z), cimag(v.z)
);
printf("(%g+%gj)x̂ + (%g+%gj)ŷ + (%g+%gj)ẑ",
creal(v.x), cimag(v.x),
creal(v.y), cimag(v.y),
creal(v.z), cimag(v.z)
);
}
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>
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) {
lmcheck(l,m);
csphvec_t N;
complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l);
qpms_bessel_t btyp, qpms_normalisation_t norm) {
lmcheck(l,m);
csphvec_t N;
complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l);
N.rc = l*(l+1) * pt.leg[y] * bessel[l] / kdlj.r * eimf;
complex double besselfac = bessel[l-1] - l * bessel[l] / kdlj.r;
N.thetac = pt.tau[y] * besselfac * eimf;
N.phic = pt.pi[y] * besselfac * I * 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;
N.thetac = pt.tau[y] * besselfac * eimf;
N.phic = pt.pi[y] * besselfac * I * eimf;
qpms_pitau_free(pt);
free(bessel);
return N;
qpms_pitau_free(pt);
free(bessel);
return N;
}
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) {
lmcheck(l,m);
csphvec_t M;
complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l);
qpms_bessel_t btyp, qpms_normalisation_t norm) {
lmcheck(l,m);
csphvec_t M;
complex double *bessel = malloc((l+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, l, kdlj.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kdlj.theta, l, norm);
complex double eimf = cexp(m * kdlj.phi * I);
qpms_y_t y = qpms_mn2y(m,l);
M.rc = 0.;
M.thetac = pt.pi[y] * bessel[l] * I * eimf;
M.phic = -pt.tau[y] * bessel[l] * eimf;
M.rc = 0.;
M.thetac = pt.pi[y] * bessel[l] * I * eimf;
M.phic = -pt.tau[y] * bessel[l] * eimf;
qpms_pitau_free(pt);
free(bessel);
return M;
qpms_pitau_free(pt);
free(bessel);
return M;
}
qpms_vswfset_sph_t *qpms_vswfset_make(qpms_l_t lMax, sph_t kdlj,
qpms_bessel_t btyp, qpms_normalisation_t norm) {
qpms_vswfset_sph_t *res = malloc(sizeof(qpms_vswfset_sph_t));
res->lMax = lMax;
qpms_y_t nelem = qpms_lMax2nelem(lMax);
res->el = 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))
abort(); // or return NULL? or rather assert?
return res;
qpms_bessel_t btyp, qpms_normalisation_t norm) {
qpms_vswfset_sph_t *res = malloc(sizeof(qpms_vswfset_sph_t));
res->lMax = lMax;
qpms_y_t nelem = qpms_lMax2nelem(lMax);
res->el = 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))
abort(); // or return NULL? or rather assert?
return res;
}
void qpms_vswfset_sph_pfree(qpms_vswfset_sph_t *w) {
assert(NULL != w && NULL != w->el && NULL != w->mg);
free(w->el);
free(w->mg);
free(w);
assert(NULL != w && NULL != w->el && NULL != w->mg);
free(w->el);
free(w->mg);
free(w);
}
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_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kr.theta, lMax, norm);
complex double const *pbes = bessel + 1; // starting from l = 1
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget;
for(qpms_l_t l = 1; l <= lMax; ++l) {
complex double besfac;
complex double besderfac;
if (kr.r) {
besfac = *pbes / kr.r;
} else {
besfac = (1 == l) ? 1/3. : 0;
}
besderfac = *(pbes-1) - l * besfac;
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * kr.phi * I);
if (longtarget) {
complex double longfac = sqrt(l*(l+1)) * eimf;
plong->rc = // FATAL FIXME: I get wrong result here for plane wave re-expansion
// whenever kr.r > 0 (for waves with longitudinal component, ofcoz)
/*(*(pbes-1) - (l+1)/kr.r* *pbes)*/
(besderfac-besfac)
* (*pleg) * longfac;
plong->thetac = *ptau * besfac * longfac;
plong->phic = *ppi * I * besfac * longfac;
++plong;
}
if (eltarget) {
pel->rc = l*(l+1) * (*pleg) * besfac * eimf;
pel->thetac = *ptau * besderfac * eimf;
pel->phic = *ppi * besderfac * I * eimf;
++pel;
}
if (mgtarget) {
pmg->rc = 0.;
pmg->thetac = *ppi * (*pbes) * I * eimf;
pmg->phic = - *ptau * (*pbes) * eimf;
++pmg;
}
++pleg; ++ppi; ++ptau;
}
++pbes;
}
free(bessel);
qpms_pitau_free(pt);
return QPMS_SUCCESS;
qpms_l_t lMax, sph_t kr,
qpms_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
qpms_pitau_t pt = qpms_pitau_get(kr.theta, lMax, norm);
complex double const *pbes = bessel + 1; // starting from l = 1
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget;
for(qpms_l_t l = 1; l <= lMax; ++l) {
complex double besfac;
complex double besderfac;
if (kr.r) {
besfac = *pbes / kr.r;
} else {
besfac = (1 == l) ? 1/3. : 0;
}
besderfac = *(pbes-1) - l * besfac;
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * kr.phi * I);
if (longtarget) {
complex double longfac = sqrt(l*(l+1)) * eimf;
plong->rc = // FATAL FIXME: I get wrong result here for plane wave re-expansion
// whenever kr.r > 0 (for waves with longitudinal component, ofcoz)
/*(*(pbes-1) - (l+1)/kr.r* *pbes)*/
(besderfac-besfac)
* (*pleg) * longfac;
plong->thetac = *ptau * besfac * longfac;
plong->phic = *ppi * I * besfac * longfac;
++plong;
}
if (eltarget) {
pel->rc = l*(l+1) * (*pleg) * besfac * eimf;
pel->thetac = *ptau * besderfac * eimf;
pel->phic = *ppi * besderfac * I * eimf;
++pel;
}
if (mgtarget) {
pmg->rc = 0.;
pmg->thetac = *ppi * (*pbes) * I * eimf;
pmg->phic = - *ptau * (*pbes) * eimf;
++pmg;
}
++pleg; ++ppi; ++ptau;
}
++pbes;
}
free(bessel);
qpms_pitau_free(pt);
return QPMS_SUCCESS;
}
// 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_l_t lMax, sph_t kr,
qpms_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
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;
qpms_l_t lMax, sph_t kr,
qpms_bessel_t btyp, qpms_normalisation_t norm) {
assert(lMax >= 1);
complex double *bessel = malloc((lMax+1)*sizeof(complex double));
if(qpms_sph_bessel_fill(btyp, lMax, kr.r, bessel)) abort();
complex double const *pbes = bessel + 1; // starting from l = 1
csphvec_t *plong = longtarget, *pmg = mgtarget, *pel = eltarget;
for(qpms_l_t l = 1; l <= lMax; ++l) {
complex double besfac = *pbes / kr.r;
complex double besderfac = *(pbes-1) - l * besfac;
double sqrtlfac = sqrt(l*(l+1));
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * kr.phi * I);
if (longtarget) {
*plong = csphvec_add(csphvec_scale(besderfac-besfac, *p3),
csphvec_scale(sqrtlfac * besfac, *p2));
++plong;
}
if (eltarget) {
*pel = csphvec_add(csphvec_scale(besderfac, *p2),
csphvec_scale(sqrtlfac * besfac, *p3));
++pel;
}
if (mgtarget) {
*pmg = csphvec_scale(*pbes, *p1);
++pmg;
}
++p1; ++p2; ++p3;
}
++pbes;
}
free(a1);
free(bessel);
return QPMS_SUCCESS;
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;
for(qpms_l_t l = 1; l <= lMax; ++l) {
complex double besfac = *pbes / kr.r;
complex double besderfac = *(pbes-1) - l * besfac;
double sqrtlfac = sqrt(l*(l+1));
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * kr.phi * I);
if (longtarget) {
*plong = csphvec_add(csphvec_scale(besderfac-besfac, *p3),
csphvec_scale(sqrtlfac * besfac, *p2));
++plong;
}
if (eltarget) {
*pel = csphvec_add(csphvec_scale(besderfac, *p2),
csphvec_scale(sqrtlfac * besfac, *p3));
++pel;
}
if (mgtarget) {
*pmg = csphvec_scale(*pbes, *p1);
++pmg;
}
++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_l_t lMax, sph_t dir, qpms_normalisation_t norm) {
assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for (qpms_l_t l = 1; l <= lMax; ++l) {
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * dir.phi * I);
if (a1target) {
p1->rc = 0;
p1->thetac = *ppi * I * eimf;
p1->phic = -*ptau * eimf;
++p1;
}
if (a2target) {
p2->rc = 0;
p2->thetac = *ptau * eimf;
p2->phic = *ppi * I * eimf;
++p2;
}
if (a3target) {
p3->rc = sqrt(l*(l+1)) * (*pleg) * eimf;
p3->thetac = 0;
p3->phic = 0;
++p3;
}
}
++pleg; ++ppi; ++ptau;
}
qpms_pitau_free(pt);
return QPMS_SUCCESS;
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) {
assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for (qpms_l_t l = 1; l <= lMax; ++l) {
for(qpms_m_t m = -l; m <= l; ++m) {
complex double eimf = cexp(m * dir.phi * I);
if (a1target) {
p1->rc = 0;
p1->thetac = *ppi * I * eimf;
p1->phic = -*ptau * eimf;
++p1;
}
if (a2target) {
p2->rc = 0;
p2->thetac = *ptau * eimf;
p2->phic = *ppi * I * eimf;
++p2;
}
if (a3target) {
p3->rc = sqrt(l*(l+1)) * (*pleg) * eimf;
p3->thetac = 0;
p3->phic = 0;
++p3;
}
}
++pleg; ++ppi; ++ptau;
}
qpms_pitau_free(pt);
return QPMS_SUCCESS;
}
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) {
assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for(qpms_l_t l = 1; l <= lMax; ++l) {
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
complex double eimf = cexp(m * dir.phi * I);
if (a1target) {
p1->rc = 0;
p1->thetac = conj(*ppi * normfac * I * eimf);
p1->phic = conj(-*ptau * normfac * eimf);
++p1;
}
if (a2target) {
p2->rc = 0;
p2->thetac = conj(*ptau * normfac * eimf);
p2->phic = conj(*ppi * normfac * I * eimf);
++p2;
}
if (a3target) {
p3->rc = conj(sqrt(l*(l+1)) * (*pleg) * normfac * eimf);
p3->thetac = 0;
p3->phic = 0;
++p3;
}
++pleg; ++ppi; ++ptau;
}
}
qpms_pitau_free(pt);
return QPMS_SUCCESS;
qpms_l_t lMax, sph_t dir, qpms_normalisation_t norm) {
assert(lMax >= 1);
qpms_pitau_t pt = qpms_pitau_get(dir.theta, lMax, norm);
double const *pleg = pt.leg;
double const *ppi = pt.pi;
double const *ptau = pt.tau;
csphvec_t *p1 = a1target, *p2 = a2target, *p3 = a3target;
for(qpms_l_t l = 1; l <= lMax; ++l) {
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
complex double eimf = cexp(m * dir.phi * I);
if (a1target) {
p1->rc = 0;
p1->thetac = conj(*ppi * normfac * I * eimf);
p1->phic = conj(-*ptau * normfac * eimf);
++p1;
}
if (a2target) {
p2->rc = 0;
p2->thetac = conj(*ptau * normfac * eimf);
p2->phic = conj(*ppi * normfac * I * eimf);
++p2;
}
if (a3target) {
p3->rc = conj(sqrt(l*(l+1)) * (*pleg) * normfac * eimf);
p3->thetac = 0;
p3->phic = 0;
++p3;
}
++pleg; ++ppi; ++ptau;
}
}
qpms_pitau_free(pt);
return QPMS_SUCCESS;
}
static inline complex double ipowl(qpms_l_t l) {
switch(l % 4) {
case 0: return 1;
break;
case 1: return I;
break;
case 2: return -1;
break;
case 3: return -I;
break;
default: abort();
}
assert(0);
switch(l % 4) {
case 0: return 1;
break;
case 1: return I;
break;
case 2: return -1;
break;
case 3: return -I;
break;
default: abort();
}
assert(0);
}
qpms_errno_t qpms_planewave2vswf_fill_sph(sph_t wavedir, csphvec_t amplitude,
complex double *target_longcoeff, complex double *target_mgcoeff,
complex double *target_elcoeff, qpms_l_t lMax, qpms_normalisation_t norm) {
qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t * const dual_A1 = malloc(3*nelem*sizeof(csphvec_t)), *const dual_A2 = dual_A1 + nelem,
* const dual_A3 = dual_A2 + nelem;
if (QPMS_SUCCESS != qpms_vecspharm_dual_fill(dual_A1, dual_A2, dual_A3, lMax, wavedir, norm))
abort();
const csphvec_t *pA1 = dual_A1, *pA2 = dual_A2, *pA3 = dual_A3;
complex double *plong = target_longcoeff, *pmg = target_mgcoeff, *pel = target_elcoeff;
for (qpms_l_t l = 1; l <= lMax; ++l) {
complex double prefac1 = 4 * M_PI * ipowl(l);
complex double prefac23 = - 4 * M_PI * ipowl(l+1);
for (qpms_m_t m = -l; m <= l; ++m) {
*plong = prefac23 * csphvec_dotnc(*pA3, amplitude);
*pmg = prefac1 * csphvec_dotnc(*pA1, amplitude);
*pel = prefac23 * csphvec_dotnc(*pA2, amplitude);
++pA1; ++pA2; ++pA3; ++plong; ++pmg; ++pel;
}
complex double *target_longcoeff, complex double *target_mgcoeff,
complex double *target_elcoeff, qpms_l_t lMax, qpms_normalisation_t norm) {
qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t * const dual_A1 = malloc(3*nelem*sizeof(csphvec_t)), *const dual_A2 = dual_A1 + nelem,
* const dual_A3 = dual_A2 + nelem;
if (QPMS_SUCCESS != qpms_vecspharm_dual_fill(dual_A1, dual_A2, dual_A3, lMax, wavedir, norm))
abort();
const csphvec_t *pA1 = dual_A1, *pA2 = dual_A2, *pA3 = dual_A3;
complex double *plong = target_longcoeff, *pmg = target_mgcoeff, *pel = target_elcoeff;
for (qpms_l_t l = 1; l <= lMax; ++l) {
complex double prefac1 = 4 * M_PI * ipowl(l);
complex double prefac23 = - 4 * M_PI * ipowl(l+1);
for (qpms_m_t m = -l; m <= l; ++m) {
*plong = prefac23 * csphvec_dotnc(*pA3, amplitude);
*pmg = prefac1 * csphvec_dotnc(*pA1, amplitude);
*pel = prefac23 * csphvec_dotnc(*pA2, amplitude);
++pA1; ++pA2; ++pA3; ++plong; ++pmg; ++pel;
}
}
free(dual_A1);
return QPMS_SUCCESS;
}
free(dual_A1);
return QPMS_SUCCESS;
}
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 elcoeff, qpms_l_t lMax, qpms_normalisation_t norm)
complex double * const longcoeff, complex double * const mgcoeff,
complex double * const elcoeff, qpms_l_t lMax, qpms_normalisation_t norm)
{
sph_t wavedir_sph = cart2sph(wavedir_cart);
csphvec_t amplitude_sphvec = ccart2csphvec(amplitude_cart, wavedir_sph);
return qpms_planewave2vswf_fill_sph(wavedir_sph, amplitude_sphvec,
longcoeff, mgcoeff, elcoeff, lMax, norm);
sph_t wavedir_sph = cart2sph(wavedir_cart);
csphvec_t amplitude_sphvec = ccart2csphvec(amplitude_cart, wavedir_sph);
return qpms_planewave2vswf_fill_sph(wavedir_sph, amplitude_sphvec,
longcoeff, mgcoeff, elcoeff, lMax, norm);
}
csphvec_t qpms_eval_vswf(sph_t kr,
complex double * const lc, complex double *const mc, complex double *const ec,
qpms_l_t lMax, qpms_bessel_t btyp, qpms_normalisation_t norm)
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_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t lsum, msum, esum, lcomp, mcomp, ecomp;
csphvec_kahaninit(&lsum, &lcomp);
csphvec_kahaninit(&msum, &mcomp);
csphvec_kahaninit(&esum, &ecomp);
csphvec_t *lset = NULL, *mset = NULL, *eset = NULL;
if(lc) lset = malloc(nelem * sizeof(csphvec_t));
if(mc) mset = malloc(nelem * sizeof(csphvec_t));
if(ec) eset = malloc(nelem * sizeof(csphvec_t));
qpms_vswf_fill(lset, mset, eset, lMax, kr, btyp, norm);
if(lc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&lsum, &lcomp, csphvec_scale(lc[y], lset[y]));
if(mc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&msum, &mcomp, csphvec_scale(mc[y], mset[y]));
if(ec) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&esum, &ecomp, csphvec_scale(ec[y], eset[y]));
if(lc) free(lset);
if(mc) free(mset);
if(ec) free(eset);
//return csphvec_add(esum, csphvec_add(msum, lsum));
csphvec_kahanadd(&esum, &ecomp, msum);
csphvec_kahanadd(&esum, &ecomp, lsum);
return esum;
qpms_y_t nelem = qpms_lMax2nelem(lMax);
csphvec_t lsum, msum, esum, lcomp, mcomp, ecomp;
csphvec_kahaninit(&lsum, &lcomp);
csphvec_kahaninit(&msum, &mcomp);
csphvec_kahaninit(&esum, &ecomp);
csphvec_t *lset = NULL, *mset = NULL, *eset = NULL;
if(lc) lset = malloc(nelem * sizeof(csphvec_t));
if(mc) mset = malloc(nelem * sizeof(csphvec_t));
if(ec) eset = malloc(nelem * sizeof(csphvec_t));
qpms_vswf_fill(lset, mset, eset, lMax, kr, btyp, norm);
if(lc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&lsum, &lcomp, csphvec_scale(lc[y], lset[y]));
if(mc) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&msum, &mcomp, csphvec_scale(mc[y], mset[y]));
if(ec) for(qpms_y_t y = 0; y < nelem; ++y)
csphvec_kahanadd(&esum, &ecomp, csphvec_scale(ec[y], eset[y]));
if(lc) free(lset);
if(mc) free(mset);
if(ec) free(eset);
//return csphvec_add(esum, csphvec_add(msum, lsum));
csphvec_kahanadd(&esum, &ecomp, msum);
csphvec_kahanadd(&esum, &ecomp, lsum);
return esum;
}

10
qpms/vswf.h
View File

@ -5,10 +5,10 @@
// Electric wave N; NI
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
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
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_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_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,
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_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
#endif // QPMS_VSWF_H