double FMIME (int J, int K, int M, int Q, int S, int j, int k, int m)
{
double coeff1 = pow(-1.0,k+m);
double coeff2 = sqrt((2.0*J + 1.0)*(2.0*j+1.0));
double J1 = gsl_sf_coupling_3j(2*J, 4, 2*j, 2*M, 2*Q, -2*m);
double J2 = gsl_sf_coupling_3j(2*J, 4, 2*j, 2*K, 2*S, -2*k);
return coeff2*coeff1*J2*J1;
}
void
check_3j_family_j_gsl (const int two_j1, const int two_j2,
const int two_m1, const int two_m2)
{
double *a;
int two_jmin, two_jmax, imax, i;
int two_m3 = -(two_m1 + two_m2);
wigner3j_family_j (two_j1, two_j2, two_m1, two_m2, &a, &two_jmin, &two_jmax);
imax = (two_jmax-two_jmin)/2;
printf ("two_j1: %d two_j2: %d two_m1: %d two_m2: %d\n",
two_j1, two_j2, two_m1, two_m2);
for(i=0; i<=imax; i++)
{
int two_j3=two_jmin+i*2;
double gsl=gsl_sf_coupling_3j(two_j1, two_j2, two_j3,
two_m1, two_m2, two_m3);
printf ("\ttwo_j3: %d\t\twigner: %g\tgsl: %g\tdiff: %g\n",
two_j3, a[i], gsl, a[i]-gsl);
}
free (a);
}
static VALUE rb_gsl_sf_coupling_3j(VALUE obj, VALUE two_ja, VALUE two_jb, VALUE two_jc, VALUE two_ma, VALUE two_mb, VALUE two_mc)
{
CHECK_FIXNUM(two_ja); CHECK_FIXNUM(two_jb); CHECK_FIXNUM(two_jc);
CHECK_FIXNUM(two_ma); CHECK_FIXNUM(two_mb); CHECK_FIXNUM(two_mc);
return rb_float_new(gsl_sf_coupling_3j(FIX2INT(two_ja), FIX2INT(two_jb),
FIX2INT(two_jc), FIX2INT(two_ma),
FIX2INT(two_mb), FIX2INT(two_mc)));
}
void
check_3j_family_j_exact_2 (const int two_jmax)
{
int two_j;
printf("two_j\trecursive\tgsl\texact\trec-ex\tgsl-ex\n");
for (two_j = 0; two_j <=two_jmax; two_j = (two_j + 1)*100)
{
double exact = 1.0 / sqrt (two_j + 1.0);
double gsl = gsl_sf_coupling_3j(two_j, two_j, 0, 0, 0, 0);
double *a;
int tjmax, tjmin;
wigner3j_family_j (two_j, two_j, 0, 0, &a, &tjmax, &tjmin);
printf("%d\t%g\t%g\t%g\t%g\t%g\n", two_j, a[0],gsl, exact, a[0]-exact, gsl-exact);
free (a);
}
}
void
check_3j_family_j_exact_1 (const int two_jmax)
{
int two_j;
for (two_j = 0; two_j <=two_jmax; two_j = (two_j + 1)*100-1)
{
double exact = 1.0 / sqrt (two_j + 1.0);
double gsl = gsl_sf_coupling_3j(two_j, two_j, 0, two_j, -two_j, 0);
double *a;
int tjmax, tjmin;
wigner3j_family_j (two_j, two_j, two_j, -two_j, &a, &tjmax, &tjmin);
printf ("two_j: %d\trecursive: % .18e\t exact: % .18e\tdiff: % .18e\n",
two_j, a[0], exact, a[0]-exact);
printf ("two_j: %d\t gsl: % .18e\t exact: % .18e\tdiff: % .18e\n",
two_j, gsl, exact, gsl-exact);
free (a);
}
}
/**
* C++ version of gsl_sf_coupling_3j().
* @param two_ja Coupling coefficient in half-integer units
* @param two_jb Coupling coefficient in half-integer units
* @param two_jc Coupling coefficient in half-integer units
* @param two_ma Coupling coefficient in half-integer units
* @param two_mb Coupling coefficient in half-integer units
* @param two_mc Coupling coefficient in half-integer units
* @return The Wigner 3-j coefficient
*/
inline double coupling_3j( int two_ja, int two_jb, int two_jc, int two_ma, int two_mb, int two_mc ){
return gsl_sf_coupling_3j( two_ja, two_jb, two_jc, two_ma, two_mb, two_mc ); }
// --- Utils ---
PetscReal wigner3j(int a, int b, int c, int d, int e, int f) {
return gsl_sf_coupling_3j(2*a, 2*b, 2*c, 2*d, 2*e, 2*f);
}
double
dmtxel (const int J, const int K, const int M, const int Jp, const int Kp,
const int Mp, const int k, const int p, const int q)
/* Matrix element of the rotation matrix <J K M|D^k_pq|Jp Kp Mp>.
Currently only defined for integer angular momentum. */
{
#ifdef DMTXEL_DEBUG
if (p != Mp - M)
{
fprintf (stderr, "dmtxel warning: p != Mp - M.\n");
return 0.0;
}
else if (q != Kp - K)
{
fprintf (stderr, "dmtxel warning: q != Kp - K.\n");
return 0.0;
}
else if (abs (q) > k)
{
fprintf (stderr, "dmtxel warning: abs(q) > k.\n");
return NAN;
}
else if (abs (p) > k)
{
fprintf (stderr, "dmtxel warning: abs(p) > k.\n");
return NAN;
}
else if (abs (M) > J)
{
fprintf (stderr, "dmtxel warning: abs(M) > J.\n");
return NAN;
}
else if (abs (K) > J)
{
fprintf (stderr, "dmtxel warning: abs(K) > J.\n");
return NAN;
}
else if (abs (Mp) > Jp)
{
fprintf (stderr, "dmtxel warning: abs(Mp) > Jp.\n");
return NAN;
}
else if (abs (Kp) > Jp)
{
fprintf (stderr, "dmtxel warning: abs(Kp) > Jp.\n");
return NAN;
}
else if ((Jp > J + k) || (Jp < abs (J - k)))
{
fprintf (stderr, "dmtxel warning: (J, k, Jp) not triangle.\n");
return 0.0;
}
#undef NAN
#endif /* DMTXEL_DEBUG */
double a = sqrt ((2.0 * J + 1.0) * (2.0 * Jp + 1.0)) *
gsl_sf_coupling_3j (2 * J, 2 * k, 2 * Jp, 2 * M, 2 * p, -2 * Mp) *
gsl_sf_coupling_3j (2 * J, 2 * k, 2 * Jp, 2 * K, 2 * q, -2 * Kp);
if (GSL_IS_ODD (Mp - Kp)) /* phase */
return -a;
else
return a;
}
// antisymmetrized matrix elements of Minnesota potential in spherical HO basis
// V_acbd, where a-b and c-d are pairs of the same l,j (i.e. are coupled to J=0)
// direct term: a-b integrated over r1, c-d integrated over r2
// exchange term: a-d integrated over r1, c-b integrated over r2
// Uses multipolar expansion of gaussian in Minnesota: exp(-mu(vec{r1}-vec{r2})^2)
// = exp(-mu(r1-r2)^2) * 4pi * sum_LM iL(2*mu*r1*r2)/exp(2*mu*r1*r2) * Y*_LM(1) * Y_LM(2)
// where iL(2*mu*r1*r2)/exp(2*mu*r1*r2) is scaled modified spherical Bessel function
void V_me(Vi1_t *V, double hw)
{
// i1 and i2 label (j,l) subspaces (Ni elements)
// ir1, ir2 are integration indices (converted later to r1, r2)
// a,b are n-quantum numbers in i1=(j1,l1) subspace
// c,d are n-quantum numbers in i2=(j2,l2) subspace
int i1, i2, ir1, ir2, a, b, c, d, L, _2l1, _2l2;
double r1, r2, mw, rm2, rp2;
double sumR, sumS, sumRp, sumSp, bess, coef;
double ***sho_nlr, *halfint1, *halfint2, *halfint3, *coef1, *coef2;
Vi2_t *Vi2;
mw = hw / H2M;
// matrix elements use double integration by Gauss-Laguerre quadrature
gaulag_init(GLNODES, 1., 0.04 / sqrt(mw)); // then use gl.x[i] and gl.w[i]
halfint1 = (double*)malloc(gl.N * sizeof(double));
halfint2 = (double*)malloc(gl.N * sizeof(double));
halfint3 = (double*)malloc(gl.N * sizeof(double));
coef1 = (double*)malloc(Ni * sizeof(double));
coef2 = (double*)malloc(Ni * sizeof(double));
if ((halfint1 == NULL) || (halfint2 == NULL) || (halfint3 == NULL)
|| (coef1 == NULL) || (coef2 == NULL)) {
fprintf(stderr, "V_me: failed allocation of auxiliary arrays halfint[%d] or coef[%d]\n", gl.N, Ni);
exit(1);
}
sho_nlr = make_sho_table(mw, N_jl[0], (Ni+1)/2); // tabulate SHO w.f.
for (i1 = 0; i1 < Ni; i1++) { // zeroing the pairing matrix elements
for (a = 0; a < V[i1].N; a++) {
for (b = 0; b < V[i1].N; b++) {
Vi2 = V[i1].V_ab[a][b].Vi2;
for (i2 = 0; i2 < Ni; i2++) {
for (c = 0; c < Vi2[i2].N; c++) {
for (d = 0; d < Vi2[i2].N; d++)
Vi2[i2].V_cd_pair[c][d] = 0.;
}
}
}
}
}
for (i1 = 0; i1 < Ni; i1++) { // j,l of the first pair
for (a = 0; a < V[i1].N; a++) {
for (b = 0; b <= a; b++) {
for (ir2 = 0; ir2 < gl.N; ir2++) {
halfint1[ir2] = 0.; // for storage of r1-integrated direct term
r2 = gl.x[ir2];
for (ir1 = 0; ir1 < gl.N; ir1++) {
r1 = gl.x[ir1];
rm2 = (r1-r2)*(r1-r2);
rp2 = (r1+r2)*(r1+r2);
halfint1[ir2] += gl.w[ir1] * r1 * sho_nlr[a][V[i1].l1][ir1] * sho_nlr[b][V[i1].l1][ir1]
* (V0R*(exp(-kR*rm2)-exp(-kR*rp2))/(16*kR)
- V0S*(exp(-kS*rm2)-exp(-kS*rp2))/(16*kS));
}
}
Vi2 = V[i1].V_ab[a][b].Vi2;
for (i2 = 0; i2 <= i1; i2++) { // j,l of the second pair
_2l1 = 2 * V[i1].l1;
_2l2 = 2 * Vi2[i2].l2;
for (L = Vi2[i2].Lmin; L <= Vi2[i2].Lmax; L += 2) {
// Clebsch-Gordan coeficients and 6j symbols for exchange term
coef = gsl_sf_coupling_3j(_2l1, _2l2, 2*L, 0, 0, 0);
coef2[L] = coef1[L] = (2*L+1) * coef * coef;
coef = gsl_sf_coupling_6j(V[i1]._2j1, Vi2[i2]._2j2, 2*L, _2l2, _2l1, 1);
coef = (_2l1 + 1) * (_2l2 + 1) * coef * coef;
coef1[L] *= 1. - coef;
coef2[L] *= coef + (_2l1 + 1) * (_2l2 + 1)
* gsl_sf_coupling_9j(2*L,_2l2,_2l1, _2l2,Vi2[i2]._2j2, 1, _2l1,1,V[i1]._2j1);
}
for (c = 0; c < Vi2[i2].N; c++) {
for (ir1 = 0; ir1 < gl.N; ir1++) {
halfint2[ir1] = 0.; // for storage of r2-integrated exchange term
halfint3[ir1] = 0.; // for storage of r2-integrated pairing term
r1 = gl.x[ir1];
for (ir2 = 0; ir2 < gl.N; ir2++) {
r2 = gl.x[ir2];
rm2 = (r1-r2) * (r1-r2);
rp2 = 2 * r1 * r2;
sumR = 0.; sumS = 0.; // storage for terms from L-expansion
sumRp = 0.; sumSp = 0.; // terms for pairing
for (L = Vi2[i2].Lmin; L <= Vi2[i2].Lmax; L += 2) {
bess = gsl_sf_bessel_il_scaled(L, kR*rp2);
sumR += bess * coef1[L];
sumRp += bess * coef2[L];
bess = gsl_sf_bessel_il_scaled(L, kS*rp2);
sumS += bess * coef1[L];
sumSp += bess * coef2[L];
}
halfint2[ir1] += gl.w[ir2] * r2 * r2 * sho_nlr[c][Vi2[i2].l2][ir2] * sho_nlr[b][V[i1].l1][ir2]
* 0.5 * (V0R * exp(-kR*rm2) * sumR - V0S * exp(-kS*rm2) * sumS);
halfint3[ir1] += gl.w[ir2] * r2 * r2 * sho_nlr[c][Vi2[i2].l2][ir2] * sho_nlr[b][V[i1].l1][ir2]
* 0.5 * (V0R * exp(-kR*rm2) * sumRp - V0S * exp(-kS*rm2) * sumSp);
}
halfint2[ir1] *= sho_nlr[a][V[i1].l1][ir1];
halfint3[ir1] *= sho_nlr[a][V[i1].l1][ir1];
}
for (d = 0; d < Vi2[i2].N; d++) {
sumR = 0.; // for direct + exchange integral
sumRp = 0.; // for pairing integral
for (ir1 = 0; ir1 < gl.N; ir1++) {
r1 = gl.x[ir1]; // direct integral is done over r2, exchange and pairing over r1
sumR += gl.w[ir1] * (
halfint1[ir1] * sho_nlr[c][Vi2[i2].l2][ir1] // direct integral
+ halfint2[ir1] * r1 // exchange integral
) * r1 * sho_nlr[d][Vi2[i2].l2][ir1];
sumRp += gl.w[ir1] * halfint3[ir1] * r1 * r1 * sho_nlr[d][Vi2[i2].l2][ir1];
}
// term (2j+1) is from the summation over m-degenerate density matrices
sumS = sumR * (Vi2[i2]._2j2 + 1);
sumSp = sumRp * (Vi2[i2]._2j2 + 1);
V[i1].V_ab[a][b].Vi2[i2].V_cd[c][d] = sumS;
V[i1].V_ab[a][b].Vi2[i2].V_cd_pair[c][d] += sumSp;
V[i1].V_ab[a][b].Vi2[i2].V_cd_pair[d][c] += sumSp;
if (a != b) {
V[i1].V_ab[b][a].Vi2[i2].V_cd[d][c] = sumS;
V[i1].V_ab[b][a].Vi2[i2].V_cd_pair[d][c] += sumSp;
V[i1].V_ab[b][a].Vi2[i2].V_cd_pair[c][d] += sumSp;
}
if (i1 > i2) { // symmetry V_acbd = V_cadb (and V_abcd = V_cdab for pairing)
sumS = sumR * (V[i1]._2j1 + 1);
sumSp = sumRp * (V[i1]._2j1 + 1);
V[i2].V_ab[c][d].Vi2[i1].V_cd[a][b] = sumS;
V[i2].V_ab[c][d].Vi2[i1].V_cd_pair[a][b] += sumSp;
V[i2].V_ab[d][c].Vi2[i1].V_cd_pair[a][b] += sumSp;
if (a != b) {
V[i2].V_ab[d][c].Vi2[i1].V_cd[b][a] = sumS;
V[i2].V_ab[d][c].Vi2[i1].V_cd_pair[b][a] += sumSp;
V[i2].V_ab[c][d].Vi2[i1].V_cd_pair[b][a] += sumSp;
}
}
} // d
} // c
} // i2
} // b
} // a
} // i1
free(halfint1);
free(halfint2);
free(coef1);
free(coef2);
free(sho_nlr[0][0]); free(sho_nlr[0]); free(sho_nlr);
}