static void ctr_rhf2e_kern(double *eri, double *ci0, double *ci1, double *tbuf,
int bcount, int stra_id, int strb_id,
int norb, int na, int nb, int nlinka, int nlinkb,
_LinkT *clink_indexa, _LinkT *clink_indexb)
{
const char TRANS_N = 'N';
const double D0 = 0;
const double D1 = 1;
const int nnorb = norb * (norb+1)/2;
double *t1 = malloc(sizeof(double) * nnorb*bcount);
double csum;
csum = prog0_b_t1(ci0, t1, bcount, stra_id, strb_id,
norb, nb, nlinkb, clink_indexb)
+ prog_a_t1(ci0, t1, bcount, stra_id, strb_id,
norb, nb, nlinka, clink_indexa);
if (csum > CSUMTHR) {
dgemm_(&TRANS_N, &TRANS_N, &nnorb, &bcount, &nnorb,
&D1, eri, &nnorb, t1, &nnorb,
&D0, tbuf, &nnorb);
spread_b_t1(ci1, tbuf, bcount, stra_id, strb_id,
norb, nb, nlinkb, clink_indexb);
} else {
memset(tbuf, 0, sizeof(double)*nnorb*bcount);
}
free(t1);
}
/***********************************************************************
*
* With symmetry
*
* Note the ordering in eri and the index in link_index
* eri is a tril matrix, it should be reordered wrt the irrep of the
* direct product E_i^j. The 2D array eri(ij,kl) is a diagonal block
* matrix. Each block is associated with an irrep.
* link_index[str_id,pair_id,0] which is the index of pair_id, should be
* reordered wrt the irreps accordingly
*
* dimirrep stores the number of occurence for each irrep
*
***********************************************************************/
static void ctr_rhf2esym_kern(double *eri, double *ci0, double *ci1, double *tbuf,
int bcount, int stra_id, int strb_id,
int norb, int na, int nb, int nlinka, int nlinkb,
_LinkT *clink_indexa, _LinkT *clink_indexb,
int *dimirrep, int totirrep)
{
const char TRANS_N = 'N';
const double D0 = 0;
const double D1 = 1;
const int nnorb = norb * (norb+1)/2;
int ir, p0;
double *t1 = malloc(sizeof(double) * nnorb*bcount);
double csum;
csum = prog0_b_t1(ci0, t1, bcount, stra_id, strb_id,
norb, nb, nlinkb, clink_indexb)
+ prog_a_t1(ci0, t1, bcount, stra_id, strb_id,
norb, nb, nlinka, clink_indexa);
if (csum > CSUMTHR) {
for (ir = 0, p0 = 0; ir < totirrep; ir++) {
dgemm_(&TRANS_N, &TRANS_N,
dimirrep+ir, &bcount, dimirrep+ir,
&D1, eri+p0*nnorb+p0, &nnorb, t1+p0, &nnorb,
&D0, tbuf+p0, &nnorb);
p0 += dimirrep[ir];
}
spread_b_t1(ci1, tbuf, bcount, stra_id, strb_id,
norb, nb, nlinkb, clink_indexb);
} else {
memset(tbuf, 0, sizeof(double)*nnorb*bcount);
}
free(t1);
}
static void ctr_rhf2e_kern(double *eri, double *ci0, double *ci1,
double *ci1buf, double *t1buf,
int bcount_for_spread_a, int ncol_ci1buf,
int bcount, int stra_id, int strb_id,
int norb, int na, int nb, int nlinka, int nlinkb,
_LinkT *clink_indexa, _LinkT *clink_indexb)
{
const char TRANS_N = 'N';
const double D0 = 0;
const double D1 = 1;
const int nnorb = norb * norb;
double *t1 = t1buf;
double *vt1 = t1buf + nnorb*bcount;
double csum;
csum = FCI_t1ci_sf(ci0, t1, bcount, stra_id, strb_id,
norb, na, nb, nlinka, nlinkb,
clink_indexa, clink_indexb);
if (csum > CSUMTHR) {
dgemm_(&TRANS_N, &TRANS_N, &nnorb, &bcount, &nnorb,
&D1, eri, &nnorb, t1, &nnorb,
&D0, vt1, &nnorb);
spread_b_t1(ci1, vt1, bcount, stra_id, strb_id,
norb, nb, nlinkb, clink_indexb);
spread_a_t1(ci1buf, vt1, bcount_for_spread_a, stra_id, 0,
norb, ncol_ci1buf, nlinka, clink_indexa);
}
}
