/*
* 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;
}
FINT CINT2c2e_loop_nopt(double *gctr, CINTEnvVars *envs)
{
const FINT *shls = envs->shls;
const FINT *bas = envs->bas;
const double *env = envs->env;
const FINT i_sh = shls[0];
const FINT k_sh = shls[1];
const FINT i_ctr = envs->i_ctr;
const FINT k_ctr = envs->k_ctr;
const double *ai = env + bas(PTR_EXP, i_sh);
const double *ak = env + bas(PTR_EXP, k_sh);
const double *ci = env + bas(PTR_COEFF, i_sh);
const double *ck = env + bas(PTR_COEFF, k_sh);
const FINT n_comp = envs->ncomp_tensor;
double fac1i, fac1k;
FINT ip, kp;
FINT empty[3] = {1, 1, 1};
FINT *iempty = empty + 0;
FINT *kempty = empty + 1;
FINT *gempty = empty + 2;
/* COMMON_ENVS_AND_DECLARE end */
const FINT nc = i_ctr * k_ctr;
const FINT leng = envs->g_size * 3 * ((1<<envs->gbits)+1);
const FINT lenk = envs->nf * nc * n_comp; // gctrk
const FINT leni = envs->nf * i_ctr * n_comp; // gctri
const FINT len0 = envs->nf * n_comp; // gout
const FINT len = leng + lenk + leni + len0;
double *const g = (double *)malloc(sizeof(double)*len);
double *g1 = g + leng;
double *gout, *gctri, *gctrk;
if (n_comp == 1) {
gctrk = gctr;
} else {
gctrk = g1;
g1 += lenk;
}
if (k_ctr == 1) {
gctri = gctrk;
iempty = kempty;
} else {
gctri = g1;
g1 += leni;
}
if (i_ctr == 1) {
gout = gctri;
gempty = iempty;
} else {
gout = g1;
}
envs->idx = (FINT *)malloc(sizeof(FINT) * envs->nf * 3);
CINTg1e_index_xyz(envs->idx, envs);
*kempty = 1;
for (kp = 0; kp < envs->k_prim; kp++) {
envs->ak = ak[kp];
envs->akl = ak[kp]; // to use CINTg0_2e
if (k_ctr == 1) {
fac1k = envs->common_factor * ck[kp];
} else {
fac1k = envs->common_factor;
*iempty = 1;
}
for (ip = 0; ip < envs->i_prim; ip++) {
envs->ai = ai[ip];
envs->aij = ai[ip];
if (i_ctr == 1) {
fac1i = fac1k*ci[ip];
} else {
fac1i = fac1k;
}
CINT2e_core(gout, g, fac1i, envs, *gempty);
PRIM2CTR0(i, gout, envs->nf*n_comp);
} // end loop i_prim
if (!*iempty) {
PRIM2CTR0(k, gctri, envs->nf*i_ctr*n_comp);
}
} // end loop k_prim
if (n_comp > 1 && !*kempty) {
CINTdmat_transpose(gctr, gctrk, envs->nf*nc, n_comp);
}
free(g);
free(envs->idx);
return !*kempty;
}
/*
* 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;
}