/*
* 1e integrals <i|O|j> with nuclear attraction
* TODO: add the gaussian nuclear model
*/
FINT CINT1e_nuc_drv(double *opij, CINTEnvVars *envs, double fac,
void (*const f_c2s)())
{
const FINT *shls = envs->shls;
const FINT *atm = envs->atm;
const FINT *bas = envs->bas;
const double *env = envs->env;
const FINT i_sh = shls[0];
const FINT j_sh = shls[1];
const FINT i_l = envs->i_l;
const FINT j_l = envs->j_l;
const FINT i_ctr = envs->i_ctr;
const FINT j_ctr = envs->j_ctr;
const FINT nfi = envs->nfi;
const FINT nfj = envs->nfj;
const FINT nc = nfi * nfj * i_ctr * j_ctr * envs->ncomp_e1;
FINT has_value = 0, has_value0;
FINT ip, jp, nop;
FINT n;
double *gctr = malloc(sizeof(double) * nc * envs->ncomp_tensor);
double *pgctr = gctr;
CINTdset0(nc * envs->ncomp_tensor, gctr);
for (n = 0; n < envs->natm; n++) {
has_value0 = CINT1e_nuc_loop(gctr, envs,
-fabs(atm(CHARGE_OF,n))*fac, n);
has_value = has_value || has_value0;
}
if (f_c2s == c2s_sph_1e) {
ip = CINTcgto_spheric(i_sh, bas);
jp = CINTcgto_spheric(j_sh, bas);
nop = ip * jp;
} else if (f_c2s == c2s_cart_1e) {
ip = CINTcgto_cart(i_sh, bas);
jp = CINTcgto_cart(j_sh, bas);
nop = ip * jp;
} else {
ip = CINTcgto_spinor(i_sh, bas);
jp = CINTcgto_spinor(j_sh, bas);
nop = ip * jp * OF_CMPLX;
}
if (!has_value) {
CINTdset0(nop * envs->ncomp_tensor, opij);
} else {
for (n = 0; n < envs->ncomp_tensor; n++) {
(*f_c2s)(opij, pgctr, shls, bas);
opij += nop;
pgctr += nc;
}
}
free(gctr);
return has_value;
}
FINT CINT2c2e_spheric_drv(double *opij, CINTEnvVars *envs, const CINTOpt *opt)
{
const FINT ip = CINTcgto_spheric(envs->shls[0], envs->bas);
const FINT kp = CINTcgto_spheric(envs->shls[1], envs->bas);
const FINT nop = ip * kp;
const FINT nc = envs->nf * envs->i_ctr * envs->k_ctr;
double *const gctr = malloc(sizeof(double) * nc * envs->ncomp_tensor);
double *pgctr = gctr;
FINT n;
FINT has_value;
if (opt != NULL) {
n = ((envs->i_ctr==1) << 1) + (envs->k_ctr==1);
has_value = CINTf_2c2e_loop[n](gctr, envs, opt);
} else {
has_value = CINT2c2e_loop_nopt(gctr, envs);
}
if (has_value) {
for (n = 0; n < envs->ncomp_tensor; n++) {
c2s_sph_1e(opij, pgctr, envs);
opij += nop;
pgctr += nc;
}
} else {
CINTdset0(nop * envs->ncomp_tensor, opij);
}
free(gctr);
return has_value;
}
/* <NABLA k NABLA i|R12 |j l> : i,j \in electron 1; k,l \in electron 2
* = (NABLA i j|R12 |NABLA k l) */
static void CINTgout2e_cint2e_ip1ip2_sph(double *g,
double *gout, const FINT *idx, const CINTEnvVars *envs, FINT gout_empty) {
const double *env = envs->env;
const FINT nf = envs->nf;
const FINT i_l = envs->i_l;
const FINT j_l = envs->j_l;
const FINT k_l = envs->k_l;
const FINT l_l = envs->l_l;
const double *ri = envs->ri;
const double *rj = envs->rj;
const double *rk = envs->rk;
const double *rl = envs->rl;
FINT ix, iy, iz, i, n;
double *g0 = g;
double *g1 = g0 + envs->g_size * 3;
double *g2 = g1 + envs->g_size * 3;
double *g3 = g2 + envs->g_size * 3;
double *g4 = g3 + envs->g_size * 3;
double s[9];
G2E_D_K(g1, g0, i_l+1, j_l+0, k_l+0, l_l);
G2E_D_I(g2, g0, i_l+0, j_l, k_l, l_l);
G2E_D_I(g3, g1, i_l+0, j_l, k_l, l_l);
for (n = 0; n < nf; n++, idx+=3) {
ix = idx[0];
iy = idx[1];
iz = idx[2];
CINTdset0(9, s);
for (i = 0; i < envs->nrys_roots; i++) {
s[0] += g3[ix+i] * g0[iy+i] * g0[iz+i];
s[1] += g2[ix+i] * g1[iy+i] * g0[iz+i];
s[2] += g2[ix+i] * g0[iy+i] * g1[iz+i];
s[3] += g1[ix+i] * g2[iy+i] * g0[iz+i];
s[4] += g0[ix+i] * g3[iy+i] * g0[iz+i];
s[5] += g0[ix+i] * g2[iy+i] * g1[iz+i];
s[6] += g1[ix+i] * g0[iy+i] * g2[iz+i];
s[7] += g0[ix+i] * g1[iy+i] * g2[iz+i];
s[8] += g0[ix+i] * g0[iy+i] * g3[iz+i];
}
if (gout_empty) {
gout[0] = + s[0];
gout[1] = + s[1];
gout[2] = + s[2];
gout[3] = + s[3];
gout[4] = + s[4];
gout[5] = + s[5];
gout[6] = + s[6];
gout[7] = + s[7];
gout[8] = + s[8];
gout += 9;
} else {
gout[0] += + s[0];
gout[1] += + s[1];
gout[2] += + s[2];
gout[3] += + s[3];
gout[4] += + s[4];
gout[5] += + s[5];
gout[6] += + s[6];
gout[7] += + s[7];
gout[8] += + s[8];
gout += 9;
}}}
/* <k NABLA i|R12 |j l> : i,j \in electron 1; k,l \in electron 2
* = (NABLA i j|R12 |k l) */
static void CINTgout2e_cint2e_ip1_sph(double *g,
double *gout, const FINT *idx, const CINTEnvVars *envs, FINT gout_empty) {
const double *env = envs->env;
const FINT nf = envs->nf;
const FINT i_l = envs->i_l;
const FINT j_l = envs->j_l;
const FINT k_l = envs->k_l;
const FINT l_l = envs->l_l;
const double *ri = envs->ri;
const double *rj = envs->rj;
const double *rk = envs->rk;
const double *rl = envs->rl;
FINT ix, iy, iz, i, n;
double *g0 = g;
double *g1 = g0 + envs->g_size * 3;
double *g2 = g1 + envs->g_size * 3;
double s[3];
G2E_D_I(g1, g0, i_l+0, j_l, k_l, l_l);
for (n = 0; n < nf; n++, idx+=3) {
ix = idx[0];
iy = idx[1];
iz = idx[2];
switch (envs->nrys_roots) {
case 1:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0];
break;
case 2:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1];
break;
case 3:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2];
break;
case 4:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2]+ g1[ix+3]*g0[iy+3]*g0[iz+3];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2]+ g0[ix+3]*g1[iy+3]*g0[iz+3];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2]+ g0[ix+3]*g0[iy+3]*g1[iz+3];
break;
case 5:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2]+ g1[ix+3]*g0[iy+3]*g0[iz+3]+ g1[ix+4]*g0[iy+4]*g0[iz+4];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2]+ g0[ix+3]*g1[iy+3]*g0[iz+3]+ g0[ix+4]*g1[iy+4]*g0[iz+4];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2]+ g0[ix+3]*g0[iy+3]*g1[iz+3]+ g0[ix+4]*g0[iy+4]*g1[iz+4];
break;
case 6:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2]+ g1[ix+3]*g0[iy+3]*g0[iz+3]+ g1[ix+4]*g0[iy+4]*g0[iz+4]+ g1[ix+5]*g0[iy+5]*g0[iz+5];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2]+ g0[ix+3]*g1[iy+3]*g0[iz+3]+ g0[ix+4]*g1[iy+4]*g0[iz+4]+ g0[ix+5]*g1[iy+5]*g0[iz+5];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2]+ g0[ix+3]*g0[iy+3]*g1[iz+3]+ g0[ix+4]*g0[iy+4]*g1[iz+4]+ g0[ix+5]*g0[iy+5]*g1[iz+5];
break;
case 7:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2]+ g1[ix+3]*g0[iy+3]*g0[iz+3]+ g1[ix+4]*g0[iy+4]*g0[iz+4]+ g1[ix+5]*g0[iy+5]*g0[iz+5]+ g1[ix+6]*g0[iy+6]*g0[iz+6];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2]+ g0[ix+3]*g1[iy+3]*g0[iz+3]+ g0[ix+4]*g1[iy+4]*g0[iz+4]+ g0[ix+5]*g1[iy+5]*g0[iz+5]+ g0[ix+6]*g1[iy+6]*g0[iz+6];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2]+ g0[ix+3]*g0[iy+3]*g1[iz+3]+ g0[ix+4]*g0[iy+4]*g1[iz+4]+ g0[ix+5]*g0[iy+5]*g1[iz+5]+ g0[ix+6]*g0[iy+6]*g1[iz+6];
break;
case 8:
s[0] = + g1[ix+0]*g0[iy+0]*g0[iz+0]+ g1[ix+1]*g0[iy+1]*g0[iz+1]+ g1[ix+2]*g0[iy+2]*g0[iz+2]+ g1[ix+3]*g0[iy+3]*g0[iz+3]+ g1[ix+4]*g0[iy+4]*g0[iz+4]+ g1[ix+5]*g0[iy+5]*g0[iz+5]+ g1[ix+6]*g0[iy+6]*g0[iz+6]+ g1[ix+7]*g0[iy+7]*g0[iz+7];
s[1] = + g0[ix+0]*g1[iy+0]*g0[iz+0]+ g0[ix+1]*g1[iy+1]*g0[iz+1]+ g0[ix+2]*g1[iy+2]*g0[iz+2]+ g0[ix+3]*g1[iy+3]*g0[iz+3]+ g0[ix+4]*g1[iy+4]*g0[iz+4]+ g0[ix+5]*g1[iy+5]*g0[iz+5]+ g0[ix+6]*g1[iy+6]*g0[iz+6]+ g0[ix+7]*g1[iy+7]*g0[iz+7];
s[2] = + g0[ix+0]*g0[iy+0]*g1[iz+0]+ g0[ix+1]*g0[iy+1]*g1[iz+1]+ g0[ix+2]*g0[iy+2]*g1[iz+2]+ g0[ix+3]*g0[iy+3]*g1[iz+3]+ g0[ix+4]*g0[iy+4]*g1[iz+4]+ g0[ix+5]*g0[iy+5]*g1[iz+5]+ g0[ix+6]*g0[iy+6]*g1[iz+6]+ g0[ix+7]*g0[iy+7]*g1[iz+7];
break;
default:
CINTdset0(3, s);
for (i = 0; i < envs->nrys_roots; i++) {
s[0] += g1[ix+i] * g0[iy+i] * g0[iz+i];
s[1] += g0[ix+i] * g1[iy+i] * g0[iz+i];
s[2] += g0[ix+i] * g0[iy+i] * g1[iz+i];
} break;}
if (gout_empty) {
gout[0] = + s[0];
gout[1] = + s[1];
gout[2] = + s[2];
gout += 3;
} else {
gout[0] += + s[0];
gout[1] += + s[1];
gout[2] += + s[2];
gout += 3;
}}}
/*
* 1e GTO integral basic loop for < i|j>, no 1/r
*/
FINT CINT1e_loop(double *gctr, CINTEnvVars *envs, double fac)
{
const FINT *shls = envs->shls;
const FINT *atm = envs->atm;
const FINT *bas = envs->bas;
const double *env = envs->env;
const FINT i_sh = shls[0];
const FINT j_sh = shls[1];
const FINT i_l = envs->i_l;
const FINT j_l = envs->j_l;
const FINT i_ctr = envs->i_ctr;
const FINT j_ctr = envs->j_ctr;
const FINT nfi = envs->nfi;
const FINT nfj = envs->nfj;
const FINT n_comp = envs->ncomp_e1 * envs->ncomp_tensor;
const FINT nf = envs->nf;
const double *ri = envs->ri;
const double *rj = envs->rj;
const double *ai = env + bas(PTR_EXP, i_sh);
const double *aj = env + bas(PTR_EXP, j_sh);
const double *ci = env + bas(PTR_COEFF, i_sh);
const double *cj = env + bas(PTR_COEFF, j_sh);
FINT ip, jp, n;
FINT has_value = 0;
FINT *const idx = malloc(sizeof(FINT) * nf * 3);
double aij, dij, eij, rrij;
double *g = malloc(sizeof(double) * envs->g_size * 3
* ((1<<envs->gbits)+1)); // +1 as buffer
double *gout = malloc(sizeof(double) * nf * n_comp);
double *gctri = malloc(sizeof(double) * nf * i_ctr * n_comp);
CINTg1e_index_xyz(idx, envs);
rrij = CINTsquare_dist(ri, rj);
fac *= SQRTPI * M_PI * CINTcommon_fac_sp(i_l) * CINTcommon_fac_sp(j_l);
for (jp = 0; jp < envs->j_prim; jp++) {
envs->aj = aj[jp];
n = nf * i_ctr * n_comp;
CINTdset0(n, gctri);
for (ip = 0; ip < envs->i_prim; ip++) {
envs->ai = ai[ip];
aij = ai[ip] + aj[jp];
eij = (ai[ip] * aj[jp] / aij) * rrij;
if (eij > EXPCUTOFF)
continue;
has_value = 1;
dij = exp(-eij) / (aij * sqrt(aij)) * fac;
CINTg_ovlp(g, ai[ip], aj[jp], dij, envs);
CINTdset0(nf * n_comp, gout);
(*envs->f_gout)(g, gout, idx, envs);
n = nf * n_comp;
CINTprim_to_ctr(gctri, n, gout, 1, envs->i_prim,
i_ctr, ci+ip);
}
n = nf * i_ctr;
CINTprim_to_ctr(gctr, n, gctri, n_comp, envs->j_prim,
j_ctr, cj+jp);
}
free(g);
free(idx);
free(gout);
free(gctri);
return has_value;
}
/*
* 1e GTO integral basic loop for < i|1/r|j>, no 1/r
* if nuc_id >= 0: nuclear attraction, use nuclear model
* if nuc_id < 0: 1/r potential, do not use nuclear model
*/
FINT CINT1e_nuc_loop(double *gctr, CINTEnvVars *envs, double fac, FINT nuc_id)
{
const FINT *shls = envs->shls;
const FINT *atm = envs->atm;
const FINT *bas = envs->bas;
const double *env = envs->env;
const FINT i_sh = shls[0];
const FINT j_sh = shls[1];
const FINT i_l = envs->i_l;
const FINT j_l = envs->j_l;
const FINT i_ctr = envs->i_ctr;
const FINT j_ctr = envs->j_ctr;
const FINT nfi = envs->nfi;
const FINT nfj = envs->nfj;
const FINT nf = envs->nf;
const FINT n_comp = envs->ncomp_e1 * envs->ncomp_tensor;
const double *ri = envs->ri;
const double *rj = envs->rj;
const double *ai = env + bas(PTR_EXP, i_sh);
const double *aj = env + bas(PTR_EXP, j_sh);
const double *ci = env + bas(PTR_COEFF, i_sh);
const double *cj = env + bas(PTR_COEFF, j_sh);
FINT ip, jp, i, n;
FINT has_value = 0;
double tau;
const double *cr;
double (*f_nuc_mod)();
double x, u[MXRYSROOTS], w[MXRYSROOTS];
FINT *const idx = malloc(sizeof(FINT) * nf * 3);
double rij[3], aij, dij, eij, rrij, t2;
double *g = malloc(sizeof(double) * envs->g_size * 3
* ((1<<envs->gbits)+1)); // +1 as buffer
double *const gout = malloc(sizeof(double) * nf * n_comp);
double *const gctri = malloc(sizeof(double) * nf * i_ctr * n_comp);
if (nuc_id < 0) {
cr = &env[PTR_RINV_ORIG];
f_nuc_mod = CINTno_nuc_mod;
} else {
cr = &env[atm(PTR_COORD, nuc_id)],
f_nuc_mod = CINTnuc_mod;
}
CINTg1e_index_xyz(idx, envs);
rrij = CINTsquare_dist(ri, rj);
fac *= 2 * M_PI * CINTcommon_fac_sp(i_l) * CINTcommon_fac_sp(j_l);
for (jp = 0; jp < envs->j_prim; jp++) {
envs->aj = aj[jp];
n = nf * i_ctr * n_comp;
CINTdset0(n, gctri);
for (ip = 0; ip < envs->i_prim; ip++) {
envs->ai = ai[ip];
aij = ai[ip] + aj[jp];
eij = (ai[ip] * aj[jp] / aij) * rrij;
if (eij > EXPCUTOFF)
continue;
has_value = 1;
rij[0] = (ai[ip] * ri[0] + aj[jp] * rj[0]) / aij;
rij[1] = (ai[ip] * ri[1] + aj[jp] * rj[1]) / aij;
rij[2] = (ai[ip] * ri[2] + aj[jp] * rj[2]) / aij;
tau = (*f_nuc_mod)(aij, nuc_id, atm, env);
x = aij * CINTsquare_dist(rij, cr) * tau * tau;
CINTrys_roots(envs->nrys_roots, x, u, w);
dij = exp(-eij) / aij * fac;
CINTdset0(nf * n_comp, gout);
for (i = 0; i < envs->nrys_roots; i++) {
t2 = u[i] / (1 + u[i]) * tau * tau;
CINTg_nuc(g, aij, rij, cr, t2,
dij * w[i] * tau, envs);
(*envs->f_gout)(g, gout, idx, envs);
}
n = nf * n_comp;
CINTprim_to_ctr(gctri, n, gout, 1, envs->i_prim,
i_ctr, ci+ip);
}
n = nf * i_ctr;
CINTprim_to_ctr(gctr, n, gctri, n_comp, envs->j_prim,
j_ctr, cj+jp);
}
free(g);
free(idx);
free(gout);
free(gctri);
return has_value;
}
