bool VECTOR_ensure_not_complex(CVECTOR *_object)
{
gsl_vector *v;
int size = SIZE(THIS);
int i;
gsl_complex c;
if (!COMPLEX(THIS))
return FALSE;
for (i = 0; i < size; i++)
{
c = gsl_vector_complex_get(CVEC(THIS), i);
if (GSL_IMAG(c) != 0.0)
return TRUE;
}
v = gsl_vector_alloc(size);
for (i = 0; i < size; i++)
gsl_vector_set(v, i, GSL_REAL(gsl_vector_complex_get(CVEC(THIS), i)));
gsl_vector_complex_free(CVEC(THIS));
THIS->vector = v;
THIS->complex = FALSE;
return FALSE;
}
static CVECTOR *VECTOR_copy(CVECTOR *_object)
{
CVECTOR *copy = VECTOR_create(SIZE(THIS), COMPLEX(THIS), FALSE);
if (!COMPLEX(THIS))
gsl_vector_memcpy(VEC(copy), VEC(THIS));
else
gsl_vector_complex_memcpy(CVEC(copy), CVEC(THIS));
return copy;
}
static int _equal(CVECTOR *a, CVECTOR *b, bool invert)
{
if (COMPLEX(a) || COMPLEX(b))
{
VECTOR_ensure_complex(a);
VECTOR_ensure_complex(b);
return gsl_vector_complex_equal(CVEC(a), CVEC(b));
}
else
return gsl_vector_equal(VEC(a), VEC(b));
}
static void
update_fragment(struct frag *frag)
{
/* update atoms */
for (size_t i = 0; i < frag->n_atoms; i++)
efp_move_pt(CVEC(frag->x), &frag->rotmat,
CVEC(frag->lib->atoms[i].x), VEC(frag->atoms[i].x));
efp_update_elec(frag);
efp_update_pol(frag);
efp_update_disp(frag);
efp_update_xr(frag);
}
void
efp_update_pol(struct frag *frag)
{
for (size_t i = 0; i < frag->n_polarizable_pts; i++) {
efp_move_pt(CVEC(frag->x), &frag->rotmat,
CVEC(frag->lib->polarizable_pts[i].x),
VEC(frag->polarizable_pts[i].x));
const mat_t *in = &frag->lib->polarizable_pts[i].tensor;
mat_t *out = &frag->polarizable_pts[i].tensor;
efp_rotate_t2(&frag->rotmat, (const double *)in, (double *)out);
}
}
static CVECTOR *_sub(CVECTOR *a, CVECTOR *b, bool invert)
{
CVECTOR *v = VECTOR_make(a);
if (COMPLEX(v) || COMPLEX(b))
{
VECTOR_ensure_complex(v);
VECTOR_ensure_complex(b);
gsl_vector_complex_sub(CVEC(v), CVEC(b));
}
else
gsl_vector_sub(VEC(v), VEC(b));
return v;
}
static char *_to_string(CVECTOR *_object, bool local)
{
char *result = NULL;
int i;
int size = SIZE(THIS);
char *str;
int len;
result = GB.AddChar(result, '[');
for (i = 0; i < size; i++)
{
if (i)
result = GB.AddChar(result, local ? ' ' : ',');
if (!COMPLEX(THIS))
{
GB.NumberToString(local, gsl_vector_get(VEC(THIS), i), NULL, &str, &len);
result = GB.AddString(result, str, len);
}
else
{
str = COMPLEX_to_string(gsl_vector_complex_get(CVEC(THIS), i), local);
result = GB.AddString(result, str, GB.StringLength(str));
GB.FreeString(&str);
}
}
result = GB.AddChar(result, ']');
return result;
}
static double
disp_tt(struct efp *efp, size_t fr_i_idx, size_t fr_j_idx,
size_t pt_i_idx, size_t pt_j_idx, double sum, const struct swf *swf)
{
const struct frag *fr_i = efp->frags + fr_i_idx;
const struct frag *fr_j = efp->frags + fr_j_idx;
const struct dynamic_polarizable_pt *pt_i =
fr_i->dynamic_polarizable_pts + pt_i_idx;
const struct dynamic_polarizable_pt *pt_j =
fr_j->dynamic_polarizable_pts + pt_j_idx;
vec_t dr = {
pt_j->x - pt_i->x - swf->cell.x,
pt_j->y - pt_i->y - swf->cell.y,
pt_j->z - pt_i->z - swf->cell.z
};
double r = vec_len(&dr);
double r2 = r * r;
double r6 = r2 * r2 * r2;
double damp = get_damp_tt(r);
double energy = -4.0 / 3.0 * sum * damp / r6;
if (efp->do_gradient) {
double gdamp = get_damp_tt_grad(r);
double g = 4.0 / 3.0 * sum * (gdamp / r - 6.0 * damp / r2) / r6;
vec_t force = {
g * dr.x * swf->swf,
g * dr.y * swf->swf,
g * dr.z * swf->swf
};
efp_add_force(efp->grad + fr_i_idx, CVEC(fr_i->x),
CVEC(pt_i->x), &force, NULL);
efp_sub_force(efp->grad + fr_j_idx, CVEC(fr_j->x),
CVEC(pt_j->x), &force, NULL);
efp_add_stress(&swf->dr, &force, &efp->stress);
}
return energy;
}
void
efp_update_disp(struct frag *frag)
{
for (size_t i = 0; i < frag->n_dynamic_polarizable_pts; i++) {
const struct dynamic_polarizable_pt *pt_in =
frag->lib->dynamic_polarizable_pts + i;
struct dynamic_polarizable_pt *pt_out =
frag->dynamic_polarizable_pts + i;
efp_move_pt(CVEC(frag->x), &frag->rotmat, CVEC(pt_in->x), VEC(pt_out->x));
for (size_t j = 0; j < 12; j++) {
const mat_t *in = pt_in->tensor + j;
mat_t *out = pt_out->tensor + j;
efp_rotate_t2(&frag->rotmat, (const double *)in, (double *)out);
}
}
}
static CVECTOR *_mulf(CVECTOR *a, double f, bool invert)
{
CVECTOR *v = VECTOR_make(a);
if (COMPLEX(v))
gsl_vector_complex_scale(CVEC(v), gsl_complex_rect(f, 0));
else
gsl_vector_scale(VEC(v), f);
return v;
}
static CVECTOR *_mulo(CVECTOR *a, void *b, bool invert)
{
CVECTOR *v = VECTOR_make(a);
if (!GB.Is(b, CLASS_Complex))
return NULL;
VECTOR_ensure_complex(v);
gsl_vector_complex_scale(CVEC(v), ((CCOMPLEX *)b)->number);
return v;
}
static CVECTOR *_divo(CVECTOR *a, void *b, bool invert)
{
if (!GB.Is(b, CLASS_Complex))
return NULL;
CCOMPLEX *c = (CCOMPLEX *)b;
if (invert)
return NULL;
if (GSL_REAL(c->number) == 0 && GSL_IMAG(c->number) == 0)
{
GB.Error(GB_ERR_ZERO);
return NULL;
}
CVECTOR *v = VECTOR_make(a);
VECTOR_ensure_complex(v);
gsl_vector_complex_scale(CVEC(v), gsl_complex_inverse(c->number));
return v;
}
static double
disp_overlap(struct efp *efp, size_t fr_i_idx, size_t fr_j_idx,
size_t pt_i_idx, size_t pt_j_idx, double s_ij, six_t ds_ij,
double sum, const struct swf *swf)
{
const struct frag *fr_i = efp->frags + fr_i_idx;
const struct frag *fr_j = efp->frags + fr_j_idx;
const struct dynamic_polarizable_pt *pt_i =
fr_i->dynamic_polarizable_pts + pt_i_idx;
const struct dynamic_polarizable_pt *pt_j =
fr_j->dynamic_polarizable_pts + pt_j_idx;
vec_t dr = {
pt_j->x - pt_i->x - swf->cell.x,
pt_j->y - pt_i->y - swf->cell.y,
pt_j->z - pt_i->z - swf->cell.z
};
double r = vec_len(&dr);
double r2 = r * r;
double r6 = r2 * r2 * r2;
double ln_s = 0.0;
double damp = 1.0;
if (fabs(s_ij) > 1.0e-5) {
ln_s = log(fabs(s_ij));
damp = 1.0 - s_ij * s_ij * (1.0 - 2.0 * ln_s + 2.0 * ln_s * ln_s);
}
double energy = -4.0 / 3.0 * sum * damp / r6;
if (efp->do_gradient) {
vec_t force, torque_i, torque_j;
double t1 = -8.0 * sum / r6 / r2 * damp;
double t2 = -16.0 / 3.0 * sum / r6 * ln_s * ln_s * s_ij;
vec_t dr_i = vec_sub(CVEC(pt_i->x), CVEC(fr_i->x));
vec_t dr_j = vec_sub(CVEC(pt_j->x), CVEC(fr_j->x));
force.x = (t1 * dr.x - t2 * ds_ij.x) * swf->swf;
force.y = (t1 * dr.y - t2 * ds_ij.y) * swf->swf;
force.z = (t1 * dr.z - t2 * ds_ij.z) * swf->swf;
torque_i.x = swf->swf * (t1 * (dr.z * dr_i.y - dr.y * dr_i.z) +
t2 * ds_ij.a);
torque_i.y = swf->swf * (t1 * (dr.x * dr_i.z - dr.z * dr_i.x) +
t2 * ds_ij.b);
torque_i.z = swf->swf * (t1 * (dr.y * dr_i.x - dr.x * dr_i.y) +
t2 * ds_ij.c);
torque_j.x = swf->swf * (t1 * (dr.z * dr_j.y - dr.y * dr_j.z) +
t2 * (ds_ij.z * swf->dr.y - ds_ij.y * swf->dr.z) +
t2 * ds_ij.a);
torque_j.y = swf->swf * (t1 * (dr.x * dr_j.z - dr.z * dr_j.x) +
t2 * (ds_ij.x * swf->dr.z - ds_ij.z * swf->dr.x) +
t2 * ds_ij.b);
torque_j.z = swf->swf * (t1 * (dr.y * dr_j.x - dr.x * dr_j.y) +
t2 * (ds_ij.y * swf->dr.x - ds_ij.x * swf->dr.y) +
t2 * ds_ij.c);
six_atomic_add_xyz(efp->grad + fr_i_idx, &force);
six_atomic_add_abc(efp->grad + fr_i_idx, &torque_i);
six_atomic_sub_xyz(efp->grad + fr_j_idx, &force);
six_atomic_sub_abc(efp->grad + fr_j_idx, &torque_j);
efp_add_stress(&swf->dr, &force, &efp->stress);
}
return energy;
}
void efp_st_int(size_t n_atoms_i, const struct xr_atom *atoms_i,
size_t n_atoms_j, const struct xr_atom *atoms_j,
size_t stride, double *s, double *t)
{
double xin[90];
double yin[90];
double zin[90];
double ft[100], dij[100];
double sblk[100], tblk[100];
for (size_t iii = 0, loc_i = 0; iii < n_atoms_i; iii++) {
const struct xr_atom *at_i = atoms_i + iii;
/* shell i */
for (size_t ii = 0; ii < at_i->n_shells; ii++) {
const struct shell *sh_i = at_i->shells + ii;
size_t type_i = get_shell_idx(sh_i->type);
size_t start_i = get_shell_start(type_i);
size_t end_i = get_shell_end(type_i);
size_t sl_i = get_shell_sl(type_i);
size_t count_i = end_i - start_i;
for (size_t jjj = 0, loc_j = 0; jjj < n_atoms_j; jjj++) {
const struct xr_atom *at_j = atoms_j + jjj;
/* shell j */
for (size_t jj = 0; jj < at_j->n_shells; jj++) {
const struct shell *sh_j = at_j->shells + jj;
size_t type_j = get_shell_idx(sh_j->type);
size_t start_j = get_shell_start(type_j);
size_t end_j = get_shell_end(type_j);
size_t sl_j = get_shell_sl(type_j);
size_t count_j = end_j - start_j;
size_t count = count_i * count_j;
memset(sblk, 0, count * sizeof(double));
memset(tblk, 0, count * sizeof(double));
init_ft(count_i, sh_j->type, ft);
double rr = vec_dist_2(CVEC(at_i->x), CVEC(at_j->x));
const size_t *shift_x = shift_table_x[type_i * 5 + type_j];
const size_t *shift_y = shift_table_y[type_i * 5 + type_j];
const size_t *shift_z = shift_table_z[type_i * 5 + type_j];
const double *coef_i = sh_i->coef;
/* primitive i */
for (size_t ig = 0; ig < sh_i->n_funcs; ig++) {
double ai = *coef_i++;
double con_i[20];
set_coef(con_i, sh_i->type, coef_i);
coef_i++;
if (sh_i->type == 'L')
coef_i++;
const double *coef_j = sh_j->coef;
/* primitive j */
for (size_t jg = 0; jg < sh_j->n_funcs; jg++) {
double aj = *coef_j++;
double aa = 1.0 / (ai + aj);
double tmp = aj * ai * rr * aa;
if (tmp > int_tol) {
coef_j++;
if (sh_j->type == 'L')
coef_j++;
continue;
}
double con_j[20];
set_coef(con_j, sh_j->type, coef_j);
coef_j++;
if (sh_j->type == 'L')
coef_j++;
vec_t a = {
(ai * at_i->x + aj * at_j->x) * aa,
(ai * at_i->y + aj * at_j->y) * aa,
(ai * at_i->z + aj * at_j->z) * aa
};
double fac = exp(-tmp);
for (size_t i = start_i, idx = 0; i < end_i; i++)
for (size_t j = start_j; j < end_j; j++, idx++)
dij[idx] = fac * con_i[i] * int_norm[i] * con_j[j] * int_norm[j];
double taa = sqrt(aa);
double t1 = -2.0 * aj * aj * taa;
double t2 = -0.5 * taa;
for (size_t i = 0, idx = 0; i < sl_i; i++, idx += 5) {
for (size_t j = 0; j < sl_j; j++) {
vec_t iout;
make_int(i, j, taa, &a, CVEC(at_i->x), CVEC(at_j->x), &iout);
xin[idx + j] = iout.x * taa;
yin[idx + j] = iout.y * taa;
zin[idx + j] = iout.z * taa;
make_int(i, j + 2, taa, &a, CVEC(at_i->x), CVEC(at_j->x), &iout);
xin[idx + j + 30] = iout.x * t1;
yin[idx + j + 30] = iout.y * t1;
zin[idx + j + 30] = iout.z * t1;
if (j >= 2) {
make_int(i, j - 2, taa, &a, CVEC(at_i->x), CVEC(at_j->x), &iout);
double t3 = j * (j - 1) * t2;
xin[idx + j + 60] = iout.x * t3;
yin[idx + j + 60] = iout.y * t3;
zin[idx + j + 60] = iout.z * t3;
}
else {
xin[idx + j + 60] = 0.0;
yin[idx + j + 60] = 0.0;
zin[idx + j + 60] = 0.0;
}
}
}
for (size_t i = 0; i < count; i++) {
size_t nx = shift_x[i];
size_t ny = shift_y[i];
size_t nz = shift_z[i];
double xyz = xin[nx] * yin[ny] * zin[nz];
double add = (xin[nx + 30] + xin[nx + 60]) * yin[ny] * zin[nz] +
(yin[ny + 30] + yin[ny + 60]) * xin[nx] * zin[nz] +
(zin[nz + 30] + zin[nz + 60]) * xin[nx] * yin[ny];
sblk[i] = sblk[i] + dij[i] * xyz;
tblk[i] = tblk[i] + dij[i] * (xyz * aj * ft[i] + add);
}
}
}
/* store integrals */
for (size_t i = 0, idx = 0; i < count_i; i++) {
size_t idx2 = (loc_i + i) * stride + loc_j;
for (size_t j = 0; j < count_j; j++, idx++, idx2++) {
s[idx2] = sblk[idx];
t[idx2] = tblk[idx];
}
}
loc_j += count_j;
}}
loc_i += count_i;
}}
}
static void
compute_grad_point(struct efp *efp, size_t frag_idx, size_t pt_idx)
{
const struct frag *fr_i = efp->frags + frag_idx;
const struct polarizable_pt *pt_i = fr_i->polarizable_pts + pt_idx;
size_t idx_i = fr_i->polarizable_offset + pt_idx;
vec_t dipole_i = {
0.5 * (efp->indip[idx_i].x + efp->indipconj[idx_i].x),
0.5 * (efp->indip[idx_i].y + efp->indipconj[idx_i].y),
0.5 * (efp->indip[idx_i].z + efp->indipconj[idx_i].z)
};
for (size_t j = 0; j < efp->n_frag; j++) {
if (j == frag_idx || efp_skip_frag_pair(efp, frag_idx, j))
continue;
struct frag *fr_j = efp->frags + j;
struct swf swf = efp_make_swf(efp, fr_i, fr_j);
/* energy without switching applied */
double energy = 0.0;
/* induced dipole - nuclei */
for (size_t k = 0; k < fr_j->n_atoms; k++) {
struct efp_atom *at_j = fr_j->atoms + k;
vec_t dr = {
at_j->x - pt_i->x - swf.cell.x,
at_j->y - pt_i->y - swf.cell.y,
at_j->z - pt_i->z - swf.cell.z
};
double p1 = 1.0, p2 = 0.0;
if (efp->opts.pol_damp == EFP_POL_DAMP_TT) {
double r = vec_len(&dr);
p1 = efp_get_pol_damp_tt(r, fr_i->pol_damp,
fr_j->pol_damp);
p2 = efp_get_pol_damp_tt_grad(r, fr_i->pol_damp,
fr_j->pol_damp);
}
vec_t force, add_i, add_j;
double e = -efp_charge_dipole_energy(at_j->znuc, &dipole_i, &dr);
efp_charge_dipole_grad(at_j->znuc, &dipole_i, &dr,
&force, &add_j, &add_i);
vec_negate(&force);
vec_scale(&force, p1);
vec_scale(&add_i, p1);
vec_scale(&add_j, p1);
force.x += p2 * e * dr.x;
force.y += p2 * e * dr.y;
force.z += p2 * e * dr.z;
vec_scale(&force, swf.swf);
vec_scale(&add_i, swf.swf);
vec_scale(&add_j, swf.swf);
efp_add_force(efp->grad + frag_idx, CVEC(fr_i->x),
CVEC(pt_i->x), &force, &add_i);
efp_sub_force(efp->grad + j, CVEC(fr_j->x),
CVEC(at_j->x), &force, &add_j);
efp_add_stress(&swf.dr, &force, &efp->stress);
energy += p1 * e;
}
/* induced dipole - multipoles */
for (size_t k = 0; k < fr_j->n_multipole_pts; k++) {
struct multipole_pt *pt_j = fr_j->multipole_pts + k;
vec_t dr = {
pt_j->x - pt_i->x - swf.cell.x,
pt_j->y - pt_i->y - swf.cell.y,
pt_j->z - pt_i->z - swf.cell.z
};
double p1 = 1.0, p2 = 0.0;
if (efp->opts.pol_damp == EFP_POL_DAMP_TT) {
double r = vec_len(&dr);
p1 = efp_get_pol_damp_tt(r, fr_i->pol_damp,
fr_j->pol_damp);
p2 = efp_get_pol_damp_tt_grad(r, fr_i->pol_damp,
fr_j->pol_damp);
}
double e = 0.0;
vec_t force_, add_i_, add_j_;
vec_t force = vec_zero, add_i = vec_zero, add_j = vec_zero;
/* induced dipole - charge */
e -= efp_charge_dipole_energy(pt_j->monopole, &dipole_i, &dr);
efp_charge_dipole_grad(pt_j->monopole, &dipole_i, &dr,
&force_, &add_j_, &add_i_);
vec_negate(&force_);
add_3(&force, &force_, &add_i, &add_i_, &add_j, &add_j_);
/* induced dipole - dipole */
e += efp_dipole_dipole_energy(&dipole_i, &pt_j->dipole, &dr);
efp_dipole_dipole_grad(&dipole_i, &pt_j->dipole, &dr,
&force_, &add_i_, &add_j_);
vec_negate(&add_j_);
add_3(&force, &force_, &add_i, &add_i_, &add_j, &add_j_);
/* induced dipole - quadrupole */
e += efp_dipole_quadrupole_energy(&dipole_i, pt_j->quadrupole, &dr);
efp_dipole_quadrupole_grad(&dipole_i, pt_j->quadrupole, &dr,
&force_, &add_i_, &add_j_);
add_3(&force, &force_, &add_i, &add_i_, &add_j, &add_j_);
/* induced dipole - octupole interactions are ignored */
vec_scale(&force, p1);
vec_scale(&add_i, p1);
vec_scale(&add_j, p1);
force.x += p2 * e * dr.x;
force.y += p2 * e * dr.y;
force.z += p2 * e * dr.z;
vec_scale(&force, swf.swf);
vec_scale(&add_i, swf.swf);
vec_scale(&add_j, swf.swf);
efp_add_force(efp->grad + frag_idx, CVEC(fr_i->x),
CVEC(pt_i->x), &force, &add_i);
efp_sub_force(efp->grad + j, CVEC(fr_j->x),
CVEC(pt_j->x), &force, &add_j);
efp_add_stress(&swf.dr, &force, &efp->stress);
energy += p1 * e;
}
/* induced dipole - induced dipoles */
for (size_t jj = 0; jj < fr_j->n_polarizable_pts; jj++) {
struct polarizable_pt *pt_j = fr_j->polarizable_pts + jj;
size_t idx_j = fr_j->polarizable_offset + jj;
vec_t dr = {
pt_j->x - pt_i->x - swf.cell.x,
pt_j->y - pt_i->y - swf.cell.y,
pt_j->z - pt_i->z - swf.cell.z
};
vec_t half_dipole_i = {
0.5 * efp->indip[idx_i].x,
0.5 * efp->indip[idx_i].y,
0.5 * efp->indip[idx_i].z
};
double p1 = 1.0, p2 = 0.0;
if (efp->opts.pol_damp == EFP_POL_DAMP_TT) {
double r = vec_len(&dr);
p1 = efp_get_pol_damp_tt(r, fr_i->pol_damp,
fr_j->pol_damp);
p2 = efp_get_pol_damp_tt_grad(r, fr_i->pol_damp,
fr_j->pol_damp);
}
vec_t force, add_i, add_j;
double e = efp_dipole_dipole_energy(&half_dipole_i,
&efp->indipconj[idx_j], &dr);
efp_dipole_dipole_grad(&half_dipole_i, &efp->indipconj[idx_j],
&dr, &force, &add_i, &add_j);
vec_negate(&add_j);
vec_scale(&force, p1);
vec_scale(&add_i, p1);
vec_scale(&add_j, p1);
force.x += p2 * e * dr.x;
force.y += p2 * e * dr.y;
force.z += p2 * e * dr.z;
vec_scale(&force, swf.swf);
vec_scale(&add_i, swf.swf);
vec_scale(&add_j, swf.swf);
efp_add_force(efp->grad + frag_idx, CVEC(fr_i->x),
CVEC(pt_i->x), &force, &add_i);
efp_sub_force(efp->grad + j, CVEC(fr_j->x),
CVEC(pt_j->x), &force, &add_j);
efp_add_stress(&swf.dr, &force, &efp->stress);
energy += p1 * e;
}
vec_t force = {
swf.dswf.x * energy,
swf.dswf.y * energy,
swf.dswf.z * energy
};
six_atomic_add_xyz(efp->grad + frag_idx, &force);
six_atomic_sub_xyz(efp->grad + j, &force);
efp_add_stress(&swf.dr, &force, &efp->stress);
}
/* induced dipole - ab initio nuclei */
if (efp->opts.terms & EFP_TERM_AI_POL) {
for (size_t j = 0; j < efp->n_ptc; j++) {
vec_t dr = vec_sub(efp->ptc_xyz + j, CVEC(pt_i->x));
vec_t force, add_i, add_j;
efp_charge_dipole_grad(efp->ptc[j], &dipole_i, &dr,
&force, &add_j, &add_i);
vec_negate(&add_i);
vec_atomic_add(efp->ptc_grad + j, &force);
efp_sub_force(efp->grad + frag_idx, CVEC(fr_i->x),
CVEC(pt_i->x), &force, &add_i);
}
}
}
static vec_t
get_elec_field(const struct efp *efp, size_t frag_idx, size_t pt_idx)
{
const struct frag *fr_j = efp->frags + frag_idx;
const struct polarizable_pt *pt = fr_j->polarizable_pts + pt_idx;
vec_t elec_field = vec_zero;
for (size_t i = 0; i < efp->n_frag; i++) {
if (i == frag_idx || efp_skip_frag_pair(efp, i, frag_idx))
continue;
const struct frag *fr_i = efp->frags + i;
struct swf swf = efp_make_swf(efp, fr_i, fr_j);
/* field due to nuclei */
for (size_t j = 0; j < fr_i->n_atoms; j++) {
const struct efp_atom *at = fr_i->atoms + j;
vec_t dr = {
pt->x - at->x - swf.cell.x,
pt->y - at->y - swf.cell.y,
pt->z - at->z - swf.cell.z
};
double r = vec_len(&dr);
double r3 = r * r * r;
double p1 = 1.0;
if (efp->opts.pol_damp == EFP_POL_DAMP_TT)
p1 = efp_get_pol_damp_tt(r, fr_i->pol_damp, fr_j->pol_damp);
elec_field.x += swf.swf * at->znuc * dr.x / r3 * p1;
elec_field.y += swf.swf * at->znuc * dr.y / r3 * p1;
elec_field.z += swf.swf * at->znuc * dr.z / r3 * p1;
}
/* field due to multipoles */
for (size_t j = 0; j < fr_i->n_multipole_pts; j++) {
const struct multipole_pt *mult_pt = fr_i->multipole_pts + j;
vec_t mult_field = get_multipole_field(CVEC(pt->x), mult_pt, &swf);
vec_t dr = {
pt->x - mult_pt->x - swf.cell.x,
pt->y - mult_pt->y - swf.cell.y,
pt->z - mult_pt->z - swf.cell.z
};
double r = vec_len(&dr);
double p1 = 1.0;
if (efp->opts.pol_damp == EFP_POL_DAMP_TT)
p1 = efp_get_pol_damp_tt(r, fr_i->pol_damp, fr_j->pol_damp);
elec_field.x += mult_field.x * p1;
elec_field.y += mult_field.y * p1;
elec_field.z += mult_field.z * p1;
}
}
if (efp->opts.terms & EFP_TERM_AI_POL) {
/* field due to nuclei from ab initio subsystem */
for (size_t i = 0; i < efp->n_ptc; i++) {
vec_t dr = vec_sub(CVEC(pt->x), efp->ptc_xyz + i);
double r = vec_len(&dr);
double r3 = r * r * r;
elec_field.x += efp->ptc[i] * dr.x / r3;
elec_field.y += efp->ptc[i] * dr.y / r3;
elec_field.z += efp->ptc[i] * dr.z / r3;
}
}
return (elec_field);
}
static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
{
if (THIS)
{
if (!COMPLEX(THIS))
{
switch (type)
{
case GB_T_FLOAT:
conv->_float.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_SINGLE:
conv->_single.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
conv->_integer.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_LONG:
conv->_long.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_string.value.addr = _to_string(THIS, type == GB_T_CSTRING);
conv->_string.value.start = 0;
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
return FALSE;
default:
break;
}
}
else
{
switch (type)
{
case GB_T_FLOAT:
conv->_float.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_SINGLE:
conv->_single.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
conv->_integer.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_LONG:
conv->_long.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_string.value.addr = _to_string(THIS, type == GB_T_CSTRING);
conv->_string.value.start = 0;
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
return FALSE;
default:
break;
}
}
// Vector ---> Float[]
if ((type == GB.FindClass("Float[]") || type == CLASS_Polynomial) && !COMPLEX(THIS))
{
GB_ARRAY a;
int i;
double *data;
GB.Array.New(&a, GB_T_FLOAT, SIZE(THIS));
data = (double *)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
data[i] = gsl_vector_get(VEC(THIS), i);
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
// Vector ---> Complex[]
else if (type == GB.FindClass("Complex[]") || type == CLASS_Polynomial)
{
GB_ARRAY a;
int i;
void **data;
CCOMPLEX *c;
GB.Array.New(&a, CLASS_Complex, SIZE(THIS));
data = (void **)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
{
c = COMPLEX_create(COMPLEX(THIS) ? gsl_vector_complex_get(CVEC(THIS), i) : gsl_complex_rect(gsl_vector_get(VEC(THIS), i), 0));
data[i] = c;
GB.Ref(c);
}
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
else
return TRUE;
// Vector ---> Polynomial
if (type == CLASS_Polynomial)
{
void *unref = conv->_object.value;
GB.Ref(unref); // Will be unref by the next GB.Conv()
POLYNOMIAL_convert(FALSE, type, conv);
GB.Unref(&unref); // Will be unref by the next GB.Conv()
//GB.Conv(conv, type);
//GB.UnrefKeep(&conv->_object.value, FALSE); // Will be ref again after the current GB.Conv()
return FALSE;
}
}
else if (type >= GB_T_OBJECT)
{
if (GB.Is(conv->_object.value, CLASS_Array))
{
GB_ARRAY array = (GB_ARRAY)conv->_object.value;
int size = GB.Array.Count(array);
CVECTOR *v;
int i;
GB_VALUE temp;
void *data;
GB_TYPE atype = GB.Array.Type(array);
// Float[] Integer[] ... ---> Vector
if (atype > GB_T_BOOLEAN && atype <= GB_T_FLOAT)
{
v = VECTOR_create(size, FALSE, FALSE);
for (i = 0; i < size; i++)
{
data = GB.Array.Get(array, i);
GB.ReadValue(&temp, data, atype);
GB.Conv(&temp, GB_T_FLOAT);
gsl_vector_set(VEC(v), i, temp._float.value);
}
conv->_object.value = v;
return FALSE;
}
// Variant[] ---> Vector
else if (atype == GB_T_VARIANT)
{
CCOMPLEX *c;
v = VECTOR_create(size, TRUE, FALSE);
for (i = 0; i < size; i++)
{
GB.ReadValue(&temp, GB.Array.Get(array, i), atype);
GB.BorrowValue(&temp);
GB.Conv(&temp, CLASS_Complex);
c = temp._object.value;
if (c)
gsl_vector_complex_set(CVEC(v), i, c->number);
else
gsl_vector_complex_set(CVEC(v), i, COMPLEX_zero);
GB.ReleaseValue(&temp);
}
conv->_object.value = v;
return FALSE;
}
// Complex[] ---> Vector
else if (atype == CLASS_Complex)
{
CCOMPLEX *c;
v = VECTOR_create(size, TRUE, FALSE);
for (i = 0; i < size; i++)
{
c = *((CCOMPLEX **)GB.Array.Get(array, i));
if (c)
gsl_vector_complex_set(CVEC(v), i, c->number);
else
gsl_vector_complex_set(CVEC(v), i, COMPLEX_zero);
}
conv->_object.value = v;
return FALSE;
}
}
// Float Integer... ---> Vector
else if (type > GB_T_BOOLEAN && type <= GB_T_FLOAT)
{
CVECTOR *v = VECTOR_create(1, FALSE, FALSE);
if (type == GB_T_FLOAT)
gsl_vector_set(VEC(v), 0, conv->_float.value);
else if (type == GB_T_SINGLE)
gsl_vector_set(VEC(v), 0, conv->_single.value);
else
gsl_vector_set(VEC(v), 0, conv->_integer.value);
conv->_object.value = v;
return FALSE;
}
// Complex ---> Vector
else if (type == CLASS_Complex)
{
CCOMPLEX *c = (CCOMPLEX *)conv->_object.value;
CVECTOR *v = VECTOR_create(1, TRUE, FALSE);
gsl_vector_complex_set(CVEC(v), 0, c->number);
conv->_object.value = v;
return FALSE;
}
}
return TRUE;
}
void efp_st_int_deriv(size_t n_atoms_i, const struct xr_atom *atoms_i,
size_t n_atoms_j, const struct xr_atom *atoms_j,
const vec_t *com_i, size_t size_i, size_t size_j,
six_t *ds, six_t *dt)
{
static const size_t shift_x[] = { 0, 1, 0, 0, 2, 0, 0, 1, 1, 0,
3, 0, 0, 2, 2, 1, 0, 1, 0, 1 };
static const size_t shift_y[] = { 0, 0, 1, 0, 0, 2, 0, 1, 0, 1,
0, 3, 0, 1, 0, 2, 2, 0, 1, 1 };
static const size_t shift_z[] = { 0, 0, 0, 1, 0, 0, 2, 0, 1, 1,
0, 0, 3, 0, 1, 0, 1, 2, 2, 1 };
double dij[100];
double xs[5][6], ys[5][6], zs[5][6];
double xt[5][4], yt[5][4], zt[5][4];
double dxs[4][4], dys[4][4], dzs[4][4];
double dxt[4][4], dyt[4][4], dzt[4][4];
memset(ds, 0, size_i * size_j * sizeof(six_t));
memset(dt, 0, size_i * size_j * sizeof(six_t));
for (size_t iii = 0, loc_i = 0; iii < n_atoms_i; iii++) {
const struct xr_atom *at_i = atoms_i + iii;
/* shell i */
for (size_t ii = 0; ii < at_i->n_shells; ii++) {
const struct shell *sh_i = at_i->shells + ii;
size_t type_i = get_shell_idx(sh_i->type);
size_t start_i = get_shell_start(type_i);
size_t end_i = get_shell_end(type_i);
size_t sl_i = get_shell_sl(type_i);
size_t count_i = end_i - start_i;
for (size_t jjj = 0, loc_j = 0; jjj < n_atoms_j; jjj++) {
const struct xr_atom *at_j = atoms_j + jjj;
/* shell j */
for (size_t jj = 0; jj < at_j->n_shells; jj++) {
const struct shell *sh_j = at_j->shells + jj;
size_t type_j = get_shell_idx(sh_j->type);
size_t start_j = get_shell_start(type_j);
size_t end_j = get_shell_end(type_j);
size_t sl_j = get_shell_sl(type_j);
size_t count_j = end_j - start_j;
double rr = vec_dist_2(CVEC(at_i->x), CVEC(at_j->x));
const double *coef_i = sh_i->coef;
/* primitive i */
for (size_t ig = 0; ig < sh_i->n_funcs; ig++) {
double ai = *coef_i++;
double con_i[20];
set_coef(con_i, sh_i->type, coef_i);
coef_i++;
if (sh_i->type == 'L')
coef_i++;
const double *coef_j = sh_j->coef;
/* primitive j */
for (size_t jg = 0; jg < sh_j->n_funcs; jg++) {
double aj = *coef_j++;
double aa = 1.0 / (ai + aj);
double tmp = ai * aj * rr * aa;
if (tmp > int_tol) {
coef_j++;
if (sh_j->type == 'L')
coef_j++;
continue;
}
double con_j[20];
set_coef(con_j, sh_j->type, coef_j);
coef_j++;
if (sh_j->type == 'L')
coef_j++;
double fac = exp(-tmp);
for (size_t i = start_i, idx = 0; i < end_i; i++)
for (size_t j = start_j; j < end_j; j++, idx++)
dij[idx] = fac * con_i[i] * int_norm[i] * con_j[j] * int_norm[j];
double taa = sqrt(aa);
vec_t a = {
(ai * at_i->x + aj * at_j->x) * aa,
(ai * at_i->y + aj * at_j->y) * aa,
(ai * at_i->z + aj * at_j->z) * aa
};
for (size_t i = 0; i < sl_i + 1; i++) {
for (size_t j = 0; j < sl_j + 2; j++) {
vec_t iout;
make_int(i, j, taa, &a, CVEC(at_i->x), CVEC(at_j->x), &iout);
xs[i][j] = iout.x * taa;
ys[i][j] = iout.y * taa;
zs[i][j] = iout.z * taa;
}
}
double ai2 = 2.0 * ai;
double aj2 = 2.0 * aj;
for (size_t i = 0; i < sl_i + 1; i++) {
xt[i][0] = (xs[i][0] - xs[i][2] * aj2) * aj;
yt[i][0] = (ys[i][0] - ys[i][2] * aj2) * aj;
zt[i][0] = (zs[i][0] - zs[i][2] * aj2) * aj;
}
if (sl_j > 1) {
for (size_t i = 0; i < sl_i + 1; i++) {
xt[i][1] = (xs[i][1] * 3.0 - xs[i][3] * aj2) * aj;
yt[i][1] = (ys[i][1] * 3.0 - ys[i][3] * aj2) * aj;
zt[i][1] = (zs[i][1] * 3.0 - zs[i][3] * aj2) * aj;
}
for (size_t j = 2; j < sl_j; j++) {
for (size_t i = 0; i < sl_i + 1; i++) {
size_t n1 = 2 * j + 1;
size_t n2 = j * (j - 1) / 2;
xt[i][j] = (xs[i][j] * n1 - xs[i][j + 2] * aj2) * aj - xs[i][j - 2] * n2;
yt[i][j] = (ys[i][j] * n1 - ys[i][j + 2] * aj2) * aj - ys[i][j - 2] * n2;
zt[i][j] = (zs[i][j] * n1 - zs[i][j + 2] * aj2) * aj - zs[i][j - 2] * n2;
}
}
}
for (size_t j = 0; j < sl_j; j++) {
dxs[0][j] = xs[1][j] * ai2;
dys[0][j] = ys[1][j] * ai2;
dzs[0][j] = zs[1][j] * ai2;
dxt[0][j] = xt[1][j] * ai2;
dyt[0][j] = yt[1][j] * ai2;
dzt[0][j] = zt[1][j] * ai2;
}
for (size_t i = 1; i < sl_i; i++) {
for (size_t j = 0; j < sl_j; j++) {
dxs[i][j] = xs[i + 1][j] * ai2 - xs[i - 1][j] * i;
dys[i][j] = ys[i + 1][j] * ai2 - ys[i - 1][j] * i;
dzs[i][j] = zs[i + 1][j] * ai2 - zs[i - 1][j] * i;
dxt[i][j] = xt[i + 1][j] * ai2 - xt[i - 1][j] * i;
dyt[i][j] = yt[i + 1][j] * ai2 - yt[i - 1][j] * i;
dzt[i][j] = zt[i + 1][j] * ai2 - zt[i - 1][j] * i;
}
}
for (size_t i = start_i, idx = 0; i < end_i; i++) {
size_t ix = shift_x[i];
size_t iy = shift_y[i];
size_t iz = shift_z[i];
for (size_t j = start_j; j < end_j; j++, idx++) {
size_t jx = shift_x[j];
size_t jy = shift_y[j];
size_t jz = shift_z[j];
double txs = dxs[ix][jx] * ys[iy][jy] * zs[iz][jz];
double tys = xs[ix][jx] * dys[iy][jy] * zs[iz][jz];
double tzs = xs[ix][jx] * ys[iy][jy] * dzs[iz][jz];
double txt = dxt[ix][jx] * ys[iy][jy] * zs[iz][jz] +
dxs[ix][jx] * yt[iy][jy] * zs[iz][jz] +
dxs[ix][jx] * ys[iy][jy] * zt[iz][jz];
double tyt = xt[ix][jx] * dys[iy][jy] * zs[iz][jz] +
xs[ix][jx] * dyt[iy][jy] * zs[iz][jz] +
xs[ix][jx] * dys[iy][jy] * zt[iz][jz];
double tzt = xt[ix][jx] * ys[iy][jy] * dzs[iz][jz] +
xs[ix][jx] * yt[iy][jy] * dzs[iz][jz] +
xs[ix][jx] * ys[iy][jy] * dzt[iz][jz];
size_t idx2 = (loc_i + i - start_i) * size_j + (loc_j + j - start_j);
ds[idx2].x += txs * dij[idx];
ds[idx2].y += tys * dij[idx];
ds[idx2].z += tzs * dij[idx];
ds[idx2].a += (tys * (at_i->z - com_i->z) - tzs * (at_i->y - com_i->y)) * dij[idx];
ds[idx2].b += (tzs * (at_i->x - com_i->x) - txs * (at_i->z - com_i->z)) * dij[idx];
ds[idx2].c += (txs * (at_i->y - com_i->y) - tys * (at_i->x - com_i->x)) * dij[idx];
dt[idx2].x += txt * dij[idx];
dt[idx2].y += tyt * dij[idx];
dt[idx2].z += tzt * dij[idx];
dt[idx2].a += (tyt * (at_i->z - com_i->z) - tzt * (at_i->y - com_i->y)) * dij[idx];
dt[idx2].b += (tzt * (at_i->x - com_i->x) - txt * (at_i->z - com_i->z)) * dij[idx];
dt[idx2].c += (txt * (at_i->y - com_i->y) - tyt * (at_i->x - com_i->x)) * dij[idx];
}
}
}
}
loc_j += count_j;
}}
loc_i += count_i;
}}
}
