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;
}
/*
* 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;
}
/*
* The size of eri is ncomp*nkl*nao*nao, note the upper triangular part
* may not be filled
*/
void AO2MOnr_e1fill_drv(int (*intor)(), void (*fill)(), double *eri,
int klsh_start, int klsh_count, int nkl,
int ncomp, CINTOpt *cintopt, CVHFOpt *vhfopt,
int *atm, int natm, int *bas, int nbas, double *env)
{
int *ao_loc = malloc(sizeof(int)*(nbas+1));
CINTshells_spheric_offset(ao_loc, bas, nbas);
ao_loc[nbas] = ao_loc[nbas-1] + CINTcgto_spheric(nbas-1, bas);
int nao = ao_loc[nbas];
struct _AO2MOEnvs envs = {natm, nbas, atm, bas, env, nao,
klsh_start, klsh_count, 0, 0, 0, 0,
ncomp, ao_loc, NULL, cintopt, vhfopt};
int ish;
int (*fprescreen)();
if (vhfopt) {
fprescreen = vhfopt->fprescreen;
} else {
fprescreen = CVHFnoscreen;
}
#pragma omp parallel default(none) \
shared(fill, fprescreen, eri, envs, intor, nkl, nbas) \
private(ish)
#pragma omp for nowait schedule(dynamic)
for (ish = 0; ish < nbas; ish++) {
(*fill)(intor, fprescreen, eri, nkl, ish, &envs);
}
free(ao_loc);
}
void RInr_fill2c2e_sph(double *eri, int auxstart, int auxcount,
int *atm, int natm, int *bas, int nbas, double *env)
{
const int nbasnaux = auxstart + auxcount;
int *ao_loc = malloc(sizeof(int)*(nbasnaux+1));
CINTshells_spheric_offset(ao_loc, bas, nbasnaux);
ao_loc[nbasnaux] = ao_loc[nbasnaux-1] + CINTcgto_spheric(nbasnaux-1, bas);
const int naoaux = ao_loc[nbasnaux] - ao_loc[auxstart];
double *buf;
int ish, jsh, di, dj;
int i, j, i0, j0;
int shls[2];
CINTOpt *cintopt = NULL;
cint2c2e_sph_optimizer(&cintopt, atm, natm, bas, nbas, env);
#pragma omp parallel default(none) \
shared(eri, auxstart, auxcount, atm, natm, bas, nbas, env, \
ao_loc, cintopt) \
private(ish, jsh, di, dj, i, j, i0, j0, shls, buf)
#pragma omp for nowait schedule(dynamic)
for (ish = auxstart; ish < nbasnaux; ish++) {
for (jsh = auxstart; jsh <= ish; jsh++) {
di = ao_loc[ish+1] - ao_loc[ish];
dj = ao_loc[jsh+1] - ao_loc[jsh];
shls[0] = ish;
shls[1] = jsh;
buf = (double *)malloc(sizeof(double) * di * dj);
if (cint2c2e_sph(buf, shls, atm, natm, bas, nbas, env,
cintopt)) {
for (i0 = ao_loc[ish]-ao_loc[auxstart], i = 0; i < di; i++, i0++) {
for (j0 = ao_loc[jsh]-ao_loc[auxstart], j = 0; j < dj; j++, j0++) {
eri[i0*naoaux+j0] = buf[j*di+i];
} }
} else {
for (i0 = ao_loc[ish]-ao_loc[auxstart];
i0 < ao_loc[ish+1]-ao_loc[auxstart]; i0++) {
for (j0 = ao_loc[jsh]-ao_loc[auxstart];
j0 < ao_loc[jsh+1]-ao_loc[auxstart]; j0++) {
eri[i0*naoaux+j0] = 0;
} }
}
free(buf);
} }
for (i = 0; i < naoaux; i++) {
for (j = 0; j < i; j++) {
eri[j*naoaux+i] = eri[i*naoaux+j];
}
}
free(ao_loc);
CINTdel_optimizer(&cintopt);
}
/*
* ************************************************
* Denoting 2e integrals (ij|kl),
* transform ij for ksh_start <= k shell < ksh_end.
* The transformation C_pi C_qj (pq|k*) coefficients are stored in
* mo_coeff, C_pi and C_qj are offset by i_start and i_count, j_start and j_count
*
* The output eri is an 2D array, ordered as (kl-AO-pair,ij-MO-pair) in
* C-order. Transposing is needed before calling AO2MOnr_e2_drv.
* eri[ncomp,nkl,mo_i,mo_j]
*/
void AO2MOnr_e1_drv(int (*intor)(), void (*fill)(),
void (*ftrans)(), int (*fmmm)(),
double *eri, double *mo_coeff,
int klsh_start, int klsh_count, int nkl,
int i_start, int i_count, int j_start, int j_count,
int ncomp, CINTOpt *cintopt, CVHFOpt *vhfopt,
int *atm, int natm, int *bas, int nbas, double *env)
{
int *ao_loc = malloc(sizeof(int)*(nbas+1));
CINTshells_spheric_offset(ao_loc, bas, nbas);
ao_loc[nbas] = ao_loc[nbas-1] + CINTcgto_spheric(nbas-1, bas);
int nao = ao_loc[nbas];
double *eri_ao = malloc(sizeof(double) * nao*nao*nkl*ncomp);
AO2MOnr_e1fill_drv(intor, fill, eri_ao, klsh_start, klsh_count,
nkl, ncomp, cintopt, vhfopt,
atm, natm, bas, nbas, env);
AO2MOnr_e2_drv(ftrans, fmmm, eri, eri_ao, mo_coeff,
nkl*ncomp, nao, i_start, i_count, j_start, j_count,
ao_loc, nbas);
free(eri_ao);
free(ao_loc);
}
void run_all(int *atm, int natm, int *bas, int nbas, double *env)
{
int i, j, k, l, ij, kl;
int di, dj, dk, dl;
int kl_max;
int shls[4];
double *buf;
int *ishls = malloc(sizeof(int)*nbas*nbas);
int *jshls = malloc(sizeof(int)*nbas*nbas);
for (i = 0, ij = 0; i < nbas; i++) {
for (j = 0; j <= i; j++, ij++) {
ishls[ij] = i;
jshls[ij] = j;
}
}
int ncgto = CINTtot_cgto_spheric(bas, nbas);
printf("\tshells = %d, total cGTO = %d, total pGTO = %d\n",
nbas, ncgto,
CINTtot_pgto_spheric(bas, nbas));
int pct;
long count;
double time0, time1 = 0;
double tt, tot;
tot = (double)ncgto*ncgto*ncgto*ncgto/8;
time0 = omp_get_wtime();
printf("\tcint2e_sph with optimizer: total num ERI = %.2e\n", tot);
CINTOpt *opt = NULL;
cint2e_sph_optimizer(&opt, atm, natm, bas, nbas, env);
pct = 0; count = 0;
#pragma omp parallel default(none) \
shared(atm, natm, bas, nbas, env, ishls, jshls, opt, time0, pct, count, stdout) \
private(di, dj, dk, dl, i, j, k, l, ij, kl, kl_max, shls, buf, time1)
#pragma omp for nowait schedule(dynamic, 2)
for (ij = 0; ij < nbas*(nbas+1)/2; ij++) {
i = ishls[ij];
j = jshls[ij];
di = CINTcgto_spheric(i, bas);
dj = CINTcgto_spheric(j, bas);
// when ksh==ish, there exists k<i, so it's possible kl>ij
kl_max = (i+1)*(i+2)/2;
for (kl = 0; kl < kl_max; kl++) {
k = ishls[kl];
l = jshls[kl];
dk = CINTcgto_spheric(k, bas);
dl = CINTcgto_spheric(l, bas);
shls[0] = i;
shls[1] = j;
shls[2] = k;
shls[3] = l;
buf = malloc(sizeof(double) * di*dj*dk*dl);
cint2e_sph(buf, shls, atm, natm, bas, nbas, env, opt);
free(buf);
}
count += kl_max;
if (100l*count/((long)nbas*nbas*(nbas+1)*(nbas+2)/8) > pct) {
pct++;
time1 = omp_get_wtime();
printf("\t%d%%, CPU time = %8.2f\r", pct, time1-time0);
fflush(stdout);
}
}
time1 = omp_get_wtime();
tt = time1-time0;
printf("\t100%%, CPU time = %8.2f, %8.4f Mflops\n", tt, tot/1e6/tt);
CINTdel_optimizer(&opt);
free(ishls);
free(jshls);
}
FINT cintcgto_spheric_(const FINT *bas_id, const FINT *bas)
{
return CINTcgto_spheric(*bas_id, bas);
}