static long double ___yn(int n, double *x)
{
long double Sum1;
long double Sum2;
long double Fact1;
long double Fact2;
long double F1;
long double F2;
long double y;
register int i;
double xx;
long double Xi;
unsigned int My;
if (EXPD(x[0]) == 0)
return -1. / 0.; /* ignore the gcc warning, this is intentional */
if ((x[0] >= (n >= 32 ? 25.8 : (n < 8 ? 17.4 + 0.1 * n : 16.2 + 0.3 * n)))) {
Xi = x[0] - M_PI * (n * 0.5 + 0.25);
My = n * n << 2;
return sqrt(M_2_PI / x[0]) * (P(My, x) * sin(Xi) + Q(My, x) * cos(Xi));
}
Sum1 = Sum2 = F1 = F2 = 0;
Fact1 = 1. / (xx = x[0] * 0.5);
Fact2 = 1.;
y = xx * xx;
for (i = 1; i < n; i++)
Fact1 *= (n - i) / xx;
for (i = 1; i <= n; i++) {
Sum1 += Fact1;
if (i == n)
break;
Fact1 *= y / (i * (n - i));
}
for (i = 1; i <= n; i++) {
Fact2 *= xx / i;
F1 += 1. / i;
}
for (i = 1; ; i++) {
Sum2 += Fact2 * (F1 + F2);
Fact2 *= -y / (i * (n + i));
if (EXPL(Sum2) - EXPL(Fact2) > 53 || !EXPL(Fact2))
break;
F1 += 1. / (n + i);
F2 += 1. / i;
}
return M_1_PI * (2. * (M_C + log(xx)) * ___jn(n, x) - Sum1 - Sum2);
}
void diff_tensor_calc_ewald_beenakker( INT i, INT j, DOUBLE* _tD )
{
DOUBLE sigma_i = coord[ DIMS1 * j + 3 ];
DOUBLE sigma_j = coord[ DIMS1 * i + 3 ];
DOUBLE v[3];
DOUBLE r[3];
const DOUBLE sigma_sq = 0.5 * (sigma_i * sigma_i + sigma_j * sigma_j);
INT k, l;
DOUBLE Op[9] = {0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0};
DOUBLE Qp[9] = {0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0};
INT f, g, h;
const DOUBLE preQ = inv_L[0] * inv_L[0] * inv_L[0];
dist_vec( coord + i*DIMS1, coord + j*DIMS1, r );
if ( (r[0] * r[0] + r[1] * r[1] + r[2] * r[2]) < (sigma_i + sigma_j)*(sigma_i + sigma_j) && i != j )
{
DOUBLE r_norm, r_sq, e[3];
get_ev2_norms( r[0], r[1], r[2], e, &r_norm, &r_sq );
{/*add overlapping Dij*/
DOUBLE sigma = (sigma_i + sigma_j) / 2;
DOUBLE pre = preDii / sigma;
DOUBLE part1 = (1 - (9 * r_norm / (32 * sigma)));
for ( i = 0; i < 3; ++i )
{
_tD[ i + 3 * i ] += pre * (part1 + 3 * e[i] * e[i] * r_norm / (32 * sigma));
for ( j = 0; j < i; ++j )
{
DOUBLE vval = pre * 3 * e[i] * e[j] * r_norm / (32 * sigma);
_tD[ j + 3 * i ] += vval;
_tD[ i + 3 * j ] += vval;
}
}
}
{/*remove none overlapping Dij*/
DOUBLE pre = preDij / r_norm;
DOUBLE sigm_r = (sigma_i * sigma_i + sigma_j * sigma_j) / r_sq;
DOUBLE part1 = 1 + sigm_r / 3;
for ( i = 0; i < 3; ++i )
{
_tD[ i + 3 * i ] -= pre*(part1 + e[i] * e[i]*(1 - sigm_r));
for ( j = 0; j < i; ++j )
{
DOUBLE vval = pre * e[i] * e[j] * (1 - sigm_r);
_tD[ j + 3 * i ] -= vval;
_tD[ i + 3 * j ] -= vval;
}
}
}
}
v[0] = r[0] * inv_L[0];
v[1] = r[1] * inv_L[1];
v[2] = r[2] * inv_L[2];
for ( h = -ewald_rr; h <= ewald_rr; ++h )
{
int next_f = (int)SQRTD( rr_sq - h*h );
for ( f = -next_f; f <= next_f; ++f )
{
int next_g = (int)SQRTD( rr_sq - h*h - f*f );
for ( g = -next_g; g <= next_g; ++g )
{
DOUBLE r_norm, r_sq, e[3];
DOUBLE inv_r, inv_r2, inv_r3;
DOUBLE sc, sc2;
get_ev2_norms( r[0] + box[0]*h, r[1] + box[0]*f, r[2] + box[0]*g, e, &r_norm, &r_sq );
if ( r_norm != 0.0f )
{
inv_r = 1 / r_norm;
inv_r2 = 1 / r_sq;
inv_r3 = inv_r*inv_r2;
sc = ewald_alpha*sigma_sq*inv_r2;
sc += 14*alpha3*sigma_sq;
sc += -4.5f*ewald_alpha;
sc += -20*alpha2*alpha3*sigma_sq*r_sq;
sc += 3*alpha3*r_sq;
sc += 4*alpha3*alpha2*alpha2*sigma_sq*r_sq*r_sq;
sc *= EXPD(-alpha2*r_sq);
sc /= SQRTPI;
sc += ERFCD( r_norm * ewald_alpha ) * ( 0.75f*inv_r + 0.5f*sigma_sq*inv_r3);
sc2 = -3*ewald_alpha*sigma_sq*inv_r2;
sc2 += -2*alpha3*sigma_sq;
sc2 += 1.5f*ewald_alpha;
sc2 += 16*alpha2*alpha3*sigma_sq*r_sq;
sc2 += -3*alpha3*r_sq;
sc2 += -4*alpha3*alpha2*alpha2*sigma_sq*r_sq*r_sq;
sc2 *= EXPD(-alpha2*r_sq);
sc2 /= SQRTPI;
sc2 += ERFCD( r_norm * ewald_alpha ) * ( 0.75f*inv_r - 1.5f*sigma_sq*inv_r3);
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = e[k] * sc2;
Op[ k * 4 ] += sc + sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Op[ k + l * 3 ] += e[l] * sc_ek;
}
}
}
/*recip*/
get_ev2_norms( h, f, g, e, &r_norm, &r_sq );
if ( r_norm != 0.0f )
{
r_norm *= 2*M_PIF;
r_sq *= 4*M_PIF*M_PIF;
sc = 1 - sigma_sq*r_sq/3;
sc *= 1 + (inv_alpha2*r_sq/4)*(1+inv_alpha2*r_sq/2);
sc *= 6* M_PIF *EXPD(-inv_alpha2*r_sq/4)/r_sq;
sc *= cos( 2 * M_PIF * (v[0] * h + v[1] * f + v[2] * g) );
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = sc * e[k];
Qp[ k * 4 ] += sc - sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Qp[ k + l * 3 ] -= e[l] * sc_ek;
}
}
}
}
}
}
for ( k = 0; k < 3; ++k )
{
_tD[ k * 4 ] += preDii * ( Op[k * 4] + preQ * Qp[k * 4] );
for ( l = 0; l < k; ++l )
{
_tD[ k + l * 3 ] += preDii * ( Op[ k + l * 3 ] + preQ * Qp[ k + l * 3 ]);
_tD[ l + k * 3 ] += preDii * ( Op[ k + l * 3 ] + preQ * Qp[ k + l * 3 ]);
}
}
}
/* divide two doubles */
double
__divdf3 (double a1, double a2)
{
register union double_long fl1, fl2;
register long long mask,result;
register int exp, sign;
fl1.d = a1;
fl2.d = a2;
/* subtract exponents */
exp = EXPD(fl1) - EXPD(fl2) + EXCESSD;
/* compute sign */
sign = SIGND(fl1) ^ SIGND(fl2);
/* numerator zero??? */
if (fl1.ll == 0) {
/* divide by zero??? */
if (fl2.ll == 0)
fl1.ll = ((unsigned long long)1<<63)-1; /* NaN */
else
fl1.ll = 0;
goto test_done;
}
/* return +Inf or -Inf */
if (fl2.ll == 0) {
fl1.ll = PACKD_LL(SIGND(fl1),2047,0);
goto test_done;
}
/* now get mantissas */
fl1.ll = MANTD_LL(fl1);
fl2.ll = MANTD_LL(fl2);
/* this assures we have 54 bits of precision in the end */
if (fl1.ll < fl2.ll) {
fl1.ll <<= 1;
exp--;
}
/* now we perform repeated subtraction of fl2.ll from fl1.ll */
mask = (long long)1<<53;
result = 0;
while (mask) {
if (fl1.ll >= fl2.ll)
{
result |= mask;
fl1.ll -= fl2.ll;
}
fl1.ll <<= 1;
mask >>= 1;
}
/* round */
result += 1;
/* normalize down */
exp++;
result >>= 1;
result &= ~HIDDEND_LL;
/* pack up and go home */
fl1.ll = PACKD_LL(sign, exp, result);
test_done:
return (fl1.d);
}
void diff_tensor_calc_ewald_smith( INT i, INT j, DOUBLE* _tD )
{
DOUBLE sigma_i = coord[ DIMS1 * j + 3 ];
DOUBLE sigma_j = coord[ DIMS1 * i + 3 ];
DOUBLE v[3];
const DOUBLE sigma_sq = 0.5 * (sigma_i * sigma_i + sigma_j * sigma_j);
INT k, l;
DOUBLE Op[9] = {0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0};
DOUBLE Qp[9] = {0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0};
INT f, g, h;
const DOUBLE preQ = 0.5 * sigma_sq * inv_L[0] * inv_L[0] * inv_L[0];
dist_vec( coord + j*DIMS1, coord + i*DIMS1, v );
if ( (v[0] * v[0] + v[1] * v[1] + v[2] * v[2]) < (sigma_i + sigma_j)*(sigma_i + sigma_j) && i != j )
{
DOUBLE r_norm, r_sq, e[3];
get_ev2_norms( v[0], v[1], v[2], e, &r_norm, &r_sq );
{/*add overlapping Dij*/
DOUBLE sigma = (sigma_i + sigma_j) / 2;
DOUBLE pre = preDii / sigma;
DOUBLE part1 = (1 - (9 * r_norm / (32 * sigma)));
for ( i = 0; i < 3; ++i )
{
_tD[ i + 3 * i ] += pre * (part1 + 3 * e[i] * e[i] * r_norm / (32 * sigma));
for ( j = 0; j < i; ++j )
{
DOUBLE vval = pre * 3 * e[i] * e[j] * r_norm / (32 * sigma);
_tD[ j + 3 * i ] += vval;
_tD[ i + 3 * j ] += vval;
}
}
}
{/*remove none overlapping Dij*/
DOUBLE pre = preDij / r_norm;
DOUBLE sigm_r = (sigma_i * sigma_i + sigma_j * sigma_j) / r_sq;
DOUBLE part1 = 1 + sigm_r / 3;
for ( i = 0; i < 3; ++i )
{
_tD[ i + 3 * i ] -= pre*(part1 + e[i] * e[i]*(1 - sigm_r));
for ( j = 0; j < i; ++j )
{
DOUBLE vval = pre * e[i] * e[j] * (1 - sigm_r);
_tD[ j + 3 * i ] -= vval;
_tD[ i + 3 * j ] -= vval;
}
}
}
}
v[0] *= inv_L[0];
v[1] *= inv_L[1];
v[2] *= inv_L[2];
for ( h = -ewald_rr; h <= ewald_rr; ++h )
{
int next_f = (int)SQRTD( rr_sq - h*h );
for ( f = -next_f; f <= next_f; ++f )
{
int next_g = (int)SQRTD( rr_sq - h*h - f*f );
for ( g = -next_g; g <= next_g; ++g )
{
DOUBLE r_norm, r_sq, e[3];
DOUBLE inv_r;
DOUBLE inv_r3;
DOUBLE sc;
DOUBLE sc2;
get_ev2_norms( v[0] + h, v[1] + f, v[2] + g, e, &r_norm, &r_sq );
if ( r_norm != 0.0f )
{
inv_r = 1 / r_norm;
inv_r3 = 1 / (r_norm * r_sq);
sc = ERFCD( r_norm * ewald_alpha ) * inv_r;
sc2 = 2 * ewald_alpha * M1_SQRTPI * EXPD( -alpha2 * r_sq );
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = e[k] * (sc + sc2);
Op[ k * 4 ] += sc + sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Op[ k + l * 3 ] += e[l] * sc_ek;
}
}
sc = inv_r3 * (ERFCD( r_norm * ewald_alpha ) + 2 * ewald_alpha * r_norm * M1_SQRTPI * EXPD( -alpha2 * r_sq ));
sc2 = -4 * alpha3 * M1_SQRTPI * EXPD( -alpha2 * r_sq );
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = (-3 * sc + sc2) * e[k];
Qp[ k * 4 ] += sc + sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Qp[ k + l * 3 ] += e[l] * sc_ek;
}
}
}
/*recip*/
get_ev2_norms( h, f, g, e, &r_norm, &r_sq );
if ( r_norm != 0.0f )
{
sc = 2 * EXPD( M_PI_ALPHA_SQ * r_sq ) / (M_PIF * r_sq);
sc2 = -1 + M_PI_ALPHA_SQ * r_sq;
sc *= cos( 2 * M_PIF * (v[0] * h + v[1] * f + v[2] * g) );
sc2 *= sc;
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = sc2 * e[k];
Op[ k * 4 ] += sc + sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Op[ k + l * 3 ] += e[l] * sc_ek;
}
}
sc = 4 * M_PIF * EXPD( M_PI_ALPHA_SQ * r_sq );
sc *= cos( 2 * M_PIF * (v[0] * h + v[1] * f + v[2] * g) );
for ( k = 0; k < 3; ++k )
{
DOUBLE sc_ek = sc * e[k];
Qp[ k * 4 ] += sc_ek * e[k];
for ( l = 0; l < k; ++l )
{
Qp[ k + l * 3 ] += e[l] * sc_ek;
}
}
}
}
}
}
for ( k = 0; k < 3; ++k )
{
_tD[ k * 4 ] += preDii * (preO * Op[k * 4] + preQ * Qp[k * 4]);
for ( l = 0; l < k; ++l )
{
_tD[ k + l * 3 ] += preDii * (preO * Op[ k + l * 3 ] + preQ * Qp[ k + l * 3 ]);
_tD[ l + k * 3 ] += preDii * (preO * Op[ k + l * 3 ] + preQ * Qp[ k + l * 3 ]);
}
}
}