diff --git a/psi4/src/psi4/cclambda/BL2_AO.cc b/psi4/src/psi4/cclambda/BL2_AO.cc index 1a351bbec51..d55b71aaaaf 100644 --- a/psi4/src/psi4/cclambda/BL2_AO.cc +++ b/psi4/src/psi4/cclambda/BL2_AO.cc @@ -47,556 +47,530 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void halftrans(dpdbuf4 *Buf1, int dpdnum1, dpdbuf4 *Buf2, int dpdnum2, double ***C, int nirreps, - int **mo_row, int **so_row, int *mospi, int *sospi, int type, double alpha, double beta); - -void AO_contribute(int p, int q, int r, int s, double value, - dpdbuf4 *tau1_AO, dpdbuf4 *tau2_AO, int anti); - -void BL2_AO(int L_irr) -{ - int h, nirreps, i, Gc, Gd, Ga, Gb, ij; - double ***C, **X; - int *orbspi, *virtpi; - int **T2_cd_row_start, **T2_pq_row_start, offset, cd, pq; - dpdbuf4 tau, t2, tau1_AO, tau2_AO; - psio_address next; - struct iwlbuf InBuf; - int idx, p, q, r, s, filenum; - int lastbuf; - double value, tolerance=1e-14; - Value *valptr; - Label *lblptr; - - nirreps = moinfo.nirreps; - orbspi = moinfo.orbspi; - virtpi = moinfo.virtpi; - C = moinfo.C; - - T2_cd_row_start = init_int_matrix(nirreps,nirreps); - for(h=0; h < nirreps; h++) { - for(Gc=0,offset=0; Gc < nirreps; Gc++) { - Gd = Gc ^ h; - T2_cd_row_start[h][Gc] = offset; - offset += virtpi[Gc] * virtpi[Gd]; +namespace psi { +namespace cclambda { + +void halftrans(dpdbuf4 *Buf1, int dpdnum1, dpdbuf4 *Buf2, int dpdnum2, double ***C, int nirreps, int **mo_row, + int **so_row, int *mospi, int *sospi, int type, double alpha, double beta); + +void AO_contribute(int p, int q, int r, int s, double value, dpdbuf4 *tau1_AO, dpdbuf4 *tau2_AO, int anti); + +void BL2_AO(int L_irr) { + int h, nirreps, i, Gc, Gd, Ga, Gb, ij; + double ***C, **X; + int *orbspi, *virtpi; + int **T2_cd_row_start, **T2_pq_row_start, offset, cd, pq; + dpdbuf4 tau, t2, tau1_AO, tau2_AO; + psio_address next; + struct iwlbuf InBuf; + int idx, p, q, r, s, filenum; + int lastbuf; + double value, tolerance = 1e-14; + Value *valptr; + Label *lblptr; + + nirreps = moinfo.nirreps; + orbspi = moinfo.orbspi; + virtpi = moinfo.virtpi; + C = moinfo.C; + + T2_cd_row_start = init_int_matrix(nirreps, nirreps); + for (h = 0; h < nirreps; h++) { + for (Gc = 0, offset = 0; Gc < nirreps; Gc++) { + Gd = Gc ^ h; + T2_cd_row_start[h][Gc] = offset; + offset += virtpi[Gc] * virtpi[Gd]; + } } - } - - T2_pq_row_start = init_int_matrix(nirreps,nirreps); - for(h=0; h < nirreps; h++) { - for(Gc=0,offset=0; Gc < nirreps; Gc++) { - Gd = Gc ^ h; - T2_pq_row_start[h][Gc] = offset; - offset += orbspi[Gc] * orbspi[Gd]; - } - } - - /************************************* AA *****************************************/ - - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (1)"); - global_dpd_->buf4_scm(&tau1_AO, 0.0); - - dpd_set_default(0); - global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 0, 1.0, 0.0); - - global_dpd_->buf4_close(&tau); - global_dpd_->buf4_close(&tau1_AO); + T2_pq_row_start = init_int_matrix(nirreps, nirreps); + for (h = 0; h < nirreps; h++) { + for (Gc = 0, offset = 0; Gc < nirreps; Gc++) { + Gd = Gc ^ h; + T2_pq_row_start[h][Gc] = offset; + offset += orbspi[Gc] * orbspi[Gd]; + } + } - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (1)"); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (2)"); - global_dpd_->buf4_scm(&tau2_AO, 0.0); + /************************************* AA *****************************************/ - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); - } + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (1)"); + global_dpd_->buf4_scm(&tau1_AO, 0.0); - iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); + dpd_set_default(0); + global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - lblptr = InBuf.labels; - valptr = InBuf.values; - lastbuf = InBuf.lastbuf; + halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 0, 1.0, 0.0); - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; + global_dpd_->buf4_close(&tau); + global_dpd_->buf4_close(&tau1_AO); - value = (double) valptr[InBuf.idx]; + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (1)"); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (2)"); + global_dpd_->buf4_scm(&tau2_AO, 0.0); - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); + } - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); - } - while(!lastbuf) { - iwl_buf_fetch(&InBuf); + lblptr = InBuf.labels; + valptr = InBuf.values; lastbuf = InBuf.lastbuf; - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; - value = (double) valptr[InBuf.idx]; + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + value = (double)valptr[InBuf.idx]; - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); } - } + while (!lastbuf) { + iwl_buf_fetch(&InBuf); + lastbuf = InBuf.lastbuf; + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - iwl_buf_close(&InBuf, 1); + value = (double)valptr[InBuf.idx]; - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); - } - global_dpd_->buf4_close(&tau1_AO); - global_dpd_->buf4_close(&tau2_AO); + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + } + } - dpd_set_default(1); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (2)"); - - dpd_set_default(0); - global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); - - halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 1, 0.5, 1.0); - - global_dpd_->buf4_close(&t2); - global_dpd_->buf4_close(&tau2_AO); + iwl_buf_close(&InBuf, 1); - /************************************* BB *****************************************/ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); + } + global_dpd_->buf4_close(&tau1_AO); + global_dpd_->buf4_close(&tau2_AO); - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (1)"); - global_dpd_->buf4_scm(&tau1_AO, 0.0); + dpd_set_default(1); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIJPQ (2)"); - dpd_set_default(0); - global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "Lijab"); + dpd_set_default(0); + global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); - halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 0, 1.0, 0.0); + halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 1, 0.5, 1.0); - global_dpd_->buf4_close(&tau); - global_dpd_->buf4_close(&tau1_AO); + global_dpd_->buf4_close(&t2); + global_dpd_->buf4_close(&tau2_AO); - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (1)"); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (2)"); - global_dpd_->buf4_scm(&tau2_AO, 0.0); + /************************************* BB *****************************************/ - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); - } + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (1)"); + global_dpd_->buf4_scm(&tau1_AO, 0.0); - iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); + dpd_set_default(0); + global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "Lijab"); - lblptr = InBuf.labels; - valptr = InBuf.values; - lastbuf = InBuf.lastbuf; + halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 0, 1.0, 0.0); - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; + global_dpd_->buf4_close(&tau); + global_dpd_->buf4_close(&tau1_AO); - value = (double) valptr[InBuf.idx]; + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (1)"); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (2)"); + global_dpd_->buf4_scm(&tau2_AO, 0.0); - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); + } - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); - } - while(!lastbuf) { - iwl_buf_fetch(&InBuf); + lblptr = InBuf.labels; + valptr = InBuf.values; lastbuf = InBuf.lastbuf; - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; - value = (double) valptr[InBuf.idx]; + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + value = (double)valptr[InBuf.idx]; - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); } - } - - iwl_buf_close(&InBuf, 1); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); - } - global_dpd_->buf4_close(&tau1_AO); - global_dpd_->buf4_close(&tau2_AO); - - - dpd_set_default(1); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (2)"); - - dpd_set_default(0); - global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New Lijab"); - - halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 1, 0.5, 1.0); - - global_dpd_->buf4_close(&t2); - global_dpd_->buf4_close(&tau2_AO); - - /************************************* AB *****************************************/ - - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (1)"); - global_dpd_->buf4_scm(&tau1_AO, 0.0); - - dpd_set_default(0); - global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - - halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 0, 1.0, 0.0); - - global_dpd_->buf4_close(&tau); - global_dpd_->buf4_close(&tau1_AO); - - dpd_set_default(1); - global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (1)"); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (2)"); - global_dpd_->buf4_scm(&tau2_AO, 0.0); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); - global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); - } - - iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); + while (!lastbuf) { + iwl_buf_fetch(&InBuf); + lastbuf = InBuf.lastbuf; + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - lblptr = InBuf.labels; - valptr = InBuf.values; - lastbuf = InBuf.lastbuf; + value = (double)valptr[InBuf.idx]; - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; - - value = (double) valptr[InBuf.idx]; - - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ - - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 0); - - } - while(!lastbuf) { - iwl_buf_fetch(&InBuf); - lastbuf = InBuf.lastbuf; - for(idx=4*InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { - p = std::abs((int) lblptr[idx++]); - q = (int) lblptr[idx++]; - r = (int) lblptr[idx++]; - s = (int) lblptr[idx++]; - - value = (double) valptr[InBuf.idx]; - - /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ - - AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 0); + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 1); + } } - } - - iwl_buf_close(&InBuf, 1); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); - global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); - } - global_dpd_->buf4_close(&tau1_AO); - global_dpd_->buf4_close(&tau2_AO); + iwl_buf_close(&InBuf, 1); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); + } + global_dpd_->buf4_close(&tau1_AO); + global_dpd_->buf4_close(&tau2_AO); - dpd_set_default(1); - global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (2)"); + dpd_set_default(1); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "Lijpq (2)"); - dpd_set_default(0); - global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + dpd_set_default(0); + global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New Lijab"); - halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, - virtpi, orbspi, 1, 1.0, 1.0); + halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 1, 0.5, 1.0); - global_dpd_->buf4_close(&t2); - global_dpd_->buf4_close(&tau2_AO); + global_dpd_->buf4_close(&t2); + global_dpd_->buf4_close(&tau2_AO); - free(T2_cd_row_start); - free(T2_pq_row_start); + /************************************* AB *****************************************/ - /* Reset the default dpd back to 0 --- this stuff gets really ugly */ - dpd_set_default(0); -} + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (1)"); + global_dpd_->buf4_scm(&tau1_AO, 0.0); -void AO_contribute(int p, int q, int r, int s, double value, dpdbuf4 - *tau1_AO, dpdbuf4 *tau2_AO, int anti) -{ - int Gp, Gq, Gr, Gs, Gpr, Gps, Gqr, Gqs, Grp, Gsp, Grq, Gsq; - int pr, ps, qr, qs, rp, rq, sp, sq, pq, rs; - int row; + dpd_set_default(0); + global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - Gp = tau1_AO->params->rsym[p]; - Gq = tau1_AO->params->rsym[q]; - Gr = tau1_AO->params->rsym[r]; - Gs = tau1_AO->params->rsym[s]; + halftrans(&tau, 0, &tau1_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 0, 1.0, 0.0); - pq = tau1_AO->params->colidx[p][q]; rs = tau1_AO->params->colidx[r][s]; + global_dpd_->buf4_close(&tau); + global_dpd_->buf4_close(&tau1_AO); - if(p!=q && r!=s) { + dpd_set_default(1); + global_dpd_->buf4_init(&tau1_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (1)"); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (2)"); + global_dpd_->buf4_scm(&tau2_AO, 0.0); - /* (pq|rs) */ - Gpr = Gp ^ Gr; - pr = tau1_AO->params->colidx[p][r]; - qs = tau1_AO->params->colidx[q][s]; - sq = tau1_AO->params->colidx[s][q]; - - for(row=0; row < tau1_AO->params->rowtot[Gpr]; row++) { - tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; - if(anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_rd(&tau1_AO, h); + global_dpd_->buf4_mat_irrep_init(&tau2_AO, h); } - /* (pq|sr) */ - Gps = Gp ^ Gs; - ps = tau1_AO->params->colidx[p][s]; - qr = tau1_AO->params->colidx[q][r]; - rq = tau1_AO->params->colidx[r][q]; - - for(row=0; row < tau1_AO->params->rowtot[Gps]; row++) { - tau2_AO->matrix[Gps][row][ps] += value * tau1_AO->matrix[Gps][row][qr]; - if(anti) tau2_AO->matrix[Gps][row][ps] -= value * tau1_AO->matrix[Gps][row][rq]; - } + iwl_buf_init(&InBuf, PSIF_SO_TEI, tolerance, 1, 1); - /* (qp|rs) */ - Gqr = Gq ^ Gr; - qr = tau1_AO->params->colidx[q][r]; - ps = tau1_AO->params->colidx[p][s]; - sp = tau1_AO->params->colidx[s][p]; + lblptr = InBuf.labels; + valptr = InBuf.values; + lastbuf = InBuf.lastbuf; - for(row=0; row < tau1_AO->params->rowtot[Gqr]; row++) { - tau2_AO->matrix[Gqr][row][qr] += value * tau1_AO->matrix[Gqr][row][ps]; - if(anti) tau2_AO->matrix[Gqr][row][qr] -= value * tau1_AO->matrix[Gqr][row][sp]; - } + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - /* (qp|sr) */ - Gqs = Gq ^ Gs; - qs = tau1_AO->params->colidx[q][s]; - pr = tau1_AO->params->colidx[p][r]; - rp = tau1_AO->params->colidx[r][p]; + value = (double)valptr[InBuf.idx]; - for(row=0; row < tau1_AO->params->rowtot[Gqs]; row++) { - tau2_AO->matrix[Gqs][row][qs] += value * tau1_AO->matrix[Gqs][row][pr]; - if(anti) tau2_AO->matrix[Gqs][row][qs] -= value * tau1_AO->matrix[Gqs][row][rp]; - } + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ - if(pq != rs) { - /* (rs|pq) */ - Grp = Gp ^ Gr; - rp = tau1_AO->params->colidx[r][p]; - sq = tau1_AO->params->colidx[s][q]; - qs = tau1_AO->params->colidx[q][s]; - - for(row=0; row < tau1_AO->params->rowtot[Grp]; row++) { - tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; - if(anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; - } - - /* (sr|pq) */ - Gsp = Gp ^ Gs; - sp = tau1_AO->params->colidx[s][p]; - qr = tau1_AO->params->colidx[q][r]; - rq = tau1_AO->params->colidx[r][q]; - - for(row=0; row < tau1_AO->params->rowtot[Gsp]; row++) { - tau2_AO->matrix[Gsp][row][sp] += value * tau1_AO->matrix[Gsp][row][rq]; - if(anti) tau2_AO->matrix[Gsp][row][sp] -= value * tau1_AO->matrix[Gsp][row][qr]; - } - - /* (rs|qp) */ - Grq = Gq ^ Gr; - rq = tau1_AO->params->colidx[r][q]; - ps = tau1_AO->params->colidx[p][s]; - sp = tau1_AO->params->colidx[s][p]; - - for(row=0; row < tau1_AO->params->rowtot[Grq]; row++) { - tau2_AO->matrix[Grq][row][rq] += value * tau1_AO->matrix[Grq][row][sp]; - if(anti) tau2_AO->matrix[Grq][row][rq] -= value * tau1_AO->matrix[Grq][row][ps]; - } - - /* (sr|qp) */ - Gsq = Gq ^ Gs; - sq = tau1_AO->params->colidx[s][q]; - pr = tau1_AO->params->colidx[p][r]; - rp = tau1_AO->params->colidx[r][p]; - - for(row=0; row < tau1_AO->params->rowtot[Gsq]; row++) { - tau2_AO->matrix[Gsq][row][sq] += value * tau1_AO->matrix[Gsq][row][rp]; - if(anti) tau2_AO->matrix[Gsq][row][sq] -= value * tau1_AO->matrix[Gsq][row][pr]; - } + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 0); } + while (!lastbuf) { + iwl_buf_fetch(&InBuf); + lastbuf = InBuf.lastbuf; + for (idx = 4 * InBuf.idx; InBuf.idx < InBuf.inbuf; InBuf.idx++) { + p = std::abs((int)lblptr[idx++]); + q = (int)lblptr[idx++]; + r = (int)lblptr[idx++]; + s = (int)lblptr[idx++]; - } - else if(p!=q && r==s) { + value = (double)valptr[InBuf.idx]; - /* (pq|rs) */ - Gpr = Gp ^ Gr; - pr = tau1_AO->params->colidx[p][r]; - qs = tau1_AO->params->colidx[q][s]; - sq = tau1_AO->params->colidx[s][q]; + /* outfile->Printf( "<%d %d %d %d = %20.10lf\n", p, q, r, s, value); */ - for(row=0; row < tau1_AO->params->rowtot[Gpr]; row++) { - tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; - if(anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + AO_contribute(p, q, r, s, value, &tau1_AO, &tau2_AO, 0); + } } - /* (qp|rs) */ - Gqr = Gq ^ Gr; - qr = tau1_AO->params->colidx[q][r]; - ps = tau1_AO->params->colidx[p][s]; - sp = tau1_AO->params->colidx[s][p]; + iwl_buf_close(&InBuf, 1); - for(row=0; row < tau1_AO->params->rowtot[Gqr]; row++) { - tau2_AO->matrix[Gqr][row][qr] += value * tau1_AO->matrix[Gqr][row][ps]; - if(anti) tau2_AO->matrix[Gqr][row][qr] -= value * tau1_AO->matrix[Gqr][row][sp]; + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau2_AO, h); + global_dpd_->buf4_mat_irrep_close(&tau1_AO, h); } + global_dpd_->buf4_close(&tau1_AO); + global_dpd_->buf4_close(&tau2_AO); - if(pq != rs) { - - /* (rs|pq) */ - Grp = Gp ^ Gr; - rp = tau1_AO->params->colidx[r][p]; - sq = tau1_AO->params->colidx[s][q]; - qs = tau1_AO->params->colidx[q][s]; - - for(row=0; row < tau1_AO->params->rowtot[Grp]; row++) { - tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; - if(anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; - } - - /* (rs|qp) */ - Grq = Gq ^ Gr; - rq = tau1_AO->params->colidx[r][q]; - ps = tau1_AO->params->colidx[p][s]; - sp = tau1_AO->params->colidx[s][p]; - - for(row=0; row < tau1_AO->params->rowtot[Grq]; row++) { - tau2_AO->matrix[Grq][row][rq] += value * tau1_AO->matrix[Grq][row][sp]; - if(anti) tau2_AO->matrix[Grq][row][rq] -= value * tau1_AO->matrix[Grq][row][ps]; - } - } + dpd_set_default(1); + global_dpd_->buf4_init(&tau2_AO, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjPq (2)"); - } + dpd_set_default(0); + global_dpd_->buf4_init(&t2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - else if(p==q && r!=s) { + halftrans(&t2, 0, &tau2_AO, 1, C, nirreps, T2_cd_row_start, T2_pq_row_start, virtpi, orbspi, 1, 1.0, 1.0); - /* (pq|rs) */ - Gpr = Gp ^ Gr; - pr = tau1_AO->params->colidx[p][r]; - qs = tau1_AO->params->colidx[q][s]; - sq = tau1_AO->params->colidx[s][q]; + global_dpd_->buf4_close(&t2); + global_dpd_->buf4_close(&tau2_AO); - for(row=0; row < tau1_AO->params->rowtot[Gpr]; row++) { - tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; - if(anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; - } + free(T2_cd_row_start); + free(T2_pq_row_start); - /* (pq|sr) */ - Gps = Gp ^ Gs; - ps = tau1_AO->params->colidx[p][s]; - qr = tau1_AO->params->colidx[q][r]; - rq = tau1_AO->params->colidx[r][q]; + /* Reset the default dpd back to 0 --- this stuff gets really ugly */ + dpd_set_default(0); +} - for(row=0; row < tau1_AO->params->rowtot[Gps]; row++) { - tau2_AO->matrix[Gps][row][ps] += value * tau1_AO->matrix[Gps][row][qr]; - if(anti) tau2_AO->matrix[Gps][row][ps] -= value * tau1_AO->matrix[Gps][row][rq]; - } +void AO_contribute(int p, int q, int r, int s, double value, dpdbuf4 *tau1_AO, dpdbuf4 *tau2_AO, int anti) { + int Gp, Gq, Gr, Gs, Gpr, Gps, Gqr, Gqs, Grp, Gsp, Grq, Gsq; + int pr, ps, qr, qs, rp, rq, sp, sq, pq, rs; + int row; + + Gp = tau1_AO->params->rsym[p]; + Gq = tau1_AO->params->rsym[q]; + Gr = tau1_AO->params->rsym[r]; + Gs = tau1_AO->params->rsym[s]; + + pq = tau1_AO->params->colidx[p][q]; + rs = tau1_AO->params->colidx[r][s]; + + if (p != q && r != s) { + /* (pq|rs) */ + Gpr = Gp ^ Gr; + pr = tau1_AO->params->colidx[p][r]; + qs = tau1_AO->params->colidx[q][s]; + sq = tau1_AO->params->colidx[s][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gpr]; row++) { + tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; + if (anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + } + + /* (pq|sr) */ + Gps = Gp ^ Gs; + ps = tau1_AO->params->colidx[p][s]; + qr = tau1_AO->params->colidx[q][r]; + rq = tau1_AO->params->colidx[r][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gps]; row++) { + tau2_AO->matrix[Gps][row][ps] += value * tau1_AO->matrix[Gps][row][qr]; + if (anti) tau2_AO->matrix[Gps][row][ps] -= value * tau1_AO->matrix[Gps][row][rq]; + } + + /* (qp|rs) */ + Gqr = Gq ^ Gr; + qr = tau1_AO->params->colidx[q][r]; + ps = tau1_AO->params->colidx[p][s]; + sp = tau1_AO->params->colidx[s][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Gqr]; row++) { + tau2_AO->matrix[Gqr][row][qr] += value * tau1_AO->matrix[Gqr][row][ps]; + if (anti) tau2_AO->matrix[Gqr][row][qr] -= value * tau1_AO->matrix[Gqr][row][sp]; + } + + /* (qp|sr) */ + Gqs = Gq ^ Gs; + qs = tau1_AO->params->colidx[q][s]; + pr = tau1_AO->params->colidx[p][r]; + rp = tau1_AO->params->colidx[r][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Gqs]; row++) { + tau2_AO->matrix[Gqs][row][qs] += value * tau1_AO->matrix[Gqs][row][pr]; + if (anti) tau2_AO->matrix[Gqs][row][qs] -= value * tau1_AO->matrix[Gqs][row][rp]; + } + + if (pq != rs) { + /* (rs|pq) */ + Grp = Gp ^ Gr; + rp = tau1_AO->params->colidx[r][p]; + sq = tau1_AO->params->colidx[s][q]; + qs = tau1_AO->params->colidx[q][s]; + + for (row = 0; row < tau1_AO->params->rowtot[Grp]; row++) { + tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; + if (anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; + } + + /* (sr|pq) */ + Gsp = Gp ^ Gs; + sp = tau1_AO->params->colidx[s][p]; + qr = tau1_AO->params->colidx[q][r]; + rq = tau1_AO->params->colidx[r][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gsp]; row++) { + tau2_AO->matrix[Gsp][row][sp] += value * tau1_AO->matrix[Gsp][row][rq]; + if (anti) tau2_AO->matrix[Gsp][row][sp] -= value * tau1_AO->matrix[Gsp][row][qr]; + } + + /* (rs|qp) */ + Grq = Gq ^ Gr; + rq = tau1_AO->params->colidx[r][q]; + ps = tau1_AO->params->colidx[p][s]; + sp = tau1_AO->params->colidx[s][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Grq]; row++) { + tau2_AO->matrix[Grq][row][rq] += value * tau1_AO->matrix[Grq][row][sp]; + if (anti) tau2_AO->matrix[Grq][row][rq] -= value * tau1_AO->matrix[Grq][row][ps]; + } + + /* (sr|qp) */ + Gsq = Gq ^ Gs; + sq = tau1_AO->params->colidx[s][q]; + pr = tau1_AO->params->colidx[p][r]; + rp = tau1_AO->params->colidx[r][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Gsq]; row++) { + tau2_AO->matrix[Gsq][row][sq] += value * tau1_AO->matrix[Gsq][row][rp]; + if (anti) tau2_AO->matrix[Gsq][row][sq] -= value * tau1_AO->matrix[Gsq][row][pr]; + } + } + + } else if (p != q && r == s) { + /* (pq|rs) */ + Gpr = Gp ^ Gr; + pr = tau1_AO->params->colidx[p][r]; + qs = tau1_AO->params->colidx[q][s]; + sq = tau1_AO->params->colidx[s][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gpr]; row++) { + tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; + if (anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + } + + /* (qp|rs) */ + Gqr = Gq ^ Gr; + qr = tau1_AO->params->colidx[q][r]; + ps = tau1_AO->params->colidx[p][s]; + sp = tau1_AO->params->colidx[s][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Gqr]; row++) { + tau2_AO->matrix[Gqr][row][qr] += value * tau1_AO->matrix[Gqr][row][ps]; + if (anti) tau2_AO->matrix[Gqr][row][qr] -= value * tau1_AO->matrix[Gqr][row][sp]; + } + + if (pq != rs) { + /* (rs|pq) */ + Grp = Gp ^ Gr; + rp = tau1_AO->params->colidx[r][p]; + sq = tau1_AO->params->colidx[s][q]; + qs = tau1_AO->params->colidx[q][s]; + + for (row = 0; row < tau1_AO->params->rowtot[Grp]; row++) { + tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; + if (anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; + } + + /* (rs|qp) */ + Grq = Gq ^ Gr; + rq = tau1_AO->params->colidx[r][q]; + ps = tau1_AO->params->colidx[p][s]; + sp = tau1_AO->params->colidx[s][p]; + + for (row = 0; row < tau1_AO->params->rowtot[Grq]; row++) { + tau2_AO->matrix[Grq][row][rq] += value * tau1_AO->matrix[Grq][row][sp]; + if (anti) tau2_AO->matrix[Grq][row][rq] -= value * tau1_AO->matrix[Grq][row][ps]; + } + } - if(pq != rs) { - - /* (rs|pq) */ - Grp = Gp ^ Gr; - rp = tau1_AO->params->colidx[r][p]; - sq = tau1_AO->params->colidx[s][q]; - qs = tau1_AO->params->colidx[q][s]; - - for(row=0; row < tau1_AO->params->rowtot[Grp]; row++) { - tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; - if(anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; - } - - /* (sr|pq) */ - Gsp = Gp ^ Gs; - sp = tau1_AO->params->colidx[s][p]; - qr = tau1_AO->params->colidx[q][r]; - rq = tau1_AO->params->colidx[r][q]; - - for(row=0; row < tau1_AO->params->rowtot[Gsp]; row++) { - tau2_AO->matrix[Gsp][row][sp] += value * tau1_AO->matrix[Gsp][row][rq]; - if(anti) tau2_AO->matrix[Gsp][row][sp] -= value * tau1_AO->matrix[Gsp][row][qr]; - } } - } + else if (p == q && r != s) { + /* (pq|rs) */ + Gpr = Gp ^ Gr; + pr = tau1_AO->params->colidx[p][r]; + qs = tau1_AO->params->colidx[q][s]; + sq = tau1_AO->params->colidx[s][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gpr]; row++) { + tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; + if (anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + } + + /* (pq|sr) */ + Gps = Gp ^ Gs; + ps = tau1_AO->params->colidx[p][s]; + qr = tau1_AO->params->colidx[q][r]; + rq = tau1_AO->params->colidx[r][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gps]; row++) { + tau2_AO->matrix[Gps][row][ps] += value * tau1_AO->matrix[Gps][row][qr]; + if (anti) tau2_AO->matrix[Gps][row][ps] -= value * tau1_AO->matrix[Gps][row][rq]; + } + + if (pq != rs) { + /* (rs|pq) */ + Grp = Gp ^ Gr; + rp = tau1_AO->params->colidx[r][p]; + sq = tau1_AO->params->colidx[s][q]; + qs = tau1_AO->params->colidx[q][s]; + + for (row = 0; row < tau1_AO->params->rowtot[Grp]; row++) { + tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; + if (anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; + } + + /* (sr|pq) */ + Gsp = Gp ^ Gs; + sp = tau1_AO->params->colidx[s][p]; + qr = tau1_AO->params->colidx[q][r]; + rq = tau1_AO->params->colidx[r][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gsp]; row++) { + tau2_AO->matrix[Gsp][row][sp] += value * tau1_AO->matrix[Gsp][row][rq]; + if (anti) tau2_AO->matrix[Gsp][row][sp] -= value * tau1_AO->matrix[Gsp][row][qr]; + } + } - else if(p==q && r==s) { - - /* (pq|rs) */ - Gpr = Gp ^ Gr; - pr = tau1_AO->params->colidx[p][r]; - qs = tau1_AO->params->colidx[q][s]; - sq = tau1_AO->params->colidx[s][q]; - - for(row=0; row < tau1_AO->params->rowtot[Gpr]; row++) { - tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; - if(anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; } - if(pq != rs) { - - /* (rs|pq) */ - Grp = Gp ^ Gr; - rp = tau1_AO->params->colidx[r][p]; - sq = tau1_AO->params->colidx[s][q]; - qs = tau1_AO->params->colidx[q][s]; - - for(row=0; row < tau1_AO->params->rowtot[Grp]; row++) { - tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; - if(anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; - } - + else if (p == q && r == s) { + /* (pq|rs) */ + Gpr = Gp ^ Gr; + pr = tau1_AO->params->colidx[p][r]; + qs = tau1_AO->params->colidx[q][s]; + sq = tau1_AO->params->colidx[s][q]; + + for (row = 0; row < tau1_AO->params->rowtot[Gpr]; row++) { + tau2_AO->matrix[Gpr][row][pr] += value * tau1_AO->matrix[Gpr][row][qs]; + if (anti) tau2_AO->matrix[Gpr][row][pr] -= value * tau1_AO->matrix[Gpr][row][sq]; + } + + if (pq != rs) { + /* (rs|pq) */ + Grp = Gp ^ Gr; + rp = tau1_AO->params->colidx[r][p]; + sq = tau1_AO->params->colidx[s][q]; + qs = tau1_AO->params->colidx[q][s]; + + for (row = 0; row < tau1_AO->params->rowtot[Grp]; row++) { + tau2_AO->matrix[Grp][row][rp] += value * tau1_AO->matrix[Grp][row][sq]; + if (anti) tau2_AO->matrix[Grp][row][rp] -= value * tau1_AO->matrix[Grp][row][qs]; + } + } } - - } - return; + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/DL2.cc b/psi4/src/psi4/cclambda/DL2.cc index caf5f901c66..0689a177128 100644 --- a/psi4/src/psi4/cclambda/DL2.cc +++ b/psi4/src/psi4/cclambda/DL2.cc @@ -38,134 +38,129 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { - void DL2(struct L_Params L_params) - { - dpdbuf4 D, Dold, X2; - int L_irr; - L_irr = L_params.irrep; +void DL2(struct L_Params L_params) { + dpdbuf4 D, Dold, X2; + int L_irr; + L_irr = L_params.irrep; - if (L_params.ground) { - /* RHS = */ - if(params.ref == 0) { /** RHF **/ - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&D); - // Add T3 contribution to CCSD(T) lambda equations - if(params.wfn == "CCSD_T") { - global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 0, 5, 0, 5, 0, "SIjAb(T)"); - global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&D, &X2, 1.0); - global_dpd_->buf4_close(&X2); + if (L_params.ground) { + /* RHS = */ + if (params.ref == 0) { /** RHF **/ + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&D); + // Add T3 contribution to CCSD(T) lambda equations + if (params.wfn == "CCSD_T") { + global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 0, 5, 0, 5, 0, "SIjAb(T)"); + global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&D, &X2, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&D); + } + } else if (params.ref == 1) { /** ROHF **/ + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New Lijab"); global_dpd_->buf4_close(&D); - } - } - else if(params.ref == 1) { /** ROHF **/ - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&D); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&D); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); - global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); + global_dpd_->buf4_copy(&D, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&D); - /* If CCSD(T) gradient, add T3 contributions */ - if(params.wfn == "CCSD_T") { - global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 2, 7, 2, 7, 0, "SIJAB"); - global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&D, &X2, 1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&D); + /* If CCSD(T) gradient, add T3 contributions */ + if (params.wfn == "CCSD_T") { + global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 2, 7, 2, 7, 0, "SIJAB"); + global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&D, &X2, 1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 12, 17, 12, 17, 0, "Sijab"); - global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&D, &X2, 1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 12, 17, 12, 17, 0, "Sijab"); + global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&D, &X2, 1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 22, 28, 22, 28, 0, "SIjAb"); - global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&D, &X2, 1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&D); - } - } - } - /* excited state - no inhomogeneous term, first term is E*L */ - else if (!params.zeta) { - if (params.ref == 0) { /* RHF */ - global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); - global_dpd_->buf4_close(&Dold); - global_dpd_->buf4_close(&D); - } - else if (params.ref == 1 ) { /* ROHF */ - global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); - global_dpd_->buf4_close(&Dold); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); - global_dpd_->buf4_close(&Dold); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); - global_dpd_->buf4_close(&Dold); - global_dpd_->buf4_close(&D); - } - else { /** UHF **/ - /* do nothing - TDC did not change to increments for the UHF case */ - } - } - /* solving zeta equations, homogeneous term is Xi, zero out files */ - else { - if (params.ref == 0) { /* RHF */ - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&X2); - } - else if (params.ref == 1 ) { /* ROHF */ - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "Xijab"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&X2); - } - else { /** UHF **/ - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 12, 17, 12, 17, 0, "Xijab"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 22, 28, 22, 28, 0, "XIjAb"); - global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&X2); - } - } + global_dpd_->buf4_init(&D, PSIF_CC_MISC, 0, 22, 28, 22, 28, 0, "SIjAb"); + global_dpd_->buf4_init(&X2, PSIF_CC_LAMBDA, 0, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&D, &X2, 1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&D); + } + } + } + /* excited state - no inhomogeneous term, first term is E*L */ + else if (!params.zeta) { + if (params.ref == 0) { /* RHF */ + global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); + global_dpd_->buf4_close(&Dold); + global_dpd_->buf4_close(&D); + } else if (params.ref == 1) { /* ROHF */ + global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); + global_dpd_->buf4_close(&Dold); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); + global_dpd_->buf4_close(&Dold); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_init(&D, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&Dold, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_axpy(&Dold, &D, -1.0 * L_params.cceom_energy); + global_dpd_->buf4_close(&Dold); + global_dpd_->buf4_close(&D); + } else { /** UHF **/ + /* do nothing - TDC did not change to increments for the UHF case */ + } + } + /* solving zeta equations, homogeneous term is Xi, zero out files */ + else { + if (params.ref == 0) { /* RHF */ + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&X2); + } else if (params.ref == 1) { /* ROHF */ + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "Xijab"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&X2); + } else { /** UHF **/ + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 12, 17, 12, 17, 0, "Xijab"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&X2, PSIF_EOM_XI, L_irr, 22, 28, 22, 28, 0, "XIjAb"); + global_dpd_->buf4_copy(&X2, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&X2); + } } +} - }} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/FaeL2.cc b/psi4/src/psi4/cclambda/FaeL2.cc index c736db7a66f..35b3a8b3d13 100644 --- a/psi4/src/psi4/cclambda/FaeL2.cc +++ b/psi4/src/psi4/cclambda/FaeL2.cc @@ -37,140 +37,137 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /** The ROHF version of this contraction can be done with fewer contractions. **/ -void FaeL2(int L_irr) -{ - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLIJAB, newLijab, newLIjAb; - dpdfile2 LFaet2, LFAEt2, F; - dpdbuf4 X, X1, X2; - dpdbuf4 L2, newL2; - - /* RHS += P(ab)*Lijae*Feb */ - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->contract424(&L2, &F, &X, 3, 0, 0, 1, 0); - global_dpd_->file2_close(&F); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&X, &newL2, 1); - global_dpd_->buf4_close(&newL2); - - global_dpd_->buf4_close(&X); - - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 1, 1, "Fae"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&LIJAB, &LFAEt2, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&LFAEt2, &LIJAB, &X2, 0, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&Lijab, &LFaet2, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&LFaet2, &Lijab, &X2, 0, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &LFaet2, &newLIjAb, 3, 0, 0, 1.0, 1.0); - global_dpd_->contract244(&LFAEt2, &LIjAb, &newLIjAb, 0, 2, 1, 1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&LFaet2); - global_dpd_->file2_close(&LFAEt2); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAEt"); - global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 3, 3, "Faet"); - - /** X(IJ,AB) = L_IJ^AE F_EB **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract424(&LIJAB, &LFAEt2, &X, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(IJ,AB) --> X'(IJ,BA) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 2, 5, "X'(IJ,BA)"); - global_dpd_->buf4_close(&X); - /** X(IJ,AB) = X(IJ,AB) - X'(IJ,BA) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X'(IJ,BA)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&X1); - /** L(IJ,AB) <-- X(IJ,AB) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X); - global_dpd_->buf4_close(&newLIJAB); - - /** X(ij,ab) = L_ij^ae F_eb **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract424(&LIJAB, &LFaet2, &X, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(ij,ab) --> X'(ij,ba) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 12, 15, "X'(ij,ba)"); - global_dpd_->buf4_close(&X); - /** X(ij,ab) = X(ij,ab) - X'(ij,ba) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X'(ij,ba)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&X1); - /** L(ij,ab) <-- X(ij,ab) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X); - global_dpd_->buf4_close(&newLIJAB); - - /** L(Ij,Ab) <-- L(Ij,Ae) F(e,b) - F(E,A) L(Ij,Eb) **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &LFaet2, &newLIjAb, 3, 0, 0, 1, 1); - global_dpd_->contract244(&LFAEt2, &LIjAb, &newLIjAb, 0, 2, 1, 1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&LFaet2); - global_dpd_->file2_close(&LFAEt2); - - } - +void FaeL2(int L_irr) { + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLIJAB, newLijab, newLIjAb; + dpdfile2 LFaet2, LFAEt2, F; + dpdbuf4 X, X1, X2; + dpdbuf4 L2, newL2; + + /* RHS += P(ab)*Lijae*Feb */ + + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->contract424(&L2, &F, &X, 3, 0, 0, 1, 0); + global_dpd_->file2_close(&F); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&X, &newL2, 1); + global_dpd_->buf4_close(&newL2); + + global_dpd_->buf4_close(&X); + + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 1, 1, "Fae"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&LIJAB, &LFAEt2, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&LFAEt2, &LIJAB, &X2, 0, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&Lijab, &LFaet2, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&LFaet2, &Lijab, &X2, 0, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &LFaet2, &newLIjAb, 3, 0, 0, 1.0, 1.0); + global_dpd_->contract244(&LFAEt2, &LIjAb, &newLIjAb, 0, 2, 1, 1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&LFaet2); + global_dpd_->file2_close(&LFAEt2); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAEt"); + global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 3, 3, "Faet"); + + /** X(IJ,AB) = L_IJ^AE F_EB **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract424(&LIJAB, &LFAEt2, &X, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(IJ,AB) --> X'(IJ,BA) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 2, 5, "X'(IJ,BA)"); + global_dpd_->buf4_close(&X); + /** X(IJ,AB) = X(IJ,AB) - X'(IJ,BA) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X'(IJ,BA)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&X1); + /** L(IJ,AB) <-- X(IJ,AB) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X); + global_dpd_->buf4_close(&newLIJAB); + + /** X(ij,ab) = L_ij^ae F_eb **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract424(&LIJAB, &LFaet2, &X, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(ij,ab) --> X'(ij,ba) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 12, 15, "X'(ij,ba)"); + global_dpd_->buf4_close(&X); + /** X(ij,ab) = X(ij,ab) - X'(ij,ba) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X'(ij,ba)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&X1); + /** L(ij,ab) <-- X(ij,ab) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X); + global_dpd_->buf4_close(&newLIJAB); + + /** L(Ij,Ab) <-- L(Ij,Ae) F(e,b) - F(E,A) L(Ij,Eb) **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &LFaet2, &newLIjAb, 3, 0, 0, 1, 1); + global_dpd_->contract244(&LFAEt2, &LIjAb, &newLIjAb, 0, 2, 1, 1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&LFaet2); + global_dpd_->file2_close(&LFAEt2); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/FmiL2.cc b/psi4/src/psi4/cclambda/FmiL2.cc index bae6119716c..ff4a99eae5f 100644 --- a/psi4/src/psi4/cclambda/FmiL2.cc +++ b/psi4/src/psi4/cclambda/FmiL2.cc @@ -37,134 +37,132 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /** The RHF/ROHF contractions can be improved here **/ -void FmiL2(int L_irr) -{ - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLijab, newLIJAB, newLIjAb; - dpdfile2 LFmit2, LFMIt2, F; - dpdbuf4 X, X1, X2; - dpdbuf4 L2, newL2; - - /* RHS -= P(ij)*Limab*Fjm */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->contract244(&F, &L2, &X, 1, 0, 0, -1.0, 0); - global_dpd_->file2_close(&F); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&X, &newL2, 1); - global_dpd_->buf4_close(&newL2); - - global_dpd_->buf4_close(&X); - } - else if(params.ref == 1) { /** RHF/ROHF **/ - - global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 0, 0, "Fmi"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&LIJAB, &LFMIt2, &X1, 1, 1, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&LFMIt2, &LIJAB, &X2, 1, 0, 0, -1.0, 0.0); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&Lijab, &LFmit2, &X1, 1, 1, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&LFmit2, &Lijab, &X2, 1, 0, 0, -1.0, 0.0); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &LFmit2, &newLIjAb, 1, 1, 1, -1.0, 1.0); - global_dpd_->contract244(&LFMIt2, &LIjAb, &newLIjAb, 1, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&LFmit2); - global_dpd_->file2_close(&LFMIt2); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMIt"); - global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 2, 2, "Fmit"); - - /** X(IJ,AB) = F(I,M) L(MJ,AB) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract244(&LFMIt2, &LIJAB, &X, 1, 0, 0, -1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(IJ,AB) --> X'(JI,AB) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 0, 7, "X'(JI,AB)"); - global_dpd_->buf4_close(&X); - - /** X(IJ,AB) = X(IJ,AB) - X'(JI,AB) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X'(JI,AB)"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - /** L(IJ,AB) <--- X(IJ,AB) **/ - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&newLIJAB); - - - /** X(ij,ab) = F(i,m) L(mj,ab) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract244(&LFmit2, &LIJAB, &X, 1, 0, 0, -1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(ij,ab) --> X'(ji,ab) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 10, 17, "X'(ji,ab)"); - global_dpd_->buf4_close(&X); - - /** X(ij,ab) = X(ij,ab) - X'(ji,ab) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X'(ji,ab)"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - /** L(ij,ab) <--- X(ij,ab) **/ - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&newLIJAB); - - /** L(Ij,Ab) <-- L(Im,Ab) F(j,m) - F(I,M) L(Mj,Ab) **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &LFmit2, &newLIjAb, 1, 1, 1, -1, 1); - global_dpd_->contract244(&LFMIt2, &LIjAb, &newLIjAb, 1, 0, 0, -1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&LFmit2); - global_dpd_->file2_close(&LFMIt2); - } +void FmiL2(int L_irr) { + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLijab, newLIJAB, newLIjAb; + dpdfile2 LFmit2, LFMIt2, F; + dpdbuf4 X, X1, X2; + dpdbuf4 L2, newL2; + + /* RHS -= P(ij)*Limab*Fjm */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->contract244(&F, &L2, &X, 1, 0, 0, -1.0, 0); + global_dpd_->file2_close(&F); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&X, &newL2, 1); + global_dpd_->buf4_close(&newL2); + + global_dpd_->buf4_close(&X); + } else if (params.ref == 1) { /** RHF/ROHF **/ + + global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 0, 0, "Fmi"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&LIJAB, &LFMIt2, &X1, 1, 1, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&LFMIt2, &LIJAB, &X2, 1, 0, 0, -1.0, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&Lijab, &LFmit2, &X1, 1, 1, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&LFmit2, &Lijab, &X2, 1, 0, 0, -1.0, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &LFmit2, &newLIjAb, 1, 1, 1, -1.0, 1.0); + global_dpd_->contract244(&LFMIt2, &LIjAb, &newLIjAb, 1, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&LFmit2); + global_dpd_->file2_close(&LFMIt2); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMIt"); + global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 2, 2, "Fmit"); + + /** X(IJ,AB) = F(I,M) L(MJ,AB) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract244(&LFMIt2, &LIJAB, &X, 1, 0, 0, -1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(IJ,AB) --> X'(JI,AB) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 0, 7, "X'(JI,AB)"); + global_dpd_->buf4_close(&X); + + /** X(IJ,AB) = X(IJ,AB) - X'(JI,AB) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X'(JI,AB)"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + /** L(IJ,AB) <--- X(IJ,AB) **/ + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&newLIJAB); + + /** X(ij,ab) = F(i,m) L(mj,ab) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract244(&LFmit2, &LIJAB, &X, 1, 0, 0, -1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(ij,ab) --> X'(ji,ab) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 10, 17, "X'(ji,ab)"); + global_dpd_->buf4_close(&X); + + /** X(ij,ab) = X(ij,ab) - X'(ji,ab) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X'(ji,ab)"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + /** L(ij,ab) <--- X(ij,ab) **/ + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&newLIJAB); + + /** L(Ij,Ab) <-- L(Im,Ab) F(j,m) - F(I,M) L(Mj,Ab) **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &LFmit2, &newLIjAb, 1, 1, 1, -1, 1); + global_dpd_->contract244(&LFMIt2, &LIjAb, &newLIjAb, 1, 0, 0, -1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&LFmit2); + global_dpd_->file2_close(&LFMIt2); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/G.cc b/psi4/src/psi4/cclambda/G.cc index 47a9915d772..a4629c1966e 100644 --- a/psi4/src/psi4/cclambda/G.cc +++ b/psi4/src/psi4/cclambda/G.cc @@ -37,185 +37,178 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void G_build(int L_irr) { - dpdbuf4 LIJAB, Lijab, LiJaB, LIjAb, LijAB, LIJab; - dpdbuf4 tIJAB, tijab, tiJaB, tIjAb, tijAB, tIJab; - dpdfile2 GAE, Gae, GMI, Gmi; - - if(params.ref == 0) { - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - - /* T(Mj,Ab) * [ 2 L(Ij,Ab) - L(Ij,Ba) ] --> G(M,I) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1, 0); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - global_dpd_->file2_close(&GMI); - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - - /* T(Ij,Eb) * [ 2 L(Ij,Ab) - L(Ij,Ba) ] --> G(A,E) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 2, 2, -1, 0); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - global_dpd_->file2_close(&GAE); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); - - /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&tIJAB, &LIJAB, &GMI, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&tIJAB); - global_dpd_->buf4_close(&LIJAB); - - /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tijab"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); - global_dpd_->contract442(&tijab, &Lijab, &Gmi, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&tijab); - global_dpd_->buf4_close(&Lijab); - - /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->contract442(&tiJaB, &LiJaB, &Gmi, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&tiJaB); - global_dpd_->buf4_close(&LiJaB); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - - - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); - - /* T2(IJ,AB) * L2(IJ,EB) --> G(A,E) */ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&LIJAB, &tIJAB, &GAE, 2, 2, -1.0, 0.0); - global_dpd_->buf4_close(&tIJAB); - global_dpd_->buf4_close(&LIJAB); - - /* T2(Ij,Ab) * L2(Ij,Eb) --> G(A,E) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 2, 2, -1.0, 1.0); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - /* T2(ij,ab) * L2(ij,eb) --> G(a,e) */ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tijab"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); - global_dpd_->contract442(&Lijab, &tijab, &Gae, 2, 2, -1.0, 0.0); - global_dpd_->buf4_close(&tijab); - global_dpd_->buf4_close(&Lijab); - - /* T2(iJ,aB) * L2(iJ,eB) --> G(a,e) */ - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->contract442(&LiJaB, &tiJaB, &Gae, 2, 2, -1.0, 1.0); - global_dpd_->buf4_close(&tiJaB); - global_dpd_->buf4_close(&LiJaB); - - global_dpd_->file2_close(&GAE); - global_dpd_->file2_close(&Gae); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); - - /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&tIJAB, &LIJAB, &GMI, 0, 0, 1, 0); - global_dpd_->buf4_close(&tIJAB); - global_dpd_->buf4_close(&LIJAB); - - /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1, 1); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 10, 17, 12, 17, 0, "tijab"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&tijab, &Lijab, &Gmi, 0, 0, 1, 0); - global_dpd_->buf4_close(&tijab); - global_dpd_->buf4_close(&Lijab); - - /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 23, 29, 23, 29, 0, "tiJaB"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&tiJaB, &LiJaB, &Gmi, 0, 0, 1, 1); - global_dpd_->buf4_close(&tiJaB); - global_dpd_->buf4_close(&LiJaB); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - - - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); - - /* T2(JI,BA) * L2(JI,BE) --> G(A,E) */ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&LIJAB, &tIJAB, &GAE, 3, 3, -1, 0); - global_dpd_->buf4_close(&tIJAB); - global_dpd_->buf4_close(&LIJAB); - - /* T2(jI,bA) * L2(jI,bE) --> G(A,E) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 23, 29, 23, 29, 0, "tiJaB"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 3, 3, -1, 1); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - /* T2(ji,ba) * L2(ji,be) --> G(a,e) */ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 12, 15, 12, 17, 0, "tijab"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&Lijab, &tijab, &Gae, 3, 3, -1, 0); - global_dpd_->buf4_close(&tijab); - global_dpd_->buf4_close(&Lijab); - - /* T2(Ji,Ba) * L2(Ji,Be) --> G(a,e) */ - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&LiJaB, &tiJaB, &Gae, 3, 3, -1, 1); - global_dpd_->buf4_close(&tiJaB); - global_dpd_->buf4_close(&LiJaB); - - global_dpd_->file2_close(&GAE); - global_dpd_->file2_close(&Gae); - - } - - return; + dpdbuf4 LIJAB, Lijab, LiJaB, LIjAb, LijAB, LIJab; + dpdbuf4 tIJAB, tijab, tiJaB, tIjAb, tijAB, tIJab; + dpdfile2 GAE, Gae, GMI, Gmi; + + if (params.ref == 0) { + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + + /* T(Mj,Ab) * [ 2 L(Ij,Ab) - L(Ij,Ba) ] --> G(M,I) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1, 0); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + global_dpd_->file2_close(&GMI); + + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + + /* T(Ij,Eb) * [ 2 L(Ij,Ab) - L(Ij,Ba) ] --> G(A,E) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 2, 2, -1, 0); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + global_dpd_->file2_close(&GAE); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); + + /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&tIJAB, &LIJAB, &GMI, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&tIJAB); + global_dpd_->buf4_close(&LIJAB); + + /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tijab"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); + global_dpd_->contract442(&tijab, &Lijab, &Gmi, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&tijab); + global_dpd_->buf4_close(&Lijab); + + /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->contract442(&tiJaB, &LiJaB, &Gmi, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&tiJaB); + global_dpd_->buf4_close(&LiJaB); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); + + /* T2(IJ,AB) * L2(IJ,EB) --> G(A,E) */ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&LIJAB, &tIJAB, &GAE, 2, 2, -1.0, 0.0); + global_dpd_->buf4_close(&tIJAB); + global_dpd_->buf4_close(&LIJAB); + + /* T2(Ij,Ab) * L2(Ij,Eb) --> G(A,E) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 2, 2, -1.0, 1.0); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + /* T2(ij,ab) * L2(ij,eb) --> G(a,e) */ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tijab"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); + global_dpd_->contract442(&Lijab, &tijab, &Gae, 2, 2, -1.0, 0.0); + global_dpd_->buf4_close(&tijab); + global_dpd_->buf4_close(&Lijab); + + /* T2(iJ,aB) * L2(iJ,eB) --> G(a,e) */ + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->contract442(&LiJaB, &tiJaB, &Gae, 2, 2, -1.0, 1.0); + global_dpd_->buf4_close(&tiJaB); + global_dpd_->buf4_close(&LiJaB); + + global_dpd_->file2_close(&GAE); + global_dpd_->file2_close(&Gae); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); + + /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&tIJAB, &LIJAB, &GMI, 0, 0, 1, 0); + global_dpd_->buf4_close(&tIJAB); + global_dpd_->buf4_close(&LIJAB); + + /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&tIjAb, &LIjAb, &GMI, 0, 0, 1, 1); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 10, 17, 12, 17, 0, "tijab"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&tijab, &Lijab, &Gmi, 0, 0, 1, 0); + global_dpd_->buf4_close(&tijab); + global_dpd_->buf4_close(&Lijab); + + /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 23, 29, 23, 29, 0, "tiJaB"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&tiJaB, &LiJaB, &Gmi, 0, 0, 1, 1); + global_dpd_->buf4_close(&tiJaB); + global_dpd_->buf4_close(&LiJaB); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); + + /* T2(JI,BA) * L2(JI,BE) --> G(A,E) */ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 2, 5, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&LIJAB, &tIJAB, &GAE, 3, 3, -1, 0); + global_dpd_->buf4_close(&tIJAB); + global_dpd_->buf4_close(&LIJAB); + + /* T2(jI,bA) * L2(jI,bE) --> G(A,E) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 23, 29, 23, 29, 0, "tiJaB"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&LIjAb, &tIjAb, &GAE, 3, 3, -1, 1); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + /* T2(ji,ba) * L2(ji,be) --> G(a,e) */ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 12, 15, 12, 17, 0, "tijab"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&Lijab, &tijab, &Gae, 3, 3, -1, 0); + global_dpd_->buf4_close(&tijab); + global_dpd_->buf4_close(&Lijab); + + /* T2(Ji,Ba) * L2(Ji,Be) --> G(a,e) */ + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&LiJaB, &tiJaB, &Gae, 3, 3, -1, 1); + global_dpd_->buf4_close(&tiJaB); + global_dpd_->buf4_close(&LiJaB); + + global_dpd_->file2_close(&GAE); + global_dpd_->file2_close(&Gae); + } + + return; } - - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/GL2.cc b/psi4/src/psi4/cclambda/GL2.cc index 4fbb019a6b0..710f5b3568a 100644 --- a/psi4/src/psi4/cclambda/GL2.cc +++ b/psi4/src/psi4/cclambda/GL2.cc @@ -37,7 +37,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* GaeL2(): Computes Gae three-body contributions of HBAR matrix ** elements to the Lambda doubles equations. These are written in @@ -50,123 +51,117 @@ namespace psi { namespace cclambda { ** TDC, July 2002 */ -void GaeL2(int L_irr) -{ - dpdbuf4 L2, newLijab, newLIJAB, newLIjAb, newL2; - dpdbuf4 D, Z; - dpdfile2 GAE, Gae, G; - dpdbuf4 X1, X2; - - /* RHS += P(ab)Gbe */ - if(params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&G, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract424(&D, &G, &Z, 3, 1, 0, 1, 0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&Z, &newL2, 1); - global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&G); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 5, 2, 5, 0, "D (i>j,ab)"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&D, &GAE, &X1, 3, 1, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&GAE, &D, &X2, 1, 2, 1, 1.0, 0.0); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&D, &Gae, &X1, 3, 1, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&Gae, &D, &X2, 1, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract424(&D, &Gae, &newLIjAb, 3, 1, 0, 1.0, 1.0); - global_dpd_->contract244(&GAE, &D, &newLIjAb, 1, 2, 1, 1.0, 1.0); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&GAE); - global_dpd_->file2_close(&Gae); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); - - /** X(IJ,AB) = G(B,E) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB)"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 5, 2, 5, 0, "D (I>J,AB)"); - global_dpd_->contract424(&D, &GAE, &X1, 3, 1, 0, 1, 0); - global_dpd_->buf4_close(&D); - /** X(IJ,AB) --> X(IJ,BA) **/ - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, pqsr, 2, 5, "X(IJ,BA)"); - /** X(IJ,AB) = X(IJ,AB) - X(IJ,BA) **/ - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "X(IJ,BA)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - /** X(IJ,AB) --> New L(IJ,AB) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X1, &L2, 1); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&L2); - - /** X(ij,ab) = G(b,e) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "X(ij,ab)"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 15, 12, 15, 0, "D (i>j,ab)"); - global_dpd_->contract424(&D, &Gae, &X1, 3, 1, 0, 1, 0); - global_dpd_->buf4_close(&D); - /** X(ij,ab) --> X(ij,ba) **/ - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, pqsr, 12, 15, "X(ij,ba)"); - /** X(ij,ab) = X(ij,ab) - X(ij,ba) **/ - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "X(ij,ba)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - /** X(ij,ab) --> New L(ij,ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X1, &L2, 1); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&L2); - - /** New L(Ij,Ab) = G(b,e) + G(A,E) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); - global_dpd_->contract424(&D, &Gae, &L2, 3, 1, 0, 1, 1); - global_dpd_->contract244(&GAE, &D, &L2, 1, 2, 1, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&L2); - - global_dpd_->file2_close(&GAE); - global_dpd_->file2_close(&Gae); - } - +void GaeL2(int L_irr) { + dpdbuf4 L2, newLijab, newLIJAB, newLIjAb, newL2; + dpdbuf4 D, Z; + dpdfile2 GAE, Gae, G; + dpdbuf4 X1, X2; + + /* RHS += P(ab)Gbe */ + if (params.ref == 0) { /** RHF **/ + global_dpd_->file2_init(&G, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract424(&D, &G, &Z, 3, 1, 0, 1, 0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&Z, &newL2, 1); + global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&G); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 5, 2, 5, 0, "D (i>j,ab)"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&D, &GAE, &X1, 3, 1, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&GAE, &D, &X2, 1, 2, 1, 1.0, 0.0); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&D, &Gae, &X1, 3, 1, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&Gae, &D, &X2, 1, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract424(&D, &Gae, &newLIjAb, 3, 1, 0, 1.0, 1.0); + global_dpd_->contract244(&GAE, &D, &newLIjAb, 1, 2, 1, 1.0, 1.0); + global_dpd_->buf4_close(&D); + + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&GAE); + global_dpd_->file2_close(&Gae); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); + + /** X(IJ,AB) = G(B,E) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB)"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 5, 2, 5, 0, "D (I>J,AB)"); + global_dpd_->contract424(&D, &GAE, &X1, 3, 1, 0, 1, 0); + global_dpd_->buf4_close(&D); + /** X(IJ,AB) --> X(IJ,BA) **/ + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, pqsr, 2, 5, "X(IJ,BA)"); + /** X(IJ,AB) = X(IJ,AB) - X(IJ,BA) **/ + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "X(IJ,BA)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + /** X(IJ,AB) --> New L(IJ,AB) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X1, &L2, 1); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&L2); + + /** X(ij,ab) = G(b,e) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "X(ij,ab)"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 15, 12, 15, 0, "D (i>j,ab)"); + global_dpd_->contract424(&D, &Gae, &X1, 3, 1, 0, 1, 0); + global_dpd_->buf4_close(&D); + /** X(ij,ab) --> X(ij,ba) **/ + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, pqsr, 12, 15, "X(ij,ba)"); + /** X(ij,ab) = X(ij,ab) - X(ij,ba) **/ + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "X(ij,ba)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + /** X(ij,ab) --> New L(ij,ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X1, &L2, 1); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&L2); + + /** New L(Ij,Ab) = G(b,e) + G(A,E) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); + global_dpd_->contract424(&D, &Gae, &L2, 3, 1, 0, 1, 1); + global_dpd_->contract244(&GAE, &D, &L2, 1, 2, 1, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_close(&GAE); + global_dpd_->file2_close(&Gae); + } } /* GmiL2(): Computes Gmi three-body contributions of HBAR matrix @@ -180,125 +175,119 @@ void GaeL2(int L_irr) ** TDC, July 2002 */ -void GmiL2(int L_irr) -{ - - dpdbuf4 L2, newLijab, newLIJAB, newLIjAb, newL2; - dpdbuf4 D, Z; - dpdfile2 GMI, Gmi, G; - dpdbuf4 X1, X2; - - /* RHS -= P(ij) * * Gmj */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&G, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract244(&G, &D, &Z, 0, 0, 0, -1, 0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&Z, &newL2, 1); - global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&G); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 7, 0, 7, 0, "D (ij,a>b)"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&D, &GMI, &X1, 1, 0, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&GMI, &D, &X2, 0, 0, 0, -1.0, 0.0); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&D, &Gmi, &X1, 1, 0, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&Gmi, &D, &X2, 0, 0, 0, -1.0, 0.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract424(&D, &Gmi, &newLIjAb, 1, 0, 1, -1.0, 1.0); - global_dpd_->contract244(&GMI, &D, &newLIjAb, 0, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); - - /** X(IJ,AB) = - G(M,I) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) C"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 7, 0, 7, 0, "D (IJ,A>B)"); - global_dpd_->contract244(&GMI, &D, &X1, 0, 0, 0, -1, 0); - global_dpd_->buf4_close(&D); - /** X(IJ,AB) --> X(JI,AB) **/ - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, qprs, 0, 7, "X(JI,AB)"); - /** X(IJ,AB) = X(IJ,AB) - X(JI,AB) **/ - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(JI,AB)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - /** X(IJ,AB) --> New L(IJ,AB) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&X1); - - /** X(ij,ab) = - G(m,i) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) C"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 10, 17, 10, 17, 0, "D (ij,a>b)"); - global_dpd_->contract244(&Gmi, &D, &X1, 0, 0, 0, -1, 0); - global_dpd_->buf4_close(&D); - /** X(ij,ab) --> X(ji,ab) **/ - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, qprs, 10, 17, "X(ji,ab)"); - /** X(ij,ab) = X(ij,ab) - X(ji,ab) **/ - global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 10, 17, 10, 17, 0, "X(ji,ab)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - /** X(ij,ab) --> New L(ij,ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&X1); - - - /* New L(Ij,Ab) <-- - G(m,j) - G(M,I) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); - global_dpd_->contract424(&D, &Gmi, &L2, 1, 0, 1, -1, 1); - global_dpd_->contract244(&GMI, &D, &L2, 0, 0, 0, -1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&L2); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - } - +void GmiL2(int L_irr) { + dpdbuf4 L2, newLijab, newLIJAB, newLIjAb, newL2; + dpdbuf4 D, Z; + dpdfile2 GMI, Gmi, G; + dpdbuf4 X1, X2; + + /* RHS -= P(ij) * * Gmj */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->file2_init(&G, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract244(&G, &D, &Z, 0, 0, 0, -1, 0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&Z, &newL2, 1); + global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&G); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 7, 0, 7, 0, "D (ij,a>b)"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&D, &GMI, &X1, 1, 0, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&GMI, &D, &X2, 0, 0, 0, -1.0, 0.0); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&D, &Gmi, &X1, 1, 0, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&Gmi, &D, &X2, 0, 0, 0, -1.0, 0.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract424(&D, &Gmi, &newLIjAb, 1, 0, 1, -1.0, 1.0); + global_dpd_->contract244(&GMI, &D, &newLIjAb, 0, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&D); + + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); + + /** X(IJ,AB) = - G(M,I) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) C"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 7, 0, 7, 0, "D (IJ,A>B)"); + global_dpd_->contract244(&GMI, &D, &X1, 0, 0, 0, -1, 0); + global_dpd_->buf4_close(&D); + /** X(IJ,AB) --> X(JI,AB) **/ + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, qprs, 0, 7, "X(JI,AB)"); + /** X(IJ,AB) = X(IJ,AB) - X(JI,AB) **/ + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 0, 7, 0, 7, 0, "X(JI,AB)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + /** X(IJ,AB) --> New L(IJ,AB) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&X1); + + /** X(ij,ab) = - G(m,i) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP2, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) C"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 10, 17, 10, 17, 0, "D (ij,a>b)"); + global_dpd_->contract244(&Gmi, &D, &X1, 0, 0, 0, -1, 0); + global_dpd_->buf4_close(&D); + /** X(ij,ab) --> X(ji,ab) **/ + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP2, qprs, 10, 17, "X(ji,ab)"); + /** X(ij,ab) = X(ij,ab) - X(ji,ab) **/ + global_dpd_->buf4_init(&X2, PSIF_CC_TMP2, L_irr, 10, 17, 10, 17, 0, "X(ji,ab)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + /** X(ij,ab) --> New L(ij,ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&X1); + + /* New L(Ij,Ab) <-- - G(m,j) - G(M,I) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); + global_dpd_->contract424(&D, &Gmi, &L2, 1, 0, 1, -1, 1); + global_dpd_->contract244(&GMI, &D, &L2, 0, 0, 0, -1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/L1.cc b/psi4/src/psi4/cclambda/L1.cc index 5a27963a586..bc9472d9597 100644 --- a/psi4/src/psi4/cclambda/L1.cc +++ b/psi4/src/psi4/cclambda/L1.cc @@ -42,697 +42,665 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - - void local_filter_T1(dpdfile2 *); - - void L1_build(struct L_Params L_params) { - dpdfile2 newLIA, newLia, LIA, Lia; - dpdfile2 dIA, dia, Fme, FME; - dpdfile2 LFaet2, LFAEt2, LFmit2, LFMIt2; - dpdfile2 GMI, Gmi, Gae, XIA, Xia; - dpdfile2 GAE; - dpdbuf4 WMBEJ, Wmbej, WMbEj, WmBeJ; - dpdbuf4 WMBIJ, Wmbij, WMbIj, WmBiJ; - dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB, L2; - dpdbuf4 WMNIE, Wmnie, WMnIe, WmNiE; - dpdbuf4 WAMEF, Wamef, WAmEf, WaMeF, W; - dpdbuf4 Z, D; - dpdfile2 XLD; - int Gim, Gi, Gm, Ga, Gam, nrows, ncols, A, a, am; - int Gei, ei, e, i, Gef, Ge, Gf, E, I, af, fa, f; - double *X; - int L_irr; - L_irr = L_params.irrep; - - /* ground state inhomogeneous term is Fme */ - if (L_params.ground) { - if(params.ref == 0) { - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&FME); - } - else if(params.ref == 1) { - global_dpd_->file2_init(&Fme,PSIF_CC_OEI, 0, 0, 1, "Fme"); - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); - } - else if(params.ref == 2) { - global_dpd_->file2_init(&Fme,PSIF_CC_OEI, 0, 2, 3, "Fme"); - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); - // Add T3 contribution to CCSD(T) lambda equations - if(params.wfn == "CCSD_T") { - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "SIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_axpy(&FME, &LIA, 1, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&FME); - - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 2, 3, "Sia"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_axpy(&FME, &LIA, 1, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&FME); - } - } - } - /* excited state - no inhomogenous term, first term is -energy*L*/ - else if (!params.zeta) { - if (params.ref == 0 || params.ref == 1) { - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_axpy(&LIA, &newLIA, -1.0 * L_params.cceom_energy,0.0); - global_dpd_->file2_axpy(&Lia, &newLia, -1.0 * L_params.cceom_energy,0.0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&newLia); - } - else if (params.ref == 2) { - /* do nothing - TDC did not change to increments for the UHF case */ - } - } - /* solving zeta equations; inhomogeneous term is Xi */ - else { - if (params.ref == 0) { - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&XIA); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); - global_dpd_->file2_init(&Xia, PSIF_EOM_XI, 0, 0, 1, "Xia"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&XIA); - global_dpd_->file2_close(&Xia); - } - else if(params.ref == 2) { - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); - global_dpd_->file2_init(&Xia, PSIF_EOM_XI, 0, 2, 3, "Xia"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&XIA); - global_dpd_->file2_close(&Xia); - } - } - - if(params.ref == 0 || params.ref == 1) { - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - } - else if(params.ref == 2) { - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - } - - if(params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - /* L1 RHS += Lie*Fea */ - global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->contract222(&LIA,&LFAEt2,&newLIA, 0, 1, 1.0, 1.0); - global_dpd_->file2_close(&LFAEt2); - - /* L1 RHS += -Lma*Fim */ - global_dpd_->file2_init(&LFMIt2,PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->contract222(&LFMIt2,&LIA,&newLIA, 0, 1, -1.0, 1.0); - global_dpd_->file2_close(&LFMIt2); - - /* L1 RHS += Lme*Wieam */ - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->contract422(&W, &LIA, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&LIA); - } - else if(params.ref == 1) { /** ROHF **/ - - /* L1 RHS += Lie*Fea */ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - - global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 1, 1, "Fae"); - global_dpd_->contract222(&Lia,&LFaet2,&newLia, 0, 1, 1.0, 1.0); - global_dpd_->contract222(&LIA,&LFAEt2,&newLIA, 0, 1, 1.0, 1.0); - global_dpd_->file2_close(&LFaet2); - global_dpd_->file2_close(&LFAEt2); - - /* L1 RHS += -Lma*Fim */ - global_dpd_->file2_init(&LFMIt2,PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->file2_init(&LFmit2,PSIF_CC_OEI, 0, 0, 0, "Fmi"); - global_dpd_->contract222(&LFmit2,&Lia,&newLia, 0, 1, -1.0, 1.0); - global_dpd_->contract222(&LFMIt2,&LIA,&newLIA, 0, 1, -1.0, 1.0); - global_dpd_->file2_close(&LFmit2); - global_dpd_->file2_close(&LFMIt2); - - /* L1 RHS += Lme*Wieam */ - global_dpd_->buf4_init(&WMBEJ, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); - global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&WMBEJ); - - global_dpd_->buf4_init(&WMbEj, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); - global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&WMbEj); - - global_dpd_->buf4_init(&Wmbej, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); - global_dpd_->contract422(&Wmbej, &Lia, &newLia, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&Wmbej); - - global_dpd_->buf4_init(&WmBeJ, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); - global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&WmBeJ); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - } - else if(params.ref == 2) { /** UHF **/ - - /* L1 RHS += Lie*Fea */ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - - global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAEt"); - global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 3, 3, "Faet"); - global_dpd_->contract222(&Lia,&LFaet2,&newLia, 0, 1, 1, 1); - global_dpd_->contract222(&LIA,&LFAEt2,&newLIA, 0, 1, 1, 1); - global_dpd_->file2_close(&LFaet2); - global_dpd_->file2_close(&LFAEt2); - - /* L1 RHS += -Lma*Fim */ - global_dpd_->file2_init(&LFMIt2,PSIF_CC_OEI, 0, 0, 0, "FMIt"); - global_dpd_->file2_init(&LFmit2,PSIF_CC_OEI, 0, 2, 2, "Fmit"); - global_dpd_->contract222(&LFmit2,&Lia,&newLia, 0, 1, -1, 1); - global_dpd_->contract222(&LFMIt2,&LIA,&newLIA, 0, 1, -1, 1); - global_dpd_->file2_close(&LFmit2); - global_dpd_->file2_close(&LFMIt2); - - /* L1 RHS += Lme*Wieam */ - global_dpd_->buf4_init(&WMBEJ, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); - global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&WMBEJ); - - global_dpd_->buf4_init(&WMbEj, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); - global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&WMbEj); - - global_dpd_->buf4_init(&Wmbej, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); - global_dpd_->contract422(&Wmbej, &Lia, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&Wmbej); - - global_dpd_->buf4_init(&WmBeJ, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); - global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&WmBeJ); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - } - - /* L1 RHS += 1/2 Limef*Wefam */ - /* L(i,a) += [ 2 L(im,ef) - L(im,fe) ] * W(am,ef) */ - /* Note: W(am,ef) is really Wabei (ei,ab) */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAbEi (Ei,Ab)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - /* dpd_contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); */ - global_dpd_->file2_mat_init(&newLIA); - global_dpd_->file2_mat_rd(&newLIA); - for(Gam=0; Gam < moinfo.nirreps; Gam++) { - Gef = Gam; /* W is totally symmetric */ - Gim = Gef ^ L_irr; - global_dpd_->buf4_mat_irrep_init(&L2, Gim); - global_dpd_->buf4_mat_irrep_rd(&L2, Gim); - global_dpd_->buf4_mat_irrep_shift13(&L2, Gim); - - for(Gi=0; Gi < moinfo.nirreps; Gi++) { - Ga = Gi ^ L_irr; - Gm = Ga ^ Gam; - W.matrix[Gam] = global_dpd_->dpd_block_matrix(moinfo.occpi[Gm],W.params->coltot[Gam]); - - nrows = moinfo.occpi[Gi]; - ncols = moinfo.occpi[Gm] * W.params->coltot[Gam]; - - for(A=0; A < moinfo.virtpi[Ga]; A++) { - a = moinfo.vir_off[Ga] + A; - am = W.row_offset[Gam][a]; - - global_dpd_->buf4_mat_irrep_rd_block(&W, Gam, am, moinfo.occpi[Gm]); - - if(nrows && ncols && moinfo.virtpi[Ga]) - C_DGEMV('n',nrows,ncols,1,L2.shift.matrix[Gim][Gi][0],ncols,W.matrix[Gam][0],1, - 1, &(newLIA.matrix[Gi][0][A]), moinfo.virtpi[Ga]); - - } - - global_dpd_->free_dpd_block(W.matrix[Gam], moinfo.occpi[Gm], W.params->coltot[Gam]); - } - global_dpd_->buf4_mat_irrep_close(&L2, Gim); - } - global_dpd_->file2_mat_wrt(&newLIA); - global_dpd_->file2_mat_close(&newLIA); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "WEIAB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WEiAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "Weiab"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WeIaB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 2) { - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 7, 21, 7, 0, "WEIAB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WEiAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 17, 31, 17, 0, "Weiab"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WeIaB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - } - - /* L1 RHS += -1/2 Lmnae*Wiemn */ - if(params.ref == 0) { - global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WMbIj"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&WMbIj); - } - else if(params.ref == 1) { - - global_dpd_->buf4_init(&WMBIJ, PSIF_CC_HBAR, 0, 10, 2, 10, 2, 0, "WMBIJ"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1.0, 1.0); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&WMBIJ); - - global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WMbIj"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&WMbIj); - - global_dpd_->buf4_init(&Wmbij, PSIF_CC_HBAR, 0, 10, 2, 10, 2, 0, "Wmbij"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); - global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1.0, 1.0); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&Wmbij); - - global_dpd_->buf4_init(&WmBiJ, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WmBiJ"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1.0, 1.0); - global_dpd_->buf4_close(&LiJaB); - global_dpd_->buf4_close(&WmBiJ); - } - else if(params.ref == 2) { - - global_dpd_->buf4_init(&WMBIJ, PSIF_CC_HBAR, 0, 20, 2, 20, 2, 0, "WMBIJ"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&WMBIJ); - - global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 24, 22, 24, 22, 0, "WMbIj"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&WMbIj); - - global_dpd_->buf4_init(&Wmbij, PSIF_CC_HBAR, 0, 30, 12, 30, 12, 0, "Wmbij"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1, 1); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&Wmbij); - - global_dpd_->buf4_init(&WmBiJ, PSIF_CC_HBAR, 0, 27, 23, 27, 23, 0, "WmBiJ"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1, 1); - global_dpd_->buf4_close(&LiJaB); - global_dpd_->buf4_close(&WmBiJ); - } - - - /* L1 RHS += -Gef*Weifa */ - if(params.ref == 0) { - - /* dpd_file2_init(&GAE, CC_LAMBDA, L_irr, 1, 1, "GAE"); */ - /* dpd_buf4_init(&WaMeF, CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf 2(Am,Ef) - (Am,fE)"); */ - /* dpd_dot13(&GAE,&WaMeF,&newLIA, 0, 0, -1.0, 1.0); */ - /* dpd_buf4_close(&WaMeF); */ - /* dpd_file2_close(&GAE); */ - - /* Above code replaced to remove disk-space and memory bottlenecks 7/26/05, -TDC */ - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_mat_init(&GAE); - global_dpd_->file2_mat_rd(&GAE); - global_dpd_->file2_mat_init(&newLIA); - global_dpd_->file2_mat_rd(&newLIA); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); - for(Gei=0; Gei < moinfo.nirreps; Gei++) { - global_dpd_->buf4_mat_irrep_row_init(&W, Gei); - X = init_array(W.params->coltot[Gei]); - for(ei=0; ei < W.params->rowtot[Gei]; ei++) { - global_dpd_->buf4_mat_irrep_row_rd(&W, Gei, ei); - e = W.params->roworb[Gei][ei][0]; - i = W.params->roworb[Gei][ei][1]; - Ge = W.params->psym[e]; - Gf = Ge ^ L_irr; - Gi = Ge ^ Gei; - Ga = Gi ^ L_irr; - E = e - moinfo.vir_off[Ge]; - I = i - moinfo.occ_off[Gi]; - - zero_arr(X,W.params->coltot[Gei]); - - for(fa=0; fa < W.params->coltot[Gei]; fa++) { - f = W.params->colorb[Gei][fa][0]; - a = W.params->colorb[Gei][fa][1]; - af = W.params->colidx[a][f]; - X[fa] = 2.0 * W.matrix[Gei][0][fa] - W.matrix[Gei][0][af]; - } - - nrows = moinfo.virtpi[Gf]; - ncols = moinfo.virtpi[Ga]; - if(nrows && ncols) - C_DGEMV('t',nrows,ncols,-1,&X[W.col_offset[Gei][Gf]],ncols, - GAE.matrix[Ge][E],1,1,newLIA.matrix[Gi][I],1); - - } - global_dpd_->buf4_mat_irrep_row_close(&W, Gei); - free(X); - } - global_dpd_->buf4_close(&W); - global_dpd_->file2_mat_wrt(&newLIA); - global_dpd_->file2_mat_close(&newLIA); - global_dpd_->file2_mat_close(&GAE); - global_dpd_->file2_close(&GAE); - } - else if(params.ref == 1) { - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); - - global_dpd_->buf4_init(&WAMEF, PSIF_CC_HBAR, 0, 11, 5, 11, 7, 0, "WAMEF"); - global_dpd_->dot13(&GAE,&WAMEF,&newLIA, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WAMEF); - - global_dpd_->buf4_init(&WaMeF, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WaMeF"); - global_dpd_->dot13(&Gae,&WaMeF,&newLIA, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WaMeF); - - global_dpd_->buf4_init(&Wamef, PSIF_CC_HBAR, 0, 11, 5, 11, 7, 0, "Wamef"); - global_dpd_->dot13(&Gae,&Wamef,&newLia, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&Wamef); - - global_dpd_->buf4_init(&WAmEf, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); - global_dpd_->dot13(&GAE,&WAmEf,&newLia, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WAmEf); - - /* - dpd_buf4_init(&WAMEF, CC_HBAR, 0, 10, 5, 10, 7, 0, "WAMEF"); - dpd_dot23(&GAE,&WAMEF,&newLIA, 0, 0, -1.0, 1.0); - dpd_buf4_close(&WAMEF); - dpd_buf4_init(&WaMeF, CC_HBAR, 0, 10, 5, 10, 5, 0, "WaMeF"); - dpd_dot23(&Gae,&WaMeF,&newLIA, 0, 0, -1.0, 1.0); - dpd_buf4_close(&WaMeF); - dpd_buf4_init(&Wamef, CC_HBAR, 0, 10, 5, 10, 7, 0, "Wamef"); - dpd_dot23(&Gae,&Wamef,&newLia, 0, 0, -1.0, 1.0); - dpd_buf4_close(&Wamef); - dpd_buf4_init(&WAmEf, CC_HBAR, 0, 10, 5, 10, 5, 0, "WAmEf"); - dpd_dot23(&GAE,&WAmEf,&newLia, 0, 0, -1.0, 1.0); - dpd_buf4_close(&WAmEf); - */ - - global_dpd_->file2_close(&Gae); - global_dpd_->file2_close(&GAE); - } - else if(params.ref == 2) { - - global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); - global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 5, 21, 7, 0, "WAMEF"); - global_dpd_->dot13(&GAE,&W,&newLIA, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WaMeF"); - global_dpd_->dot13(&Gae,&W,&newLIA, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 15, 31, 17, 0, "Wamef"); - global_dpd_->dot13(&Gae,&W,&newLia, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WAmEf"); - global_dpd_->dot13(&GAE,&W,&newLia, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&Gae); - global_dpd_->file2_close(&GAE); - - } - - /* L1 RHS += -Gmn*Wmina */ - if(params.ref == 0) { - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - - global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "2WMnIe - WnMIe (Mn,eI)"); - global_dpd_->dot14(&GMI, &WmNiE, &newLIA, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WmNiE); - - global_dpd_->file2_close(&GMI); - } - else if(params.ref == 1) { - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); - - global_dpd_->buf4_init(&WMNIE, PSIF_CC_HBAR, 0, 0, 11, 2, 11, 0, "WMNIE (M>N,EI)"); - global_dpd_->dot14(&GMI, &WMNIE, &newLIA, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WMNIE); - - global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WmNiE (mN,Ei)"); - global_dpd_->dot14(&Gmi, &WmNiE, &newLIA, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WmNiE); - - global_dpd_->buf4_init(&Wmnie, PSIF_CC_HBAR, 0, 0, 11, 2, 11, 0, "Wmnie (m>n,ei)"); - global_dpd_->dot14(&Gmi, &Wmnie, &newLia, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&Wmnie); - - global_dpd_->buf4_init(&WMnIe, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WMnIe (Mn,eI)"); - global_dpd_->dot14(&GMI, &WMnIe, &newLia, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WMnIe); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - - } - else if(params.ref == 2) { - - global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); - global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 0, 21, 2, 21, 0, "WMNIE (M>N,EI)"); - global_dpd_->dot14(&GMI, &W, &newLIA, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 23, 26, 23, 26, 0, "WmNiE (mN,Ei)"); - global_dpd_->dot14(&Gmi, &W, &newLIA, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 31, 12, 31, 0, "Wmnie (m>n,ei)"); - global_dpd_->dot14(&Gmi, &W, &newLia, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 22, 25, 22, 25, 0, "WMnIe (Mn,eI)"); - global_dpd_->dot14(&GMI, &W, &newLia, 0, 0, -1, 1); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&Gmi); - global_dpd_->file2_close(&GMI); - } - - /* CC3 T3->L1 */ - if(params.wfn == "CC3") { - if(params.ref == 0) { - - global_dpd_->file2_init(&XLD, PSIF_CC3_MISC, 0, 0, 1, "CC3 XLD"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D 2 - "); - global_dpd_->dot24(&XLD, &D, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->file2_close(&XLD); +namespace psi { +namespace cclambda { + +void local_filter_T1(dpdfile2 *); + +void L1_build(struct L_Params L_params) { + dpdfile2 newLIA, newLia, LIA, Lia; + dpdfile2 dIA, dia, Fme, FME; + dpdfile2 LFaet2, LFAEt2, LFmit2, LFMIt2; + dpdfile2 GMI, Gmi, Gae, XIA, Xia; + dpdfile2 GAE; + dpdbuf4 WMBEJ, Wmbej, WMbEj, WmBeJ; + dpdbuf4 WMBIJ, Wmbij, WMbIj, WmBiJ; + dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB, L2; + dpdbuf4 WMNIE, Wmnie, WMnIe, WmNiE; + dpdbuf4 WAMEF, Wamef, WAmEf, WaMeF, W; + dpdbuf4 Z, D; + dpdfile2 XLD; + int Gim, Gi, Gm, Ga, Gam, nrows, ncols, A, a, am; + int Gei, ei, e, i, Gef, Ge, Gf, E, I, af, fa, f; + double *X; + int L_irr; + L_irr = L_params.irrep; + + /* ground state inhomogeneous term is Fme */ + if (L_params.ground) { + if (params.ref == 0) { + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&FME); + } else if (params.ref == 1) { + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + } else if (params.ref == 2) { + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 2, 3, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + // Add T3 contribution to CCSD(T) lambda equations + if (params.wfn == "CCSD_T") { + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "SIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_axpy(&FME, &LIA, 1, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&FME); + + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 2, 3, "Sia"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_axpy(&FME, &LIA, 1, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&FME); + } + } + } + /* excited state - no inhomogenous term, first term is -energy*L*/ + else if (!params.zeta) { + if (params.ref == 0 || params.ref == 1) { + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_axpy(&LIA, &newLIA, -1.0 * L_params.cceom_energy, 0.0); + global_dpd_->file2_axpy(&Lia, &newLia, -1.0 * L_params.cceom_energy, 0.0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&newLia); + } else if (params.ref == 2) { + /* do nothing - TDC did not change to increments for the UHF case */ + } + } + /* solving zeta equations; inhomogeneous term is Xi */ + else { + if (params.ref == 0) { + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&XIA); + } else if (params.ref == 1) { + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); + global_dpd_->file2_init(&Xia, PSIF_EOM_XI, 0, 0, 1, "Xia"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&XIA); + global_dpd_->file2_close(&Xia); + } else if (params.ref == 2) { + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, 0, 0, 1, "XIA"); + global_dpd_->file2_init(&Xia, PSIF_EOM_XI, 0, 2, 3, "Xia"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&XIA); + global_dpd_->file2_close(&Xia); + } + } + + if (params.ref == 0 || params.ref == 1) { + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + } else if (params.ref == 2) { + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + } + + if (params.ref == 0) { /** RHF **/ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + + /* L1 RHS += Lie*Fea */ + global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->contract222(&LIA, &LFAEt2, &newLIA, 0, 1, 1.0, 1.0); + global_dpd_->file2_close(&LFAEt2); + + /* L1 RHS += -Lma*Fim */ + global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->contract222(&LFMIt2, &LIA, &newLIA, 0, 1, -1.0, 1.0); + global_dpd_->file2_close(&LFMIt2); + + /* L1 RHS += Lme*Wieam */ + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->contract422(&W, &LIA, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_close(&LIA); + } else if (params.ref == 1) { /** ROHF **/ + + /* L1 RHS += Lie*Fea */ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + + global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 1, 1, "Fae"); + global_dpd_->contract222(&Lia, &LFaet2, &newLia, 0, 1, 1.0, 1.0); + global_dpd_->contract222(&LIA, &LFAEt2, &newLIA, 0, 1, 1.0, 1.0); + global_dpd_->file2_close(&LFaet2); + global_dpd_->file2_close(&LFAEt2); + + /* L1 RHS += -Lma*Fim */ + global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 0, 0, "Fmi"); + global_dpd_->contract222(&LFmit2, &Lia, &newLia, 0, 1, -1.0, 1.0); + global_dpd_->contract222(&LFMIt2, &LIA, &newLIA, 0, 1, -1.0, 1.0); + global_dpd_->file2_close(&LFmit2); + global_dpd_->file2_close(&LFMIt2); + + /* L1 RHS += Lme*Wieam */ + global_dpd_->buf4_init(&WMBEJ, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); + global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&WMBEJ); + + global_dpd_->buf4_init(&WMbEj, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); + global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&WMbEj); + + global_dpd_->buf4_init(&Wmbej, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); + global_dpd_->contract422(&Wmbej, &Lia, &newLia, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&Wmbej); + + global_dpd_->buf4_init(&WmBeJ, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); + global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&WmBeJ); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + } else if (params.ref == 2) { /** UHF **/ + + /* L1 RHS += Lie*Fea */ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + + global_dpd_->file2_init(&LFAEt2, PSIF_CC_OEI, 0, 1, 1, "FAEt"); + global_dpd_->file2_init(&LFaet2, PSIF_CC_OEI, 0, 3, 3, "Faet"); + global_dpd_->contract222(&Lia, &LFaet2, &newLia, 0, 1, 1, 1); + global_dpd_->contract222(&LIA, &LFAEt2, &newLIA, 0, 1, 1, 1); + global_dpd_->file2_close(&LFaet2); + global_dpd_->file2_close(&LFAEt2); + + /* L1 RHS += -Lma*Fim */ + global_dpd_->file2_init(&LFMIt2, PSIF_CC_OEI, 0, 0, 0, "FMIt"); + global_dpd_->file2_init(&LFmit2, PSIF_CC_OEI, 0, 2, 2, "Fmit"); + global_dpd_->contract222(&LFmit2, &Lia, &newLia, 0, 1, -1, 1); + global_dpd_->contract222(&LFMIt2, &LIA, &newLIA, 0, 1, -1, 1); + global_dpd_->file2_close(&LFmit2); + global_dpd_->file2_close(&LFMIt2); + + /* L1 RHS += Lme*Wieam */ + global_dpd_->buf4_init(&WMBEJ, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); + global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&WMBEJ); + + global_dpd_->buf4_init(&WMbEj, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); + global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&WMbEj); + + global_dpd_->buf4_init(&Wmbej, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); + global_dpd_->contract422(&Wmbej, &Lia, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&Wmbej); + + global_dpd_->buf4_init(&WmBeJ, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); + global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&WmBeJ); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + } + + /* L1 RHS += 1/2 Limef*Wefam */ + /* L(i,a) += [ 2 L(im,ef) - L(im,fe) ] * W(am,ef) */ + /* Note: W(am,ef) is really Wabei (ei,ab) */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAbEi (Ei,Ab)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + /* dpd_contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); */ + global_dpd_->file2_mat_init(&newLIA); + global_dpd_->file2_mat_rd(&newLIA); + for (Gam = 0; Gam < moinfo.nirreps; Gam++) { + Gef = Gam; /* W is totally symmetric */ + Gim = Gef ^ L_irr; + global_dpd_->buf4_mat_irrep_init(&L2, Gim); + global_dpd_->buf4_mat_irrep_rd(&L2, Gim); + global_dpd_->buf4_mat_irrep_shift13(&L2, Gim); + + for (Gi = 0; Gi < moinfo.nirreps; Gi++) { + Ga = Gi ^ L_irr; + Gm = Ga ^ Gam; + W.matrix[Gam] = global_dpd_->dpd_block_matrix(moinfo.occpi[Gm], W.params->coltot[Gam]); + + nrows = moinfo.occpi[Gi]; + ncols = moinfo.occpi[Gm] * W.params->coltot[Gam]; + + for (A = 0; A < moinfo.virtpi[Ga]; A++) { + a = moinfo.vir_off[Ga] + A; + am = W.row_offset[Gam][a]; + + global_dpd_->buf4_mat_irrep_rd_block(&W, Gam, am, moinfo.occpi[Gm]); + + if (nrows && ncols && moinfo.virtpi[Ga]) + C_DGEMV('n', nrows, ncols, 1, L2.shift.matrix[Gim][Gi][0], ncols, W.matrix[Gam][0], 1, 1, + &(newLIA.matrix[Gi][0][A]), moinfo.virtpi[Ga]); + } + + global_dpd_->free_dpd_block(W.matrix[Gam], moinfo.occpi[Gm], W.params->coltot[Gam]); + } + global_dpd_->buf4_mat_irrep_close(&L2, Gim); + } + global_dpd_->file2_mat_wrt(&newLIA); + global_dpd_->file2_mat_close(&newLIA); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "WEIAB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WEiAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "Weiab"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WeIaB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 7, 21, 7, 0, "WEIAB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WEiAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 17, 31, 17, 0, "Weiab"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WeIaB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + } + + /* L1 RHS += -1/2 Lmnae*Wiemn */ + if (params.ref == 0) { + global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WMbIj"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&WMbIj); + } else if (params.ref == 1) { + global_dpd_->buf4_init(&WMBIJ, PSIF_CC_HBAR, 0, 10, 2, 10, 2, 0, "WMBIJ"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1.0, 1.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&WMBIJ); + + global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WMbIj"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&WMbIj); + + global_dpd_->buf4_init(&Wmbij, PSIF_CC_HBAR, 0, 10, 2, 10, 2, 0, "Wmbij"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); + global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1.0, 1.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&Wmbij); + + global_dpd_->buf4_init(&WmBiJ, PSIF_CC_HBAR, 0, 10, 0, 10, 0, 0, "WmBiJ"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1.0, 1.0); + global_dpd_->buf4_close(&LiJaB); + global_dpd_->buf4_close(&WmBiJ); + } else if (params.ref == 2) { + global_dpd_->buf4_init(&WMBIJ, PSIF_CC_HBAR, 0, 20, 2, 20, 2, 0, "WMBIJ"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&WMBIJ); + + global_dpd_->buf4_init(&WMbIj, PSIF_CC_HBAR, 0, 24, 22, 24, 22, 0, "WMbIj"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&WMbIj); + + global_dpd_->buf4_init(&Wmbij, PSIF_CC_HBAR, 0, 30, 12, 30, 12, 0, "Wmbij"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1, 1); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&Wmbij); + + global_dpd_->buf4_init(&WmBiJ, PSIF_CC_HBAR, 0, 27, 23, 27, 23, 0, "WmBiJ"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1, 1); + global_dpd_->buf4_close(&LiJaB); + global_dpd_->buf4_close(&WmBiJ); + } + + /* L1 RHS += -Gef*Weifa */ + if (params.ref == 0) { + /* dpd_file2_init(&GAE, CC_LAMBDA, L_irr, 1, 1, "GAE"); */ + /* dpd_buf4_init(&WaMeF, CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf 2(Am,Ef) - (Am,fE)"); */ + /* dpd_dot13(&GAE,&WaMeF,&newLIA, 0, 0, -1.0, 1.0); */ + /* dpd_buf4_close(&WaMeF); */ + /* dpd_file2_close(&GAE); */ + + /* Above code replaced to remove disk-space and memory bottlenecks 7/26/05, -TDC */ + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_mat_init(&GAE); + global_dpd_->file2_mat_rd(&GAE); + global_dpd_->file2_mat_init(&newLIA); + global_dpd_->file2_mat_rd(&newLIA); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); + for (Gei = 0; Gei < moinfo.nirreps; Gei++) { + global_dpd_->buf4_mat_irrep_row_init(&W, Gei); + X = init_array(W.params->coltot[Gei]); + for (ei = 0; ei < W.params->rowtot[Gei]; ei++) { + global_dpd_->buf4_mat_irrep_row_rd(&W, Gei, ei); + e = W.params->roworb[Gei][ei][0]; + i = W.params->roworb[Gei][ei][1]; + Ge = W.params->psym[e]; + Gf = Ge ^ L_irr; + Gi = Ge ^ Gei; + Ga = Gi ^ L_irr; + E = e - moinfo.vir_off[Ge]; + I = i - moinfo.occ_off[Gi]; + + zero_arr(X, W.params->coltot[Gei]); + + for (fa = 0; fa < W.params->coltot[Gei]; fa++) { + f = W.params->colorb[Gei][fa][0]; + a = W.params->colorb[Gei][fa][1]; + af = W.params->colidx[a][f]; + X[fa] = 2.0 * W.matrix[Gei][0][fa] - W.matrix[Gei][0][af]; + } + + nrows = moinfo.virtpi[Gf]; + ncols = moinfo.virtpi[Ga]; + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, -1, &X[W.col_offset[Gei][Gf]], ncols, GAE.matrix[Ge][E], 1, 1, + newLIA.matrix[Gi][I], 1); + } + global_dpd_->buf4_mat_irrep_row_close(&W, Gei); + free(X); + } + global_dpd_->buf4_close(&W); + global_dpd_->file2_mat_wrt(&newLIA); + global_dpd_->file2_mat_close(&newLIA); + global_dpd_->file2_mat_close(&GAE); + global_dpd_->file2_close(&GAE); + } else if (params.ref == 1) { + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 1, 1, "Gae"); + + global_dpd_->buf4_init(&WAMEF, PSIF_CC_HBAR, 0, 11, 5, 11, 7, 0, "WAMEF"); + global_dpd_->dot13(&GAE, &WAMEF, &newLIA, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WAMEF); + + global_dpd_->buf4_init(&WaMeF, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WaMeF"); + global_dpd_->dot13(&Gae, &WaMeF, &newLIA, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WaMeF); + + global_dpd_->buf4_init(&Wamef, PSIF_CC_HBAR, 0, 11, 5, 11, 7, 0, "Wamef"); + global_dpd_->dot13(&Gae, &Wamef, &newLia, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&Wamef); + + global_dpd_->buf4_init(&WAmEf, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); + global_dpd_->dot13(&GAE, &WAmEf, &newLia, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WAmEf); + + /* + dpd_buf4_init(&WAMEF, CC_HBAR, 0, 10, 5, 10, 7, 0, "WAMEF"); + dpd_dot23(&GAE,&WAMEF,&newLIA, 0, 0, -1.0, 1.0); + dpd_buf4_close(&WAMEF); + dpd_buf4_init(&WaMeF, CC_HBAR, 0, 10, 5, 10, 5, 0, "WaMeF"); + dpd_dot23(&Gae,&WaMeF,&newLIA, 0, 0, -1.0, 1.0); + dpd_buf4_close(&WaMeF); + dpd_buf4_init(&Wamef, CC_HBAR, 0, 10, 5, 10, 7, 0, "Wamef"); + dpd_dot23(&Gae,&Wamef,&newLia, 0, 0, -1.0, 1.0); + dpd_buf4_close(&Wamef); + dpd_buf4_init(&WAmEf, CC_HBAR, 0, 10, 5, 10, 5, 0, "WAmEf"); + dpd_dot23(&GAE,&WAmEf,&newLia, 0, 0, -1.0, 1.0); + dpd_buf4_close(&WAmEf); + */ + + global_dpd_->file2_close(&Gae); + global_dpd_->file2_close(&GAE); + } else if (params.ref == 2) { + global_dpd_->file2_init(&GAE, PSIF_CC_LAMBDA, L_irr, 1, 1, "GAE"); + global_dpd_->file2_init(&Gae, PSIF_CC_LAMBDA, L_irr, 3, 3, "Gae"); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 5, 21, 7, 0, "WAMEF"); + global_dpd_->dot13(&GAE, &W, &newLIA, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WaMeF"); + global_dpd_->dot13(&Gae, &W, &newLIA, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 15, 31, 17, 0, "Wamef"); + global_dpd_->dot13(&Gae, &W, &newLia, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WAmEf"); + global_dpd_->dot13(&GAE, &W, &newLia, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_close(&Gae); + global_dpd_->file2_close(&GAE); + } + + /* L1 RHS += -Gmn*Wmina */ + if (params.ref == 0) { + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + + global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "2WMnIe - WnMIe (Mn,eI)"); + global_dpd_->dot14(&GMI, &WmNiE, &newLIA, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WmNiE); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); - global_dpd_->contract442(&Z, &L2, &newLIA, 0, 2, -0.5, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&L2); + global_dpd_->file2_close(&GMI); + } else if (params.ref == 1) { + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 0, 0, "Gmi"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIfLn"); - global_dpd_->contract442(&Z, &L2, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&WMNIE, PSIF_CC_HBAR, 0, 0, 11, 2, 11, 0, "WMNIE (M>N,EI)"); + global_dpd_->dot14(&GMI, &WMNIE, &newLIA, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WMNIE); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 11, 5, 11, 5, 0, "CC3 ZDFAN (AN,DF)"); - global_dpd_->contract442(&L2, &Z, &newLIA, 0, 0, 0.5, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 11, 5, 11, 5, 0, "CC3 ZDfAn (An,Df)"); - global_dpd_->contract442(&L2, &Z, &newLIA, 0, 0, 1.0, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&L2); - } - } - - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); - - /* newLia * Dia */ - if(params.ref == 0) { /** RHF **/ - - if(params.wfn == "CCSD_T") { + global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WmNiE (mN,Ei)"); + global_dpd_->dot14(&Gmi, &WmNiE, &newLIA, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WmNiE); + + global_dpd_->buf4_init(&Wmnie, PSIF_CC_HBAR, 0, 0, 11, 2, 11, 0, "Wmnie (m>n,ei)"); + global_dpd_->dot14(&Gmi, &Wmnie, &newLia, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&Wmnie); + + global_dpd_->buf4_init(&WMnIe, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WMnIe (Mn,eI)"); + global_dpd_->dot14(&GMI, &WMnIe, &newLia, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WMnIe); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + + } else if (params.ref == 2) { + global_dpd_->file2_init(&GMI, PSIF_CC_LAMBDA, L_irr, 0, 0, "GMI"); + global_dpd_->file2_init(&Gmi, PSIF_CC_LAMBDA, L_irr, 2, 2, "Gmi"); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 0, 21, 2, 21, 0, "WMNIE (M>N,EI)"); + global_dpd_->dot14(&GMI, &W, &newLIA, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 23, 26, 23, 26, 0, "WmNiE (mN,Ei)"); + global_dpd_->dot14(&Gmi, &W, &newLIA, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 31, 12, 31, 0, "Wmnie (m>n,ei)"); + global_dpd_->dot14(&Gmi, &W, &newLia, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 22, 25, 22, 25, 0, "WMnIe (Mn,eI)"); + global_dpd_->dot14(&GMI, &W, &newLia, 0, 0, -1, 1); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_close(&Gmi); + global_dpd_->file2_close(&GMI); + } + + /* CC3 T3->L1 */ + if (params.wfn == "CC3") { + if (params.ref == 0) { + global_dpd_->file2_init(&XLD, PSIF_CC3_MISC, 0, 0, 1, "CC3 XLD"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D 2 - "); + global_dpd_->dot24(&XLD, &D, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->file2_close(&XLD); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); + global_dpd_->contract442(&Z, &L2, &newLIA, 0, 2, -0.5, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIfLn"); + global_dpd_->contract442(&Z, &L2, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 11, 5, 11, 5, 0, "CC3 ZDFAN (AN,DF)"); + global_dpd_->contract442(&L2, &Z, &newLIA, 0, 0, 0.5, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 11, 5, 11, 5, 0, "CC3 ZDfAn (An,Df)"); + global_dpd_->contract442(&L2, &Z, &newLIA, 0, 0, 1.0, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&L2); + } + } + + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); + + /* newLia * Dia */ + if (params.ref == 0) { /** RHF **/ + + if (params.wfn == "CCSD_T") { global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "SIA(T)"); global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); global_dpd_->file2_axpy(&FME, &newLIA, 1, 0); global_dpd_->file2_close(&newLIA); global_dpd_->file2_close(&FME); - } - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - if(params.local && local.filter_singles) local_filter_T1(&newLIA); - else { - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); - } - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); - global_dpd_->file2_close(&LIA); - - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New Lia"); /* spin-adaptation for RHF */ - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_copy(&newLia, PSIF_CC_LAMBDA, "New Lia Increment"); - global_dpd_->file2_close(&newLia); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); - global_dpd_->file2_dirprd(&dia, &newLia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&newLia); - - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_copy(&Lia, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); - global_dpd_->file2_axpy(&Lia, &newLia, 1, 0); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&newLia); - } - else if(params.ref == 2) { - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); - global_dpd_->file2_dirprd(&dia, &newLia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&newLia); - } + } + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + if (params.local && local.filter_singles) + local_filter_T1(&newLIA); + else { + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + } + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); + global_dpd_->file2_close(&LIA); + + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New Lia"); /* spin-adaptation for RHF */ + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_copy(&newLia, PSIF_CC_LAMBDA, "New Lia Increment"); + global_dpd_->file2_close(&newLia); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); + global_dpd_->file2_dirprd(&dia, &newLia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&newLia); + + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_copy(&Lia, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); + global_dpd_->file2_axpy(&Lia, &newLia, 1, 0); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&newLia); + } else if (params.ref == 2) { + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); + global_dpd_->file2_dirprd(&dia, &newLia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&newLia); + } #ifdef EOM_DEBUG - check_sum("after L1 build",L_irr); + check_sum("after L1 build", L_irr); #endif - return; - } - - + return; +} - }} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/L1FL2.cc b/psi4/src/psi4/cclambda/L1FL2.cc index f3dce89506e..49b6decc85f 100644 --- a/psi4/src/psi4/cclambda/L1FL2.cc +++ b/psi4/src/psi4/cclambda/L1FL2.cc @@ -37,7 +37,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* L2FL2(): Computes the contributions of the Fme HBAR matrix elements ** to the Lambda doubles equations. These contributions are given in @@ -50,277 +51,292 @@ namespace psi { namespace cclambda { ** TDC, July 2002 */ -void L1FL2(int L_irr) -{ - int h, nirreps; - int row,col; - int i,j,a,b,I,J,A,B,Isym,Jsym,Asym,Bsym; - dpdfile2 LIA, Lia, FJB, Fjb, L, F; - dpdbuf4 newL2; - - nirreps = moinfo.nirreps; - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&L, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&L); - global_dpd_->file2_mat_rd(&L); - global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_mat_init(&F); - global_dpd_->file2_mat_rd(&F); - - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - for(h=0; h < nirreps; h++) { - - global_dpd_->buf4_mat_irrep_init(&newL2, h); - global_dpd_->buf4_mat_irrep_rd(&newL2, h); - - for(row=0; row < newL2.params->rowtot[h]; row++) { - i = newL2.params->roworb[h][row][0]; - j = newL2.params->roworb[h][row][1]; - - for(col=0; col < newL2.params->coltot[h^L_irr]; col++) { - a = newL2.params->colorb[h^L_irr][col][0]; - b = newL2.params->colorb[h^L_irr][col][1]; - - I = L.params->rowidx[i]; Isym = L.params->psym[i]; - J = F.params->rowidx[j]; Jsym = F.params->psym[j]; - A = L.params->colidx[a]; Asym = L.params->qsym[a]; - B = F.params->colidx[b]; Bsym = F.params->qsym[b]; - if(((Isym^Asym) == L_irr) && (Jsym == Bsym)) - newL2.matrix[h][row][col] += (L.matrix[Isym][I][A] * F.matrix[Jsym][J][B]); - - if((Isym == Asym) && ((Jsym^Bsym) == L_irr)) - newL2.matrix[h][row][col] += (L.matrix[Jsym][J][B] * F.matrix[Isym][I][A]); - } - } - - global_dpd_->buf4_mat_irrep_wrt(&newL2, h); - global_dpd_->buf4_mat_irrep_close(&newL2, h); - +void L1FL2(int L_irr) { + int h, nirreps; + int row, col; + int i, j, a, b, I, J, A, B, Isym, Jsym, Asym, Bsym; + dpdfile2 LIA, Lia, FJB, Fjb, L, F; + dpdbuf4 newL2; + + nirreps = moinfo.nirreps; + + if (params.ref == 0) { /** RHF **/ + + global_dpd_->file2_init(&L, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_mat_init(&L); + global_dpd_->file2_mat_rd(&L); + global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_mat_init(&F); + global_dpd_->file2_mat_rd(&F); + + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&newL2, h); + global_dpd_->buf4_mat_irrep_rd(&newL2, h); + + for (row = 0; row < newL2.params->rowtot[h]; row++) { + i = newL2.params->roworb[h][row][0]; + j = newL2.params->roworb[h][row][1]; + + for (col = 0; col < newL2.params->coltot[h ^ L_irr]; col++) { + a = newL2.params->colorb[h ^ L_irr][col][0]; + b = newL2.params->colorb[h ^ L_irr][col][1]; + + I = L.params->rowidx[i]; + Isym = L.params->psym[i]; + J = F.params->rowidx[j]; + Jsym = F.params->psym[j]; + A = L.params->colidx[a]; + Asym = L.params->qsym[a]; + B = F.params->colidx[b]; + Bsym = F.params->qsym[b]; + if (((Isym ^ Asym) == L_irr) && (Jsym == Bsym)) + newL2.matrix[h][row][col] += (L.matrix[Isym][I][A] * F.matrix[Jsym][J][B]); + + if ((Isym == Asym) && ((Jsym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] += (L.matrix[Jsym][J][B] * F.matrix[Isym][I][A]); + } + } + + global_dpd_->buf4_mat_irrep_wrt(&newL2, h); + global_dpd_->buf4_mat_irrep_close(&newL2, h); + } + + global_dpd_->buf4_close(&newL2); + + global_dpd_->file2_mat_close(&F); + global_dpd_->file2_close(&F); + global_dpd_->file2_mat_close(&L); + global_dpd_->file2_close(&L); + + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_mat_init(&LIA); + global_dpd_->file2_mat_rd(&LIA); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_mat_init(&Lia); + global_dpd_->file2_mat_rd(&Lia); + global_dpd_->file2_init(&FJB, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_mat_init(&FJB); + global_dpd_->file2_mat_rd(&FJB); + global_dpd_->file2_init(&Fjb, PSIF_CC_OEI, 0, 0, 1, "Fme"); + global_dpd_->file2_mat_init(&Fjb); + global_dpd_->file2_mat_rd(&Fjb); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_mat_init(&LIA); + global_dpd_->file2_mat_rd(&LIA); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_mat_init(&Lia); + global_dpd_->file2_mat_rd(&Lia); + global_dpd_->file2_init(&FJB, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_mat_init(&FJB); + global_dpd_->file2_mat_rd(&FJB); + global_dpd_->file2_init(&Fjb, PSIF_CC_OEI, 0, 2, 3, "Fme"); + global_dpd_->file2_mat_init(&Fjb); + global_dpd_->file2_mat_rd(&Fjb); } - global_dpd_->buf4_close(&newL2); - - global_dpd_->file2_mat_close(&F); - global_dpd_->file2_close(&F); - global_dpd_->file2_mat_close(&L); - global_dpd_->file2_close(&L); - - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&LIA); - global_dpd_->file2_mat_rd(&LIA); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_mat_init(&Lia); - global_dpd_->file2_mat_rd(&Lia); - global_dpd_->file2_init(&FJB, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_mat_init(&FJB); - global_dpd_->file2_mat_rd(&FJB); - global_dpd_->file2_init(&Fjb, PSIF_CC_OEI, 0, 0, 1, "Fme"); - global_dpd_->file2_mat_init(&Fjb); - global_dpd_->file2_mat_rd(&Fjb); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&LIA); - global_dpd_->file2_mat_rd(&LIA); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_mat_init(&Lia); - global_dpd_->file2_mat_rd(&Lia); - global_dpd_->file2_init(&FJB, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_mat_init(&FJB); - global_dpd_->file2_mat_rd(&FJB); - global_dpd_->file2_init(&Fjb, PSIF_CC_OEI, 0, 2, 3, "Fme"); - global_dpd_->file2_mat_init(&Fjb); - global_dpd_->file2_mat_rd(&Fjb); - - } - - if(params.ref == 1) /** RHF/ROHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - else if(params.ref == 2) /** UHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - - if(params.ref == 1 || params.ref == 2) { - /* loop over row irreps of LIJAB */ - for(h=0; h < nirreps; h++) { - - global_dpd_->buf4_mat_irrep_init(&newL2, h); - global_dpd_->buf4_mat_irrep_rd(&newL2, h); - - /* loop over rows of irrep of LIJAB */ - for(row=0; row < newL2.params->rowtot[h]; row++) { - i = newL2.params->roworb[h][row][0]; - j = newL2.params->roworb[h][row][1]; - - /* loop over cols of irrep of LIJAB */ - for(col=0; col < newL2.params->coltot[h^L_irr]; col++) { - a = newL2.params->colorb[h^L_irr][col][0]; - b = newL2.params->colorb[h^L_irr][col][1]; - - I = LIA.params->rowidx[i]; Isym = LIA.params->psym[i]; - J = FJB.params->rowidx[j]; Jsym = FJB.params->psym[j]; - A = LIA.params->colidx[a]; Asym = LIA.params->qsym[a]; - B = FJB.params->colidx[b]; Bsym = FJB.params->qsym[b]; - - if( ((Isym^Asym) == L_irr) && (Jsym == Bsym) ) - newL2.matrix[h][row][col] += (LIA.matrix[Isym][I][A] * - FJB.matrix[Jsym][J][B]); - - J = LIA.params->rowidx[j]; Jsym = LIA.params->psym[j]; - I = FJB.params->rowidx[i]; Isym = FJB.params->psym[i]; - - if( (Isym == Asym) && ((Jsym^Bsym) == L_irr) ) - newL2.matrix[h][row][col] += (LIA.matrix[Jsym][J][B] * - FJB.matrix[Isym][I][A]); - - I = LIA.params->rowidx[i]; Isym = LIA.params->psym[i]; - J = FJB.params->rowidx[j]; Jsym = FJB.params->psym[j]; - B = LIA.params->colidx[b]; Bsym = LIA.params->qsym[b]; - A = FJB.params->colidx[a]; Asym = FJB.params->qsym[a]; - - if( ((Jsym^Asym) == L_irr) && (Isym == Bsym)) - newL2.matrix[h][row][col] -= (LIA.matrix[Jsym][J][A] * - FJB.matrix[Isym][I][B]); - - J = LIA.params->rowidx[j]; Jsym = LIA.params->psym[j]; - I = FJB.params->rowidx[i]; Isym = FJB.params->psym[i]; - - if( (Jsym == Asym) && ((Isym^Bsym) == L_irr) ) - newL2.matrix[h][row][col] -= (LIA.matrix[Isym][I][B] * - FJB.matrix[Jsym][J][A]); - } - } - - global_dpd_->buf4_mat_irrep_wrt(&newL2, h); - global_dpd_->buf4_mat_irrep_close(&newL2, h); - + if (params.ref == 1) /** RHF/ROHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + else if (params.ref == 2) /** UHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + + if (params.ref == 1 || params.ref == 2) { + /* loop over row irreps of LIJAB */ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&newL2, h); + global_dpd_->buf4_mat_irrep_rd(&newL2, h); + + /* loop over rows of irrep of LIJAB */ + for (row = 0; row < newL2.params->rowtot[h]; row++) { + i = newL2.params->roworb[h][row][0]; + j = newL2.params->roworb[h][row][1]; + + /* loop over cols of irrep of LIJAB */ + for (col = 0; col < newL2.params->coltot[h ^ L_irr]; col++) { + a = newL2.params->colorb[h ^ L_irr][col][0]; + b = newL2.params->colorb[h ^ L_irr][col][1]; + + I = LIA.params->rowidx[i]; + Isym = LIA.params->psym[i]; + J = FJB.params->rowidx[j]; + Jsym = FJB.params->psym[j]; + A = LIA.params->colidx[a]; + Asym = LIA.params->qsym[a]; + B = FJB.params->colidx[b]; + Bsym = FJB.params->qsym[b]; + + if (((Isym ^ Asym) == L_irr) && (Jsym == Bsym)) + newL2.matrix[h][row][col] += (LIA.matrix[Isym][I][A] * FJB.matrix[Jsym][J][B]); + + J = LIA.params->rowidx[j]; + Jsym = LIA.params->psym[j]; + I = FJB.params->rowidx[i]; + Isym = FJB.params->psym[i]; + + if ((Isym == Asym) && ((Jsym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] += (LIA.matrix[Jsym][J][B] * FJB.matrix[Isym][I][A]); + + I = LIA.params->rowidx[i]; + Isym = LIA.params->psym[i]; + J = FJB.params->rowidx[j]; + Jsym = FJB.params->psym[j]; + B = LIA.params->colidx[b]; + Bsym = LIA.params->qsym[b]; + A = FJB.params->colidx[a]; + Asym = FJB.params->qsym[a]; + + if (((Jsym ^ Asym) == L_irr) && (Isym == Bsym)) + newL2.matrix[h][row][col] -= (LIA.matrix[Jsym][J][A] * FJB.matrix[Isym][I][B]); + + J = LIA.params->rowidx[j]; + Jsym = LIA.params->psym[j]; + I = FJB.params->rowidx[i]; + Isym = FJB.params->psym[i]; + + if ((Jsym == Asym) && ((Isym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] -= (LIA.matrix[Isym][I][B] * FJB.matrix[Jsym][J][A]); + } + } + + global_dpd_->buf4_mat_irrep_wrt(&newL2, h); + global_dpd_->buf4_mat_irrep_close(&newL2, h); + } + global_dpd_->buf4_close(&newL2); } - global_dpd_->buf4_close(&newL2); - } - - if(params.ref == 1) /** RHF/ROHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - else if(params.ref == 2) /** UHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - - if(params.ref == 1 || params.ref == 2) { - for(h=0; h < nirreps; h++) { - - global_dpd_->buf4_mat_irrep_init(&newL2, h); - global_dpd_->buf4_mat_irrep_rd(&newL2, h); - - for(row=0; row < newL2.params->rowtot[h]; row++) { - i = newL2.params->roworb[h][row][0]; - j = newL2.params->roworb[h][row][1]; - - for(col=0; col < newL2.params->coltot[h^L_irr]; col++) { - a = newL2.params->colorb[h^L_irr][col][0]; - b = newL2.params->colorb[h^L_irr][col][1]; - - I = Lia.params->rowidx[i]; Isym = Lia.params->psym[i]; - J = Fjb.params->rowidx[j]; Jsym = Fjb.params->psym[j]; - A = Lia.params->colidx[a]; Asym = Lia.params->qsym[a]; - B = Fjb.params->colidx[b]; Bsym = Fjb.params->qsym[b]; - - if(((Isym^Asym) == L_irr) && (Jsym == Bsym)) - newL2.matrix[h][row][col] += (Lia.matrix[Isym][I][A] * - Fjb.matrix[Jsym][J][B]); - - J = Lia.params->rowidx[j]; Jsym = Lia.params->psym[j]; - I = Fjb.params->rowidx[i]; Isym = Fjb.params->psym[i]; - - if((Isym == Asym) && ((Jsym^Bsym) == L_irr)) - newL2.matrix[h][row][col] += (Lia.matrix[Jsym][J][B] * - Fjb.matrix[Isym][I][A]); - - I = Lia.params->rowidx[i]; Isym = Lia.params->psym[i]; - J = Fjb.params->rowidx[j]; Jsym = Fjb.params->psym[j]; - B = Lia.params->colidx[b]; Bsym = Lia.params->qsym[b]; - A = Fjb.params->colidx[a]; Asym = Fjb.params->qsym[a]; - - if(((Jsym^Asym) == L_irr) && (Isym == Bsym)) - newL2.matrix[h][row][col] -= (Lia.matrix[Jsym][J][A] * - Fjb.matrix[Isym][I][B]); - - J = Lia.params->rowidx[j]; Jsym = Lia.params->psym[j]; - I = Fjb.params->rowidx[i]; Isym = Fjb.params->psym[i]; - - if((Jsym == Asym) && ((Isym^Bsym) == L_irr)) - newL2.matrix[h][row][col] -= (Lia.matrix[Isym][I][B] * - Fjb.matrix[Jsym][J][A]); - } - } - - global_dpd_->buf4_mat_irrep_wrt(&newL2, h); - global_dpd_->buf4_mat_irrep_close(&newL2, h); + if (params.ref == 1) /** RHF/ROHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + else if (params.ref == 2) /** UHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + + if (params.ref == 1 || params.ref == 2) { + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&newL2, h); + global_dpd_->buf4_mat_irrep_rd(&newL2, h); + + for (row = 0; row < newL2.params->rowtot[h]; row++) { + i = newL2.params->roworb[h][row][0]; + j = newL2.params->roworb[h][row][1]; + + for (col = 0; col < newL2.params->coltot[h ^ L_irr]; col++) { + a = newL2.params->colorb[h ^ L_irr][col][0]; + b = newL2.params->colorb[h ^ L_irr][col][1]; + + I = Lia.params->rowidx[i]; + Isym = Lia.params->psym[i]; + J = Fjb.params->rowidx[j]; + Jsym = Fjb.params->psym[j]; + A = Lia.params->colidx[a]; + Asym = Lia.params->qsym[a]; + B = Fjb.params->colidx[b]; + Bsym = Fjb.params->qsym[b]; + + if (((Isym ^ Asym) == L_irr) && (Jsym == Bsym)) + newL2.matrix[h][row][col] += (Lia.matrix[Isym][I][A] * Fjb.matrix[Jsym][J][B]); + + J = Lia.params->rowidx[j]; + Jsym = Lia.params->psym[j]; + I = Fjb.params->rowidx[i]; + Isym = Fjb.params->psym[i]; + + if ((Isym == Asym) && ((Jsym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] += (Lia.matrix[Jsym][J][B] * Fjb.matrix[Isym][I][A]); + + I = Lia.params->rowidx[i]; + Isym = Lia.params->psym[i]; + J = Fjb.params->rowidx[j]; + Jsym = Fjb.params->psym[j]; + B = Lia.params->colidx[b]; + Bsym = Lia.params->qsym[b]; + A = Fjb.params->colidx[a]; + Asym = Fjb.params->qsym[a]; + + if (((Jsym ^ Asym) == L_irr) && (Isym == Bsym)) + newL2.matrix[h][row][col] -= (Lia.matrix[Jsym][J][A] * Fjb.matrix[Isym][I][B]); + + J = Lia.params->rowidx[j]; + Jsym = Lia.params->psym[j]; + I = Fjb.params->rowidx[i]; + Isym = Fjb.params->psym[i]; + + if ((Jsym == Asym) && ((Isym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] -= (Lia.matrix[Isym][I][B] * Fjb.matrix[Jsym][J][A]); + } + } + + global_dpd_->buf4_mat_irrep_wrt(&newL2, h); + global_dpd_->buf4_mat_irrep_close(&newL2, h); + } + global_dpd_->buf4_close(&newL2); } - global_dpd_->buf4_close(&newL2); - } - - if(params.ref == 1) /** RHF/ROHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - else if(params.ref == 2) /** UHF **/ - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - if(params.ref == 1 || params.ref == 2) { - for(h=0; h < nirreps; h++) { - - global_dpd_->buf4_mat_irrep_init(&newL2, h); - global_dpd_->buf4_mat_irrep_rd(&newL2, h); - - for(row=0; row < newL2.params->rowtot[h]; row++) { - i = newL2.params->roworb[h][row][0]; - j = newL2.params->roworb[h][row][1]; - - for(col=0; col < newL2.params->coltot[h^L_irr]; col++) { - a = newL2.params->colorb[h^L_irr][col][0]; - b = newL2.params->colorb[h^L_irr][col][1]; - - I = LIA.params->rowidx[i]; Isym = LIA.params->psym[i]; - J = Fjb.params->rowidx[j]; Jsym = Fjb.params->psym[j]; - A = LIA.params->colidx[a]; Asym = LIA.params->qsym[a]; - B = Fjb.params->colidx[b]; Bsym = Fjb.params->qsym[b]; - - if(((Isym^Asym) == L_irr) && (Jsym == Bsym)) - newL2.matrix[h][row][col] += (LIA.matrix[Isym][I][A] * - Fjb.matrix[Jsym][J][B]); - - J = Lia.params->rowidx[j]; Jsym = Lia.params->psym[j]; - I = FJB.params->rowidx[i]; Isym = FJB.params->psym[i]; - B = Lia.params->colidx[b]; Bsym = Lia.params->qsym[b]; - A = FJB.params->colidx[a]; Asym = FJB.params->qsym[a]; - - if((Isym == Asym) && ((Jsym^Bsym) == L_irr)) - newL2.matrix[h][row][col] += (Lia.matrix[Jsym][J][B] * - FJB.matrix[Isym][I][A]); - } - } - - global_dpd_->buf4_mat_irrep_wrt(&newL2, h); - global_dpd_->buf4_mat_irrep_close(&newL2, h); + if (params.ref == 1) /** RHF/ROHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + else if (params.ref == 2) /** UHF **/ + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + + if (params.ref == 1 || params.ref == 2) { + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&newL2, h); + global_dpd_->buf4_mat_irrep_rd(&newL2, h); + + for (row = 0; row < newL2.params->rowtot[h]; row++) { + i = newL2.params->roworb[h][row][0]; + j = newL2.params->roworb[h][row][1]; + + for (col = 0; col < newL2.params->coltot[h ^ L_irr]; col++) { + a = newL2.params->colorb[h ^ L_irr][col][0]; + b = newL2.params->colorb[h ^ L_irr][col][1]; + + I = LIA.params->rowidx[i]; + Isym = LIA.params->psym[i]; + J = Fjb.params->rowidx[j]; + Jsym = Fjb.params->psym[j]; + A = LIA.params->colidx[a]; + Asym = LIA.params->qsym[a]; + B = Fjb.params->colidx[b]; + Bsym = Fjb.params->qsym[b]; + + if (((Isym ^ Asym) == L_irr) && (Jsym == Bsym)) + newL2.matrix[h][row][col] += (LIA.matrix[Isym][I][A] * Fjb.matrix[Jsym][J][B]); + + J = Lia.params->rowidx[j]; + Jsym = Lia.params->psym[j]; + I = FJB.params->rowidx[i]; + Isym = FJB.params->psym[i]; + B = Lia.params->colidx[b]; + Bsym = Lia.params->qsym[b]; + A = FJB.params->colidx[a]; + Asym = FJB.params->qsym[a]; + + if ((Isym == Asym) && ((Jsym ^ Bsym) == L_irr)) + newL2.matrix[h][row][col] += (Lia.matrix[Jsym][J][B] * FJB.matrix[Isym][I][A]); + } + } + + global_dpd_->buf4_mat_irrep_wrt(&newL2, h); + global_dpd_->buf4_mat_irrep_close(&newL2, h); + } + } + if (params.ref == 1 || params.ref == 2) { + global_dpd_->buf4_close(&newL2); + + global_dpd_->file2_mat_close(&FJB); + global_dpd_->file2_close(&FJB); + global_dpd_->file2_mat_close(&Fjb); + global_dpd_->file2_close(&Fjb); + global_dpd_->file2_mat_close(&LIA); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_mat_close(&Lia); + global_dpd_->file2_close(&Lia); } - } - - if(params.ref == 1 || params.ref == 2) { - global_dpd_->buf4_close(&newL2); - - global_dpd_->file2_mat_close(&FJB); - global_dpd_->file2_close(&FJB); - global_dpd_->file2_mat_close(&Fjb); - global_dpd_->file2_close(&Fjb); - global_dpd_->file2_mat_close(&LIA); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_mat_close(&Lia); - global_dpd_->file2_close(&Lia); - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/L2.cc b/psi4/src/psi4/cclambda/L2.cc index 227cd02053c..6aa435c6f36 100644 --- a/psi4/src/psi4/cclambda/L2.cc +++ b/psi4/src/psi4/cclambda/L2.cc @@ -38,7 +38,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* L2_build(): @@ -60,90 +61,90 @@ void dijabL2(int L_irr); void BL2_AO(int L_irr); void CCLambdaWavefunction::L2_build(struct L_Params L_params) { - dpdbuf4 L2; - int L_irr; - L_irr = L_params.irrep; + dpdbuf4 L2; + int L_irr; + L_irr = L_params.irrep; - DL2(L_params); - if(params.print & 2) status(" -> L2", "outfile"); + DL2(L_params); + if (params.print & 2) status(" -> L2", "outfile"); #ifdef EOM_DEBUG - check_sum("DL2", L_irr); + check_sum("DL2", L_irr); #endif - WijmnL2(L_irr); + WijmnL2(L_irr); #ifdef EOM_DEBUG - check_sum("WijmnL2", L_irr); + check_sum("WijmnL2", L_irr); #endif - if(params.print & 2) status("Wmnij -> L2", "outfile"); + if (params.print & 2) status("Wmnij -> L2", "outfile"); - WefabL2(L_irr); + WefabL2(L_irr); #ifdef EOM_DEBUG - check_sum("WefabL2", L_irr); + check_sum("WefabL2", L_irr); #endif - if(params.print & 2) status("Wabef -> L2", "outfile"); + if (params.print & 2) status("Wabef -> L2", "outfile"); - WejabL2(L_irr); + WejabL2(L_irr); #ifdef EOM_DEBUG - check_sum("WejabL2", L_irr); + check_sum("WejabL2", L_irr); #endif - if(params.print & 2) status("Wamef -> L2", "outfile"); + if (params.print & 2) status("Wamef -> L2", "outfile"); - WijmbL2(L_irr); + WijmbL2(L_irr); #ifdef EOM_DEBUG - check_sum("WijmbL2", L_irr); + check_sum("WijmbL2", L_irr); #endif - if(params.print & 2) status("Wmnie -> L2", "outfile"); + if (params.print & 2) status("Wmnie -> L2", "outfile"); - GaeL2(L_irr); + GaeL2(L_irr); #ifdef EOM_DEBUG - check_sum("GaeL2", L_irr); + check_sum("GaeL2", L_irr); #endif - GmiL2(L_irr); + GmiL2(L_irr); #ifdef EOM_DEBUG - check_sum("GmiL2", L_irr); + check_sum("GmiL2", L_irr); #endif - if(params.print & 2) status("G -> L2", "outfile"); - - /* For RHF-CCSD response calculations, save all the above - contributions to the L2 residual for use in the ccresponse code - (specifically, HX1Y1 and LHX1Y1). */ - if(params.ref == 0 && params.dertype == 3) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, "LHX1Y1 Residual I"); - global_dpd_->buf4_close(&L2); - } - - FaeL2(L_irr); + if (params.print & 2) status("G -> L2", "outfile"); + + /* For RHF-CCSD response calculations, save all the above + contributions to the L2 residual for use in the ccresponse code + (specifically, HX1Y1 and LHX1Y1). */ + if (params.ref == 0 && params.dertype == 3) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, "LHX1Y1 Residual I"); + global_dpd_->buf4_close(&L2); + } + + FaeL2(L_irr); #ifdef EOM_DEBUG - check_sum("FaeL2", L_irr); + check_sum("FaeL2", L_irr); #endif - FmiL2(L_irr); + FmiL2(L_irr); #ifdef EOM_DEBUG - check_sum("FmiL2", L_irr); + check_sum("FmiL2", L_irr); #endif - if(params.print & 2) status("F -> L2", "outfile"); + if (params.print & 2) status("F -> L2", "outfile"); - WmbejL2(L_irr); + WmbejL2(L_irr); #ifdef EOM_DEBUG - check_sum("WmbejL2", L_irr); + check_sum("WmbejL2", L_irr); #endif - if(params.print & 2) status("Wmbej -> L2", "outfile"); + if (params.print & 2) status("Wmbej -> L2", "outfile"); - if(!params.sekino) L1FL2(L_irr); /* should be dropped for Sekino-Bartlett modelIII approach */ + if (!params.sekino) L1FL2(L_irr); /* should be dropped for Sekino-Bartlett modelIII approach */ #ifdef EOM_DEBUG - check_sum("L1FL2", L_irr); + check_sum("L1FL2", L_irr); #endif - if(params.print & 2) status("L1*F -> L2", "outfile"); + if (params.print & 2) status("L1*F -> L2", "outfile"); - dijabL2(L_irr); + dijabL2(L_irr); #ifdef EOM_DEBUG - check_sum("after D2s", L_irr); + check_sum("after D2s", L_irr); #endif - if(params.print & 2) status("L2 amplitudes", "outfile"); + if (params.print & 2) status("L2 amplitudes", "outfile"); } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/L3_AAA.cc b/psi4/src/psi4/cclambda/L3_AAA.cc index e01a3f729b4..842f57b8a4e 100644 --- a/psi4/src/psi4/cclambda/L3_AAA.cc +++ b/psi4/src/psi4/cclambda/L3_AAA.cc @@ -91,628 +91,622 @@ #include "psi4/libqt/qt.h" #include "psi4/psifiles.h" -namespace psi { namespace cclambda { - -void L3_AAA(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, - dpdbuf4 *T2, dpdbuf4 *F, dpdbuf4 *E, dpdfile2 *fIJ, dpdfile2 *fAB, - dpdbuf4 *D, dpdbuf4 *LIJAB, dpdfile2 *LIA, dpdfile2 *FME, - int *occpi, int *occ_off, int *virtpi, int *vir_off) -{ - int h; - int i, j, k; - int Ga, Gb, Gc; - int Gij, Gji, Gik, Gki, Gjk, Gkj, Gijk; - int Gab, Gba, Gbc, Gcb, Gac, Gca; - int Gd, Gl; - int Gid, Gjd, Gkd; - int Gla, Glb, Glc; - int Gil, Gjl, Gkl; - int a, b, c, A, B, C; - int ij, ji, ik, ki, jk, kj; - int ab, ba, ac, ca, bc, cb; - int cd, bd, ad; - int id, jd, kd; - int la, lb, lc; - int il, jl, kl; - int nrows, ncols, nlinks; - double dijk, denom; - double ***W2; - double L1, F1, D2, L2; - - global_dpd_->file2_mat_init(fIJ); - global_dpd_->file2_mat_init(fAB); - global_dpd_->file2_mat_rd(fIJ); - global_dpd_->file2_mat_rd(fAB); - - global_dpd_->file2_mat_init(LIA); - global_dpd_->file2_mat_rd(LIA); - global_dpd_->file2_mat_init(FME); - global_dpd_->file2_mat_rd(FME); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(T2, h); - global_dpd_->buf4_mat_irrep_rd(T2, h); - - global_dpd_->buf4_mat_irrep_init(E, h); - global_dpd_->buf4_mat_irrep_rd(E, h); - - global_dpd_->buf4_mat_irrep_init(LIJAB, h); - global_dpd_->buf4_mat_irrep_rd(LIJAB, h); - - global_dpd_->buf4_mat_irrep_init(D, h); - global_dpd_->buf4_mat_irrep_rd(D, h); - } - - i = I - occ_off[Gi]; - j = J - occ_off[Gj]; - k = K - occ_off[Gk]; - - Gij = Gji = Gi ^ Gj; - Gik = Gki = Gi ^ Gk; - Gjk = Gkj = Gj ^ Gk; - Gijk = Gi ^ Gj ^ Gk; - - ij = T2->params->rowidx[I][J]; - ji = T2->params->rowidx[J][I]; - jk = T2->params->rowidx[J][K]; - kj = T2->params->rowidx[K][J]; - ik = T2->params->rowidx[I][K]; - ki = T2->params->rowidx[K][I]; - - dijk = 0.0; - if(fIJ->params->rowtot[Gi]) dijk += fIJ->matrix[Gi][i][i]; - if(fIJ->params->rowtot[Gj]) dijk += fIJ->matrix[Gj][j][j]; - if(fIJ->params->rowtot[Gk]) dijk += fIJ->matrix[Gk][k][k]; - - W2 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - - W2[Gab] = global_dpd_->dpd_block_matrix(F->params->coltot[Gab], virtpi[Gc]); - - if(F->params->coltot[Gab] && virtpi[Gc]) { - memset(W1[Gab][0], 0, F->params->coltot[Gab]*virtpi[Gc]*sizeof(double)); +namespace psi { +namespace cclambda { + +void L3_AAA(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, dpdbuf4 *T2, dpdbuf4 *F, dpdbuf4 *E, + dpdfile2 *fIJ, dpdfile2 *fAB, dpdbuf4 *D, dpdbuf4 *LIJAB, dpdfile2 *LIA, dpdfile2 *FME, int *occpi, + int *occ_off, int *virtpi, int *vir_off) { + int h; + int i, j, k; + int Ga, Gb, Gc; + int Gij, Gji, Gik, Gki, Gjk, Gkj, Gijk; + int Gab, Gba, Gbc, Gcb, Gac, Gca; + int Gd, Gl; + int Gid, Gjd, Gkd; + int Gla, Glb, Glc; + int Gil, Gjl, Gkl; + int a, b, c, A, B, C; + int ij, ji, ik, ki, jk, kj; + int ab, ba, ac, ca, bc, cb; + int cd, bd, ad; + int id, jd, kd; + int la, lb, lc; + int il, jl, kl; + int nrows, ncols, nlinks; + double dijk, denom; + double ***W2; + double L1, F1, D2, L2; + + global_dpd_->file2_mat_init(fIJ); + global_dpd_->file2_mat_init(fAB); + global_dpd_->file2_mat_rd(fIJ); + global_dpd_->file2_mat_rd(fAB); + + global_dpd_->file2_mat_init(LIA); + global_dpd_->file2_mat_rd(LIA); + global_dpd_->file2_mat_init(FME); + global_dpd_->file2_mat_rd(FME); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(T2, h); + global_dpd_->buf4_mat_irrep_rd(T2, h); + + global_dpd_->buf4_mat_irrep_init(E, h); + global_dpd_->buf4_mat_irrep_rd(E, h); + + global_dpd_->buf4_mat_irrep_init(LIJAB, h); + global_dpd_->buf4_mat_irrep_rd(LIJAB, h); + + global_dpd_->buf4_mat_irrep_init(D, h); + global_dpd_->buf4_mat_irrep_rd(D, h); } - } - for(Gd=0; Gd < nirreps; Gd++) { + i = I - occ_off[Gi]; + j = J - occ_off[Gj]; + k = K - occ_off[Gk]; - /* +t_kjcd * F_idab */ - Gab = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Gc = Gjk ^ Gd; /* assumes totally symmetric! */ + Gij = Gji = Gi ^ Gj; + Gik = Gki = Gi ^ Gk; + Gjk = Gkj = Gj ^ Gk; + Gijk = Gi ^ Gj ^ Gk; - cd = T2->col_offset[Gjk][Gc]; - id = F->row_offset[Gid][I]; + ij = T2->params->rowidx[I][J]; + ji = T2->params->rowidx[J][I]; + jk = T2->params->rowidx[J][K]; + kj = T2->params->rowidx[K][J]; + ik = T2->params->rowidx[I][K]; + ki = T2->params->rowidx[K][I]; - F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); + dijk = 0.0; + if (fIJ->params->rowtot[Gi]) dijk += fIJ->matrix[Gi][i][i]; + if (fIJ->params->rowtot[Gj]) dijk += fIJ->matrix[Gj][j][j]; + if (fIJ->params->rowtot[Gk]) dijk += fIJ->matrix[Gk][k][k]; - nrows = F->params->coltot[Gid]; - ncols = virtpi[Gc]; - nlinks = virtpi[Gd]; + W2 = (double ***)malloc(nirreps * sizeof(double **)); - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, F->matrix[Gid][0], nrows, - &(T2->matrix[Gjk][kj][cd]), nlinks, 1.0, W1[Gab][0], ncols); + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); + W2[Gab] = global_dpd_->dpd_block_matrix(F->params->coltot[Gab], virtpi[Gc]); - /* +t_ikcd * F_jdab */ - Gab = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Gc = Gik ^ Gd; /* assumes totally symmetric! */ + if (F->params->coltot[Gab] && virtpi[Gc]) { + memset(W1[Gab][0], 0, F->params->coltot[Gab] * virtpi[Gc] * sizeof(double)); + } + } + + for (Gd = 0; Gd < nirreps; Gd++) { + /* +t_kjcd * F_idab */ + Gab = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Gc = Gjk ^ Gd; /* assumes totally symmetric! */ + + cd = T2->col_offset[Gjk][Gc]; + id = F->row_offset[Gid][I]; + + F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); + + nrows = F->params->coltot[Gid]; + ncols = virtpi[Gc]; + nlinks = virtpi[Gd]; - cd = T2->col_offset[Gik][Gc]; - jd = F->row_offset[Gjd][J]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, F->matrix[Gid][0], nrows, &(T2->matrix[Gjk][kj][cd]), nlinks, + 1.0, W1[Gab][0], ncols); - F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); + global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); - nrows = F->params->coltot[Gjd]; - ncols = virtpi[Gc]; - nlinks = virtpi[Gd]; + /* +t_ikcd * F_jdab */ + Gab = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Gc = Gik ^ Gd; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, F->matrix[Gjd][0], nrows, - &(T2->matrix[Gik][ik][cd]), nlinks, 1.0, W1[Gab][0], ncols); + cd = T2->col_offset[Gik][Gc]; + jd = F->row_offset[Gjd][J]; - global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); + F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); - /* -t_ijcd * F_kdab */ - Gab = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ - Gc = Gij ^ Gd; /* assumes totally symmetric! */ + nrows = F->params->coltot[Gjd]; + ncols = virtpi[Gc]; + nlinks = virtpi[Gd]; - cd = T2->col_offset[Gij][Gc]; - kd = F->row_offset[Gkd][K]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, F->matrix[Gjd][0], nrows, &(T2->matrix[Gik][ik][cd]), nlinks, + 1.0, W1[Gab][0], ncols); - F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); + global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); - nrows = F->params->coltot[Gkd]; - ncols = virtpi[Gc]; - nlinks = virtpi[Gd]; + /* -t_ijcd * F_kdab */ + Gab = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ + Gc = Gij ^ Gd; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, F->matrix[Gkd][0], nrows, - &(T2->matrix[Gij][ij][cd]), nlinks, 1.0, W1[Gab][0], ncols); + cd = T2->col_offset[Gij][Gc]; + kd = F->row_offset[Gkd][K]; - global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); + F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); - } + nrows = F->params->coltot[Gkd]; + ncols = virtpi[Gc]; + nlinks = virtpi[Gd]; - for(Gl=0; Gl < nirreps; Gl++) { + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, F->matrix[Gkd][0], nrows, &(T2->matrix[Gij][ij][cd]), nlinks, + 1.0, W1[Gab][0], ncols); - /* -t_ilab * E_jklc */ - Gab = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Gc = Gjk ^ Gl; /* assumes totally symmetric! */ + global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); + } - lc = E->col_offset[Gjk][Gl]; - il = T2->row_offset[Gil][I]; + for (Gl = 0; Gl < nirreps; Gl++) { + /* -t_ilab * E_jklc */ + Gab = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Gc = Gjk ^ Gl; /* assumes totally symmetric! */ - nrows = T2->params->coltot[Gil]; - ncols = virtpi[Gc]; - nlinks = occpi[Gl]; + lc = E->col_offset[Gjk][Gl]; + il = T2->row_offset[Gil][I]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gil][il], nrows, - &(E->matrix[Gjk][jk][lc]), ncols, 1.0, W1[Gab][0], ncols); + nrows = T2->params->coltot[Gil]; + ncols = virtpi[Gc]; + nlinks = occpi[Gl]; - /* +t_jlab * E_iklc */ - Gab = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Gc = Gik ^ Gl; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gil][il], nrows, &(E->matrix[Gjk][jk][lc]), ncols, + 1.0, W1[Gab][0], ncols); - lc = E->col_offset[Gik][Gl]; - jl = T2->row_offset[Gjl][J]; + /* +t_jlab * E_iklc */ + Gab = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Gc = Gik ^ Gl; /* assumes totally symmetric! */ - nrows = T2->params->coltot[Gjl]; - ncols = virtpi[Gc]; - nlinks = occpi[Gl]; + lc = E->col_offset[Gik][Gl]; + jl = T2->row_offset[Gjl][J]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gjl][jl], nrows, - &(E->matrix[Gik][ik][lc]), ncols, 1.0, W1[Gab][0], ncols); + nrows = T2->params->coltot[Gjl]; + ncols = virtpi[Gc]; + nlinks = occpi[Gl]; - /* +t_klab * E_jilc */ - Gab = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ - Gc = Gji ^ Gl; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gjl][jl], nrows, &(E->matrix[Gik][ik][lc]), ncols, + 1.0, W1[Gab][0], ncols); - lc = E->col_offset[Gji][Gl]; - kl = T2->row_offset[Gkl][K]; + /* +t_klab * E_jilc */ + Gab = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ + Gc = Gji ^ Gl; /* assumes totally symmetric! */ - nrows = T2->params->coltot[Gkl]; - ncols = virtpi[Gc]; - nlinks = occpi[Gl]; + lc = E->col_offset[Gji][Gl]; + kl = T2->row_offset[Gkl][K]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gkl][kl], nrows, - &(E->matrix[Gji][ji][lc]), ncols, 1.0, W1[Gab][0], ncols); + nrows = T2->params->coltot[Gkl]; + ncols = virtpi[Gc]; + nlinks = occpi[Gl]; - } + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gkl][kl], nrows, &(E->matrix[Gji][ji][lc]), ncols, + 1.0, W1[Gab][0], ncols); + } - for(Gd=0; Gd < nirreps; Gd++) { - /* +t_kjbd * F_idca */ - Gca = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Gb = Gjk ^ Gd; /* assumes totally symmetric! */ + for (Gd = 0; Gd < nirreps; Gd++) { + /* +t_kjbd * F_idca */ + Gca = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Gb = Gjk ^ Gd; /* assumes totally symmetric! */ - bd = T2->col_offset[Gjk][Gb]; - id = F->row_offset[Gid][I]; + bd = T2->col_offset[Gjk][Gb]; + id = F->row_offset[Gid][I]; - F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); + F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); - nrows = F->params->coltot[Gid]; - ncols = virtpi[Gb]; - nlinks = virtpi[Gd]; + nrows = F->params->coltot[Gid]; + ncols = virtpi[Gb]; + nlinks = virtpi[Gd]; - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, F->matrix[Gid][0], nrows, - &(T2->matrix[Gjk][kj][bd]), nlinks, 1.0, W2[Gca][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, F->matrix[Gid][0], nrows, &(T2->matrix[Gjk][kj][bd]), nlinks, + 1.0, W2[Gca][0], ncols); - global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); + global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); - /* +t_ikbd * F_jdca */ - Gca = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Gb = Gik ^ Gd; /* assumes totally symmetric! */ + /* +t_ikbd * F_jdca */ + Gca = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Gb = Gik ^ Gd; /* assumes totally symmetric! */ - bd = T2->col_offset[Gik][Gb]; - jd = F->row_offset[Gjd][J]; + bd = T2->col_offset[Gik][Gb]; + jd = F->row_offset[Gjd][J]; - F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); + F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); - nrows = F->params->coltot[Gjd]; - ncols = virtpi[Gb]; - nlinks = virtpi[Gd]; + nrows = F->params->coltot[Gjd]; + ncols = virtpi[Gb]; + nlinks = virtpi[Gd]; - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, F->matrix[Gjd][0], nrows, - &(T2->matrix[Gik][ik][bd]), nlinks, 1.0, W2[Gca][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, F->matrix[Gjd][0], nrows, &(T2->matrix[Gik][ik][bd]), nlinks, + 1.0, W2[Gca][0], ncols); - global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); + global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); - /* -t_ijbd * F_kdca */ - Gca = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ - Gb = Gij ^ Gd; /* assumes totally symmetric! */ + /* -t_ijbd * F_kdca */ + Gca = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ + Gb = Gij ^ Gd; /* assumes totally symmetric! */ - bd = T2->col_offset[Gij][Gb]; - kd = F->row_offset[Gkd][K]; + bd = T2->col_offset[Gij][Gb]; + kd = F->row_offset[Gkd][K]; - F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); + F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); - nrows = F->params->coltot[Gkd]; - ncols = virtpi[Gb]; - nlinks = virtpi[Gd]; + nrows = F->params->coltot[Gkd]; + ncols = virtpi[Gb]; + nlinks = virtpi[Gd]; - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, -1.0, F->matrix[Gkd][0], nrows, - &(T2->matrix[Gij][ij][bd]), nlinks, 1.0, W2[Gca][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, F->matrix[Gkd][0], nrows, &(T2->matrix[Gij][ij][bd]), nlinks, + 1.0, W2[Gca][0], ncols); - global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); - } + global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); + } - for(Gl=0; Gl < nirreps; Gl++) { - /* -t_ilca * E_jklb */ - Gca = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Gb = Gjk ^ Gl; /* assumes totally symmetric! */ + for (Gl = 0; Gl < nirreps; Gl++) { + /* -t_ilca * E_jklb */ + Gca = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Gb = Gjk ^ Gl; /* assumes totally symmetric! */ - lb = E->col_offset[Gjk][Gl]; - il = T2->row_offset[Gil][I]; + lb = E->col_offset[Gjk][Gl]; + il = T2->row_offset[Gil][I]; - nrows = T2->params->coltot[Gil]; - ncols = virtpi[Gb]; - nlinks = occpi[Gl]; + nrows = T2->params->coltot[Gil]; + ncols = virtpi[Gb]; + nlinks = occpi[Gl]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gil][il], nrows, - &(E->matrix[Gjk][jk][lb]), ncols, 1.0, W2[Gca][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gil][il], nrows, &(E->matrix[Gjk][jk][lb]), ncols, + 1.0, W2[Gca][0], ncols); - /* +t_jlca * E_iklb */ - Gca = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Gb = Gik ^ Gl; /* assumes totally symmetric! */ + /* +t_jlca * E_iklb */ + Gca = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Gb = Gik ^ Gl; /* assumes totally symmetric! */ - lb = E->col_offset[Gik][Gl]; - jl = T2->row_offset[Gjl][J]; + lb = E->col_offset[Gik][Gl]; + jl = T2->row_offset[Gjl][J]; - nrows = T2->params->coltot[Gjl]; - ncols = virtpi[Gb]; - nlinks = occpi[Gl]; + nrows = T2->params->coltot[Gjl]; + ncols = virtpi[Gb]; + nlinks = occpi[Gl]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gjl][jl], nrows, - &(E->matrix[Gik][ik][lb]), ncols, 1.0, W2[Gca][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gjl][jl], nrows, &(E->matrix[Gik][ik][lb]), ncols, + 1.0, W2[Gca][0], ncols); - /* +t_klca * E_jilb */ - Gca = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ - Gb = Gji ^ Gl; /* assumes totally symmetric! */ + /* +t_klca * E_jilb */ + Gca = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ + Gb = Gji ^ Gl; /* assumes totally symmetric! */ - lb = E->col_offset[Gji][Gl]; - kl = T2->row_offset[Gkl][K]; + lb = E->col_offset[Gji][Gl]; + kl = T2->row_offset[Gkl][K]; - nrows = T2->params->coltot[Gkl]; - ncols = virtpi[Gb]; - nlinks = occpi[Gl]; + nrows = T2->params->coltot[Gkl]; + ncols = virtpi[Gb]; + nlinks = occpi[Gl]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gkl][kl], nrows, - &(E->matrix[Gji][ji][lb]), ncols, 1.0, W2[Gca][0], ncols); - } + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gkl][kl], nrows, &(E->matrix[Gji][ji][lb]), ncols, + 1.0, W2[Gca][0], ncols); + } - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, F->params->coltot, F->params->colidx, - F->params->colorb, F->params->rsym, F->params->ssym, vir_off, - vir_off, virtpi, vir_off, F->params->colidx, bca, 1); + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, F->params->coltot, F->params->colidx, F->params->colorb, + F->params->rsym, F->params->ssym, vir_off, vir_off, virtpi, vir_off, F->params->colidx, bca, + 1); - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - if(F->params->coltot[Gab] && virtpi[Gc]) { - memset(W2[Gab][0], 0, F->params->coltot[Gab]*virtpi[Gc]*sizeof(double)); + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + if (F->params->coltot[Gab] && virtpi[Gc]) { + memset(W2[Gab][0], 0, F->params->coltot[Gab] * virtpi[Gc] * sizeof(double)); + } } - } - for(Gd=0; Gd < nirreps; Gd++) { - /* -t_kjad * F_idcb */ - Gcb = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Ga = Gkj ^ Gd; /* assumes totally symmetric! */ + for (Gd = 0; Gd < nirreps; Gd++) { + /* -t_kjad * F_idcb */ + Gcb = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Ga = Gkj ^ Gd; /* assumes totally symmetric! */ + + ad = T2->col_offset[Gkj][Ga]; + id = F->row_offset[Gid][I]; - ad = T2->col_offset[Gkj][Ga]; - id = F->row_offset[Gid][I]; + F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); - F->matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gid, id, virtpi[Gd]); + nrows = F->params->coltot[Gid]; + ncols = virtpi[Ga]; + nlinks = virtpi[Gd]; - nrows = F->params->coltot[Gid]; - ncols = virtpi[Ga]; - nlinks = virtpi[Gd]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, F->matrix[Gid][0], nrows, &(T2->matrix[Gkj][kj][ad]), nlinks, + 1.0, W2[Gcb][0], ncols); - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, -1.0, F->matrix[Gid][0], nrows, - &(T2->matrix[Gkj][kj][ad]), nlinks, 1.0, W2[Gcb][0], ncols); + global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); - global_dpd_->free_dpd_block(F->matrix[Gid], virtpi[Gd], F->params->coltot[Gid]); + /* -t_ikad * F_jdcb */ + Gcb = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Ga = Gik ^ Gd; /* assumes totally symmetric! */ - /* -t_ikad * F_jdcb */ - Gcb = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Ga = Gik ^ Gd; /* assumes totally symmetric! */ + ad = T2->col_offset[Gik][Ga]; + jd = F->row_offset[Gjd][J]; - ad = T2->col_offset[Gik][Ga]; - jd = F->row_offset[Gjd][J]; + F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); - F->matrix[Gjd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gjd, jd, virtpi[Gd]); + nrows = F->params->coltot[Gjd]; + ncols = virtpi[Ga]; + nlinks = virtpi[Gd]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, F->matrix[Gjd][0], nrows, &(T2->matrix[Gik][ik][ad]), nlinks, + 1.0, W2[Gcb][0], ncols); + + global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); + + /* +t_ijad * F_kdcb */ + Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ + Ga = Gij ^ Gd; /* assumes totally symmetric! */ + + ad = T2->col_offset[Gij][Ga]; + kd = F->row_offset[Gkd][K]; + + F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); + + nrows = F->params->coltot[Gkd]; + ncols = virtpi[Ga]; + nlinks = virtpi[Gd]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, F->matrix[Gkd][0], nrows, &(T2->matrix[Gij][ij][ad]), nlinks, + 1.0, W2[Gcb][0], ncols); + + global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); + } - nrows = F->params->coltot[Gjd]; - ncols = virtpi[Ga]; - nlinks = virtpi[Gd]; + for (Gl = 0; Gl < nirreps; Gl++) { + /* +t_ilcb * E_jkla */ + Gcb = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Ga = Gjk ^ Gl; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, -1.0, F->matrix[Gjd][0], nrows, - &(T2->matrix[Gik][ik][ad]), nlinks, 1.0, W2[Gcb][0], ncols); + la = E->col_offset[Gjk][Gl]; + il = T2->row_offset[Gil][I]; - global_dpd_->free_dpd_block(F->matrix[Gjd], virtpi[Gd], F->params->coltot[Gjd]); + nrows = T2->params->coltot[Gil]; + ncols = virtpi[Ga]; + nlinks = occpi[Gl]; - /* +t_ijad * F_kdcb */ - Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ - Ga = Gij ^ Gd; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gil][il], nrows, &(E->matrix[Gjk][jk][la]), ncols, + 1.0, W2[Gcb][0], ncols); - ad = T2->col_offset[Gij][Ga]; - kd = F->row_offset[Gkd][K]; + /* -t_jlcb * E_ikla */ + Gcb = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Ga = Gik ^ Gl; /* assumes totally symmetric! */ + + la = E->col_offset[Gik][Gl]; + jl = T2->row_offset[Gjl][J]; + + nrows = T2->params->coltot[Gjl]; + ncols = virtpi[Ga]; + nlinks = occpi[Gl]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gjl][jl], nrows, &(E->matrix[Gik][ik][la]), ncols, + 1.0, W2[Gcb][0], ncols); + + /* -t_klcb * E_jila */ + Gcb = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ + Ga = Gji ^ Gl; /* assumes totally symmetric! */ + + la = E->col_offset[Gji][Gl]; + kl = T2->row_offset[Gkl][K]; + + nrows = T2->params->coltot[Gkl]; + ncols = virtpi[Ga]; + nlinks = occpi[Gl]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gkl][kl], nrows, &(E->matrix[Gji][ji][la]), ncols, + 1.0, W2[Gcb][0], ncols); + } + + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, F->params->coltot, F->params->colidx, F->params->colorb, + F->params->rsym, F->params->ssym, vir_off, vir_off, virtpi, vir_off, F->params->colidx, cba, + 1); + + /* Add disconnected terms */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + Gba = Gab; + for (ab = 0; ab < F->params->coltot[Gab]; ab++) { + A = F->params->colorb[Gab][ab][0]; + B = F->params->colorb[Gab][ab][1]; + Ga = F->params->rsym[A]; + Gb = F->params->ssym[B]; + a = A - vir_off[Ga]; + b = B - vir_off[Gb]; + + Gbc = Gcb = Gb ^ Gc; + Gac = Gca = Ga ^ Gc; + + ba = LIJAB->params->colidx[B][A]; + + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + + bc = LIJAB->params->colidx[B][C]; + cb = LIJAB->params->colidx[C][B]; + ac = LIJAB->params->colidx[A][C]; + ca = LIJAB->params->colidx[C][A]; + + /* +L_ia * D_jkbc + F_ia * L_jkbc */ + if (Gi == Ga && Gjk == Gbc) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { + L1 = LIA->matrix[Gi][i][a]; + F1 = FME->matrix[Gi][i][a]; + } + if (D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { + D2 = D->matrix[Gjk][jk][bc]; + L2 = LIJAB->matrix[Gjk][jk][bc]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + /* -L_ib * D_jkac - F_ib * L_jkac */ + if (Gi == Gb && Gjk == Gac) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { + L1 = LIA->matrix[Gi][i][b]; + F1 = FME->matrix[Gi][i][b]; + } + if (D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { + D2 = D->matrix[Gjk][jk][ac]; + L2 = LIJAB->matrix[Gjk][jk][ac]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + /* -L_ic * D_jkba - F_ic * L_jkba */ + if (Gi == Gc && Gjk == Gba) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { + L1 = LIA->matrix[Gi][i][c]; + F1 = FME->matrix[Gi][i][c]; + } + if (D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { + D2 = D->matrix[Gjk][jk][ba]; + L2 = LIJAB->matrix[Gjk][jk][ba]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + /* -L_ja * D_ikbc - F_ja * L_ikbc */ + if (Gj == Ga && Gik == Gbc) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { + L1 = LIA->matrix[Gj][j][a]; + F1 = FME->matrix[Gj][j][a]; + } + if (D->params->rowtot[Gik] && D->params->coltot[Gik]) { + D2 = D->matrix[Gik][ik][bc]; + L2 = LIJAB->matrix[Gik][ik][bc]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + /* +L_jb * D_ikac + F_jb * L_ikac */ + if (Gj == Gb && Gik == Gac) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { + L1 = LIA->matrix[Gj][j][b]; + F1 = FME->matrix[Gj][j][b]; + } + if (D->params->rowtot[Gik] && D->params->coltot[Gik]) { + D2 = D->matrix[Gik][ik][ac]; + L2 = LIJAB->matrix[Gik][ik][ac]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + /* +L_jc * D_ikba + F_jc * L_ikba */ + if (Gj == Gc && Gik == Gba) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { + L1 = LIA->matrix[Gj][j][c]; + F1 = FME->matrix[Gj][j][c]; + } + if (D->params->rowtot[Gik] && D->params->coltot[Gik]) { + D2 = D->matrix[Gik][ik][ba]; + L2 = LIJAB->matrix[Gik][ik][ba]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + /* -L_ka * D_jibc - F_ka * L_jibc */ + if (Gk == Ga && Gji == Gbc) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { + L1 = LIA->matrix[Gk][k][a]; + F1 = FME->matrix[Gk][k][a]; + } + if (D->params->rowtot[Gji] && D->params->coltot[Gji]) { + D2 = D->matrix[Gji][ji][bc]; + L2 = LIJAB->matrix[Gji][ji][bc]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + /* +L_kb * D_jiac + F_kb * L_jiac */ + if (Gk == Gb && Gji == Gac) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { + L1 = LIA->matrix[Gk][k][b]; + F1 = FME->matrix[Gk][k][b]; + } + if (D->params->rowtot[Gji] && D->params->coltot[Gji]) { + D2 = D->matrix[Gji][ji][ac]; + L2 = LIJAB->matrix[Gji][ji][ac]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + /* +L_kc * D_jiba + F_kc * L_jiba */ + if (Gk == Gc && Gji == Gba) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { + L1 = LIA->matrix[Gk][k][c]; + F1 = FME->matrix[Gk][k][c]; + } + if (D->params->rowtot[Gji] && D->params->coltot[Gji]) { + D2 = D->matrix[Gji][ji][ba]; + L2 = LIJAB->matrix[Gji][ji][ba]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + } + } + } + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + + for (ab = 0; ab < F->params->coltot[Gab]; ab++) { + A = F->params->colorb[Gab][ab][0]; + B = F->params->colorb[Gab][ab][1]; + Ga = F->params->rsym[A]; + Gb = F->params->ssym[B]; + a = A - vir_off[Ga]; + b = B - vir_off[Gb]; + + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + + denom = dijk; + if (fAB->params->rowtot[Ga]) denom -= fAB->matrix[Ga][a][a]; + if (fAB->params->rowtot[Gb]) denom -= fAB->matrix[Gb][b][b]; + if (fAB->params->rowtot[Gc]) denom -= fAB->matrix[Gc][c][c]; + + W1[Gab][ab][c] /= denom; + + } /* c */ + } /* ab */ + } /* Gab */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + global_dpd_->free_dpd_block(W2[Gab], F->params->coltot[Gab], virtpi[Gc]); + } + free(W2); - F->matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], F->params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(F, Gkd, kd, virtpi[Gd]); + global_dpd_->file2_mat_close(fIJ); + global_dpd_->file2_mat_close(fAB); - nrows = F->params->coltot[Gkd]; - ncols = virtpi[Ga]; - nlinks = virtpi[Gd]; + global_dpd_->file2_mat_close(FME); + global_dpd_->file2_mat_close(LIA); - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, F->matrix[Gkd][0], nrows, - &(T2->matrix[Gij][ij][ad]), nlinks, 1.0, W2[Gcb][0], ncols); - - global_dpd_->free_dpd_block(F->matrix[Gkd], virtpi[Gd], F->params->coltot[Gkd]); - - } - - for(Gl=0; Gl < nirreps; Gl++) { - /* +t_ilcb * E_jkla */ - Gcb = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Ga = Gjk ^ Gl; /* assumes totally symmetric! */ - - la = E->col_offset[Gjk][Gl]; - il = T2->row_offset[Gil][I]; - - nrows = T2->params->coltot[Gil]; - ncols = virtpi[Ga]; - nlinks = occpi[Gl]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2->matrix[Gil][il], nrows, - &(E->matrix[Gjk][jk][la]), ncols, 1.0, W2[Gcb][0], ncols); - - /* -t_jlcb * E_ikla */ - Gcb = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Ga = Gik ^ Gl; /* assumes totally symmetric! */ - - la = E->col_offset[Gik][Gl]; - jl = T2->row_offset[Gjl][J]; - - nrows = T2->params->coltot[Gjl]; - ncols = virtpi[Ga]; - nlinks = occpi[Gl]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gjl][jl], nrows, - &(E->matrix[Gik][ik][la]), ncols, 1.0, W2[Gcb][0], ncols); - - /* -t_klcb * E_jila */ - Gcb = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ - Ga = Gji ^ Gl; /* assumes totally symmetric! */ - - la = E->col_offset[Gji][Gl]; - kl = T2->row_offset[Gkl][K]; - - nrows = T2->params->coltot[Gkl]; - ncols = virtpi[Ga]; - nlinks = occpi[Gl]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2->matrix[Gkl][kl], nrows, - &(E->matrix[Gji][ji][la]), ncols, 1.0, W2[Gcb][0], ncols); - - } - - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, F->params->coltot, F->params->colidx, - F->params->colorb, F->params->rsym, F->params->ssym, vir_off, - vir_off, virtpi, vir_off, F->params->colidx, cba, 1); - - /* Add disconnected terms */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - Gba = Gab; - for(ab=0; ab < F->params->coltot[Gab]; ab++) { - A = F->params->colorb[Gab][ab][0]; - B = F->params->colorb[Gab][ab][1]; - Ga = F->params->rsym[A]; - Gb = F->params->ssym[B]; - a = A - vir_off[Ga]; - b = B - vir_off[Gb]; - - Gbc = Gcb = Gb ^ Gc; - Gac = Gca = Ga ^ Gc; - - ba = LIJAB->params->colidx[B][A]; - - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - - bc = LIJAB->params->colidx[B][C]; - cb = LIJAB->params->colidx[C][B]; - ac = LIJAB->params->colidx[A][C]; - ca = LIJAB->params->colidx[C][A]; - - /* +L_ia * D_jkbc + F_ia * L_jkbc */ - if(Gi == Ga && Gjk == Gbc) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { - L1 = LIA->matrix[Gi][i][a]; - F1 = FME->matrix[Gi][i][a]; - } - if(D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { - D2 = D->matrix[Gjk][jk][bc]; - L2 = LIJAB->matrix[Gjk][jk][bc]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - /* -L_ib * D_jkac - F_ib * L_jkac */ - if(Gi == Gb && Gjk == Gac) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { - L1 = LIA->matrix[Gi][i][b]; - F1 = FME->matrix[Gi][i][b]; - } - if(D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { - D2 = D->matrix[Gjk][jk][ac]; - L2 = LIJAB->matrix[Gjk][jk][ac]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - /* -L_ic * D_jkba - F_ic * L_jkba */ - if(Gi == Gc && Gjk == Gba) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { - L1 = LIA->matrix[Gi][i][c]; - F1 = FME->matrix[Gi][i][c]; - } - if(D->params->rowtot[Gjk] && D->params->coltot[Gjk]) { - D2 = D->matrix[Gjk][jk][ba]; - L2 = LIJAB->matrix[Gjk][jk][ba]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - /* -L_ja * D_ikbc - F_ja * L_ikbc */ - if(Gj == Ga && Gik == Gbc) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { - L1 = LIA->matrix[Gj][j][a]; - F1 = FME->matrix[Gj][j][a]; - } - if(D->params->rowtot[Gik] && D->params->coltot[Gik]) { - D2 = D->matrix[Gik][ik][bc]; - L2 = LIJAB->matrix[Gik][ik][bc]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - /* +L_jb * D_ikac + F_jb * L_ikac */ - if(Gj == Gb && Gik == Gac) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { - L1 = LIA->matrix[Gj][j][b]; - F1 = FME->matrix[Gj][j][b]; - } - if(D->params->rowtot[Gik] && D->params->coltot[Gik]) { - D2 = D->matrix[Gik][ik][ac]; - L2 = LIJAB->matrix[Gik][ik][ac]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - /* +L_jc * D_ikba + F_jc * L_ikba */ - if(Gj == Gc && Gik == Gba) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { - L1 = LIA->matrix[Gj][j][c]; - F1 = FME->matrix[Gj][j][c]; - } - if(D->params->rowtot[Gik] && D->params->coltot[Gik]) { - D2 = D->matrix[Gik][ik][ba]; - L2 = LIJAB->matrix[Gik][ik][ba]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - /* -L_ka * D_jibc - F_ka * L_jibc */ - if(Gk == Ga && Gji == Gbc) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { - L1 = LIA->matrix[Gk][k][a]; - F1 = FME->matrix[Gk][k][a]; - } - if(D->params->rowtot[Gji] && D->params->coltot[Gji]) { - D2 = D->matrix[Gji][ji][bc]; - L2 = LIJAB->matrix[Gji][ji][bc]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - /* +L_kb * D_jiac + F_kb * L_jiac */ - if(Gk == Gb && Gji == Gac) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { - L1 = LIA->matrix[Gk][k][b]; - F1 = FME->matrix[Gk][k][b]; - } - if(D->params->rowtot[Gji] && D->params->coltot[Gji]) { - D2 = D->matrix[Gji][ji][ac]; - L2 = LIJAB->matrix[Gji][ji][ac]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - /* +L_kc * D_jiba + F_kc * L_jiba */ - if(Gk == Gc && Gji == Gba) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gk] && LIA->params->coltot[Gk]) { - L1 = LIA->matrix[Gk][k][c]; - F1 = FME->matrix[Gk][k][c]; - } - if(D->params->rowtot[Gji] && D->params->coltot[Gji]) { - D2 = D->matrix[Gji][ji][ba]; - L2 = LIJAB->matrix[Gji][ji][ba]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - } + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_close(T2, h); + global_dpd_->buf4_mat_irrep_close(E, h); + global_dpd_->buf4_mat_irrep_close(D, h); + global_dpd_->buf4_mat_irrep_close(LIJAB, h); } - } - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - - for(ab=0; ab < F->params->coltot[Gab]; ab++) { - A = F->params->colorb[Gab][ab][0]; - B = F->params->colorb[Gab][ab][1]; - Ga = F->params->rsym[A]; - Gb = F->params->ssym[B]; - a = A - vir_off[Ga]; - b = B - vir_off[Gb]; - - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - - denom = dijk; - if(fAB->params->rowtot[Ga]) denom -= fAB->matrix[Ga][a][a]; - if(fAB->params->rowtot[Gb]) denom -= fAB->matrix[Gb][b][b]; - if(fAB->params->rowtot[Gc]) denom -= fAB->matrix[Gc][c][c]; - - W1[Gab][ab][c] /= denom; - - } /* c */ - } /* ab */ - } /* Gab */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - global_dpd_->free_dpd_block(W2[Gab], F->params->coltot[Gab], virtpi[Gc]); - } - free(W2); - - global_dpd_->file2_mat_close(fIJ); - global_dpd_->file2_mat_close(fAB); - - global_dpd_->file2_mat_close(FME); - global_dpd_->file2_mat_close(LIA); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_close(T2, h); - global_dpd_->buf4_mat_irrep_close(E, h); - global_dpd_->buf4_mat_irrep_close(D, h); - global_dpd_->buf4_mat_irrep_close(LIJAB, h); - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/L3_AAB.cc b/psi4/src/psi4/cclambda/L3_AAB.cc index 92d23592c2f..7bd65ef42c4 100644 --- a/psi4/src/psi4/cclambda/L3_AAB.cc +++ b/psi4/src/psi4/cclambda/L3_AAB.cc @@ -91,629 +91,620 @@ #include "psi4/libqt/qt.h" #include "psi4/psifiles.h" -namespace psi { namespace cclambda { - -void L3_AAB(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, - dpdbuf4 *T2AA, dpdbuf4 *T2AB, dpdbuf4 *T2BA, dpdbuf4 *FAA, dpdbuf4 *FAB, dpdbuf4 *FBA, - dpdbuf4 *EAA, dpdbuf4 *EAB, dpdbuf4 *EBA, dpdfile2 *fIJ, dpdfile2 *fij, - dpdfile2 *fAB, dpdfile2 *fab, dpdbuf4 *DAA, dpdbuf4 *DAB, dpdbuf4 *LIJAB, dpdbuf4 *LIjAb, - dpdfile2 *LIA, dpdfile2 *Lia, dpdfile2 *FME, dpdfile2 *Fme, - int *aoccpi, int *aocc_off, int *boccpi, int *bocc_off, - int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off) -{ - int h; - int i, j, k; - int Ga, Gb, Gc; - int Gij, Gji, Gik, Gki, Gjk, Gkj, Gijk; - int Gab, Gba, Gbc, Gcb, Gac, Gca; - int Gd, Gl; - int Gid, Gjd, Gkd; - int Gla, Glb, Glc; - int Gil, Gjl, Gkl; - int a, b, c, A, B, C; - int ij, ji, ik, ki, jk, kj; - int ab, ba, ac, ca, bc, cb; - int dc, bd, ad; - int id, jd, kd; - int la, lb, lc; - int il, jl, kl; - int nrows, ncols, nlinks; - double dijk, denom; - double ***W2; - double L1, F1, D2, L2; - - global_dpd_->file2_mat_init(fIJ); - global_dpd_->file2_mat_init(fAB); - global_dpd_->file2_mat_rd(fIJ); - global_dpd_->file2_mat_rd(fAB); - global_dpd_->file2_mat_init(fij); - global_dpd_->file2_mat_init(fab); - global_dpd_->file2_mat_rd(fij); - global_dpd_->file2_mat_rd(fab); - - global_dpd_->file2_mat_init(FME); - global_dpd_->file2_mat_rd(FME); - global_dpd_->file2_mat_init(Fme); - global_dpd_->file2_mat_rd(Fme); - global_dpd_->file2_mat_init(LIA); - global_dpd_->file2_mat_rd(LIA); - global_dpd_->file2_mat_init(Lia); - global_dpd_->file2_mat_rd(Lia); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(T2AA, h); - global_dpd_->buf4_mat_irrep_rd(T2AA, h); - - global_dpd_->buf4_mat_irrep_init(T2AB, h); - global_dpd_->buf4_mat_irrep_rd(T2AB, h); - - global_dpd_->buf4_mat_irrep_init(T2BA, h); - global_dpd_->buf4_mat_irrep_rd(T2BA, h); - - global_dpd_->buf4_mat_irrep_init(EAA, h); - global_dpd_->buf4_mat_irrep_rd(EAA, h); - - global_dpd_->buf4_mat_irrep_init(EAB, h); - global_dpd_->buf4_mat_irrep_rd(EAB, h); - - global_dpd_->buf4_mat_irrep_init(EBA, h); - global_dpd_->buf4_mat_irrep_rd(EBA, h); - - global_dpd_->buf4_mat_irrep_init(DAA, h); - global_dpd_->buf4_mat_irrep_rd(DAA, h); - - global_dpd_->buf4_mat_irrep_init(DAB, h); - global_dpd_->buf4_mat_irrep_rd(DAB, h); - - global_dpd_->buf4_mat_irrep_init(LIJAB, h); - global_dpd_->buf4_mat_irrep_rd(LIJAB, h); - - global_dpd_->buf4_mat_irrep_init(LIjAb, h); - global_dpd_->buf4_mat_irrep_rd(LIjAb, h); - } - - i = I - aocc_off[Gi]; - j = J - aocc_off[Gj]; - k = K - bocc_off[Gk]; - - Gij = Gji = Gi ^ Gj; - Gik = Gki = Gi ^ Gk; - Gjk = Gkj = Gj ^ Gk; - Gijk = Gi ^ Gj ^ Gk; - - ij = T2AA->params->rowidx[I][J]; - ji = T2AA->params->rowidx[J][I]; - jk = T2AB->params->rowidx[J][K]; - kj = T2BA->params->rowidx[K][J]; - ik = T2AB->params->rowidx[I][K]; - ki = T2BA->params->rowidx[K][I]; - - dijk = 0.0; - if(fIJ->params->rowtot[Gi]) dijk += fIJ->matrix[Gi][i][i]; - if(fIJ->params->rowtot[Gj]) dijk += fIJ->matrix[Gj][j][j]; - if(fij->params->rowtot[Gk]) dijk += fij->matrix[Gk][k][k]; - - W2 = (double ***) malloc(nirreps * sizeof(double **)); /* alpha-beta-alpha */ - - /* clear out the old W1 */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - - if(FAA->params->coltot[Gab] && bvirtpi[Gc]) { - memset(W1[Gab][0], 0, FAA->params->coltot[Gab]*bvirtpi[Gc]*sizeof(double)); +namespace psi { +namespace cclambda { + +void L3_AAB(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, dpdbuf4 *T2AA, dpdbuf4 *T2AB, + dpdbuf4 *T2BA, dpdbuf4 *FAA, dpdbuf4 *FAB, dpdbuf4 *FBA, dpdbuf4 *EAA, dpdbuf4 *EAB, dpdbuf4 *EBA, + dpdfile2 *fIJ, dpdfile2 *fij, dpdfile2 *fAB, dpdfile2 *fab, dpdbuf4 *DAA, dpdbuf4 *DAB, dpdbuf4 *LIJAB, + dpdbuf4 *LIjAb, dpdfile2 *LIA, dpdfile2 *Lia, dpdfile2 *FME, dpdfile2 *Fme, int *aoccpi, int *aocc_off, + int *boccpi, int *bocc_off, int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off) { + int h; + int i, j, k; + int Ga, Gb, Gc; + int Gij, Gji, Gik, Gki, Gjk, Gkj, Gijk; + int Gab, Gba, Gbc, Gcb, Gac, Gca; + int Gd, Gl; + int Gid, Gjd, Gkd; + int Gla, Glb, Glc; + int Gil, Gjl, Gkl; + int a, b, c, A, B, C; + int ij, ji, ik, ki, jk, kj; + int ab, ba, ac, ca, bc, cb; + int dc, bd, ad; + int id, jd, kd; + int la, lb, lc; + int il, jl, kl; + int nrows, ncols, nlinks; + double dijk, denom; + double ***W2; + double L1, F1, D2, L2; + + global_dpd_->file2_mat_init(fIJ); + global_dpd_->file2_mat_init(fAB); + global_dpd_->file2_mat_rd(fIJ); + global_dpd_->file2_mat_rd(fAB); + global_dpd_->file2_mat_init(fij); + global_dpd_->file2_mat_init(fab); + global_dpd_->file2_mat_rd(fij); + global_dpd_->file2_mat_rd(fab); + + global_dpd_->file2_mat_init(FME); + global_dpd_->file2_mat_rd(FME); + global_dpd_->file2_mat_init(Fme); + global_dpd_->file2_mat_rd(Fme); + global_dpd_->file2_mat_init(LIA); + global_dpd_->file2_mat_rd(LIA); + global_dpd_->file2_mat_init(Lia); + global_dpd_->file2_mat_rd(Lia); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(T2AA, h); + global_dpd_->buf4_mat_irrep_rd(T2AA, h); + + global_dpd_->buf4_mat_irrep_init(T2AB, h); + global_dpd_->buf4_mat_irrep_rd(T2AB, h); + + global_dpd_->buf4_mat_irrep_init(T2BA, h); + global_dpd_->buf4_mat_irrep_rd(T2BA, h); + + global_dpd_->buf4_mat_irrep_init(EAA, h); + global_dpd_->buf4_mat_irrep_rd(EAA, h); + + global_dpd_->buf4_mat_irrep_init(EAB, h); + global_dpd_->buf4_mat_irrep_rd(EAB, h); + + global_dpd_->buf4_mat_irrep_init(EBA, h); + global_dpd_->buf4_mat_irrep_rd(EBA, h); + + global_dpd_->buf4_mat_irrep_init(DAA, h); + global_dpd_->buf4_mat_irrep_rd(DAA, h); + + global_dpd_->buf4_mat_irrep_init(DAB, h); + global_dpd_->buf4_mat_irrep_rd(DAB, h); + + global_dpd_->buf4_mat_irrep_init(LIJAB, h); + global_dpd_->buf4_mat_irrep_rd(LIJAB, h); + + global_dpd_->buf4_mat_irrep_init(LIjAb, h); + global_dpd_->buf4_mat_irrep_rd(LIjAb, h); } - } - for(Gd=0; Gd < nirreps; Gd++) { - /* +t_JkDc * F_IDAB */ - Gab = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Gc = Gjk ^ Gd; /* assumes totally symmetric! */ + i = I - aocc_off[Gi]; + j = J - aocc_off[Gj]; + k = K - bocc_off[Gk]; - dc = T2AB->col_offset[Gjk][Gd]; - id = FAA->row_offset[Gid][I]; + Gij = Gji = Gi ^ Gj; + Gik = Gki = Gi ^ Gk; + Gjk = Gkj = Gj ^ Gk; + Gijk = Gi ^ Gj ^ Gk; - FAA->matrix[Gid] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FAA->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(FAA, Gid, id, avirtpi[Gd]); + ij = T2AA->params->rowidx[I][J]; + ji = T2AA->params->rowidx[J][I]; + jk = T2AB->params->rowidx[J][K]; + kj = T2BA->params->rowidx[K][J]; + ik = T2AB->params->rowidx[I][K]; + ki = T2BA->params->rowidx[K][I]; - nrows = FAA->params->coltot[Gid]; - ncols = bvirtpi[Gc]; - nlinks = avirtpi[Gd]; + dijk = 0.0; + if (fIJ->params->rowtot[Gi]) dijk += fIJ->matrix[Gi][i][i]; + if (fIJ->params->rowtot[Gj]) dijk += fIJ->matrix[Gj][j][j]; + if (fij->params->rowtot[Gk]) dijk += fij->matrix[Gk][k][k]; - if(nrows && ncols && nlinks) - C_DGEMM('t','n',nrows, ncols, nlinks, 1.0, FAA->matrix[Gid][0], nrows, - &(T2AB->matrix[Gjk][jk][dc]), ncols, 1.0, W1[Gab][0], ncols); + W2 = (double ***)malloc(nirreps * sizeof(double **)); /* alpha-beta-alpha */ - global_dpd_->free_dpd_block(FAA->matrix[Gid], avirtpi[Gd], FAA->params->coltot[Gid]); + /* clear out the old W1 */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - /* -t_IkDc * F_JDAB */ - Gab = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Gc = Gik ^ Gd; /* assumes totally symmetric! */ + if (FAA->params->coltot[Gab] && bvirtpi[Gc]) { + memset(W1[Gab][0], 0, FAA->params->coltot[Gab] * bvirtpi[Gc] * sizeof(double)); + } + } + + for (Gd = 0; Gd < nirreps; Gd++) { + /* +t_JkDc * F_IDAB */ + Gab = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Gc = Gjk ^ Gd; /* assumes totally symmetric! */ - dc = T2AB->col_offset[Gik][Gd]; - jd = FAA->row_offset[Gjd][J]; + dc = T2AB->col_offset[Gjk][Gd]; + id = FAA->row_offset[Gid][I]; - FAA->matrix[Gjd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FAA->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(FAA, Gjd, jd, avirtpi[Gd]); + FAA->matrix[Gid] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FAA->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(FAA, Gid, id, avirtpi[Gd]); - nrows = FAA->params->coltot[Gjd]; - ncols = bvirtpi[Gc]; - nlinks = avirtpi[Gd]; + nrows = FAA->params->coltot[Gid]; + ncols = bvirtpi[Gc]; + nlinks = avirtpi[Gd]; - if(nrows && ncols && nlinks) - C_DGEMM('t','n',nrows, ncols, nlinks, -1.0, FAA->matrix[Gjd][0], nrows, - &(T2AB->matrix[Gik][ik][dc]), ncols, 1.0, W1[Gab][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, FAA->matrix[Gid][0], nrows, &(T2AB->matrix[Gjk][jk][dc]), + ncols, 1.0, W1[Gab][0], ncols); - global_dpd_->free_dpd_block(FAA->matrix[Gjd], avirtpi[Gd], FAA->params->coltot[Gjd]); - } - for(Gl=0; Gl < nirreps; Gl++) { + global_dpd_->free_dpd_block(FAA->matrix[Gid], avirtpi[Gd], FAA->params->coltot[Gid]); - /* -t_ILAB * E_JkLc */ - Gab = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Gc = Gjk ^ Gl; /* assumes totally symmetric! */ + /* -t_IkDc * F_JDAB */ + Gab = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Gc = Gik ^ Gd; /* assumes totally symmetric! */ - lc = EAB->col_offset[Gjk][Gl]; - il = T2AA->row_offset[Gil][I]; + dc = T2AB->col_offset[Gik][Gd]; + jd = FAA->row_offset[Gjd][J]; - nrows = T2AA->params->coltot[Gil]; - ncols = bvirtpi[Gc]; - nlinks = aoccpi[Gl]; + FAA->matrix[Gjd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FAA->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(FAA, Gjd, jd, avirtpi[Gd]); - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AA->matrix[Gil][il], nrows, - &(EAB->matrix[Gjk][jk][lc]), ncols, 1.0, W1[Gab][0], ncols); + nrows = FAA->params->coltot[Gjd]; + ncols = bvirtpi[Gc]; + nlinks = avirtpi[Gd]; - /* +t_JLAB * E_IkLc */ - Gab = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Gc = Gik ^ Gl; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, FAA->matrix[Gjd][0], nrows, &(T2AB->matrix[Gik][ik][dc]), + ncols, 1.0, W1[Gab][0], ncols); - lc = EAB->col_offset[Gik][Gl]; - jl = T2AA->row_offset[Gjl][J]; + global_dpd_->free_dpd_block(FAA->matrix[Gjd], avirtpi[Gd], FAA->params->coltot[Gjd]); + } + for (Gl = 0; Gl < nirreps; Gl++) { + /* -t_ILAB * E_JkLc */ + Gab = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Gc = Gjk ^ Gl; /* assumes totally symmetric! */ - nrows = T2AA->params->coltot[Gjl]; - ncols = bvirtpi[Gc]; - nlinks = aoccpi[Gl]; + lc = EAB->col_offset[Gjk][Gl]; + il = T2AA->row_offset[Gil][I]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AA->matrix[Gjl][jl], nrows, - &(EAB->matrix[Gik][ik][lc]), ncols, 1.0, W1[Gab][0], ncols); - } + nrows = T2AA->params->coltot[Gil]; + ncols = bvirtpi[Gc]; + nlinks = aoccpi[Gl]; - /* Open memory for an alpha-beta-alpha array */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AA->matrix[Gil][il], nrows, &(EAB->matrix[Gjk][jk][lc]), + ncols, 1.0, W1[Gab][0], ncols); - W2[Gab] = global_dpd_->dpd_block_matrix(FAB->params->coltot[Gab], avirtpi[Gc]); - } + /* +t_JLAB * E_IkLc */ + Gab = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Gc = Gik ^ Gl; /* assumes totally symmetric! */ - for(Gd=0; Gd < nirreps; Gd++) { - /* +t_JkBd * F_IdAc */ - Gac = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Gb = Gjk ^ Gd; /* assumes totally symmetric! */ + lc = EAB->col_offset[Gik][Gl]; + jl = T2AA->row_offset[Gjl][J]; - bd = T2AB->col_offset[Gjk][Gb]; - id = FAB->row_offset[Gid][I]; + nrows = T2AA->params->coltot[Gjl]; + ncols = bvirtpi[Gc]; + nlinks = aoccpi[Gl]; - FAB->matrix[Gid] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(FAB, Gid, id, bvirtpi[Gd]); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AA->matrix[Gjl][jl], nrows, &(EAB->matrix[Gik][ik][lc]), + ncols, 1.0, W1[Gab][0], ncols); + } + + /* Open memory for an alpha-beta-alpha array */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + + W2[Gab] = global_dpd_->dpd_block_matrix(FAB->params->coltot[Gab], avirtpi[Gc]); + } - nrows = FAB->params->coltot[Gid]; - ncols = avirtpi[Gb]; - nlinks = bvirtpi[Gd]; + for (Gd = 0; Gd < nirreps; Gd++) { + /* +t_JkBd * F_IdAc */ + Gac = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Gb = Gjk ^ Gd; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, FAB->matrix[Gid][0], nrows, - &(T2AB->matrix[Gjk][jk][bd]), nlinks, 1.0, W2[Gac][0], ncols); + bd = T2AB->col_offset[Gjk][Gb]; + id = FAB->row_offset[Gid][I]; - global_dpd_->free_dpd_block(FAB->matrix[Gid], bvirtpi[Gd], FAB->params->coltot[Gid]); + FAB->matrix[Gid] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(FAB, Gid, id, bvirtpi[Gd]); - /* -t_IkBd * F_JdAc */ - Gac = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Gb = Gik ^ Gd; /* assumes totally symmetric! */ + nrows = FAB->params->coltot[Gid]; + ncols = avirtpi[Gb]; + nlinks = bvirtpi[Gd]; - bd = T2AB->col_offset[Gik][Gb]; - jd = FAB->row_offset[Gjd][J]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, FAB->matrix[Gid][0], nrows, &(T2AB->matrix[Gjk][jk][bd]), + nlinks, 1.0, W2[Gac][0], ncols); - FAB->matrix[Gjd] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(FAB, Gjd, jd, bvirtpi[Gd]); + global_dpd_->free_dpd_block(FAB->matrix[Gid], bvirtpi[Gd], FAB->params->coltot[Gid]); - nrows = FAB->params->coltot[Gjd]; - ncols = avirtpi[Gb]; - nlinks = bvirtpi[Gd]; + /* -t_IkBd * F_JdAc */ + Gac = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Gb = Gik ^ Gd; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, -1.0, FAB->matrix[Gjd][0], nrows, - &(T2AB->matrix[Gik][ik][bd]), nlinks, 1.0, W2[Gac][0], ncols); + bd = T2AB->col_offset[Gik][Gb]; + jd = FAB->row_offset[Gjd][J]; - global_dpd_->free_dpd_block(FAB->matrix[Gjd], bvirtpi[Gd], FAB->params->coltot[Gjd]); + FAB->matrix[Gjd] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(FAB, Gjd, jd, bvirtpi[Gd]); - } + nrows = FAB->params->coltot[Gjd]; + ncols = avirtpi[Gb]; + nlinks = bvirtpi[Gd]; - for(Gl=0; Gl < nirreps; Gl++) { - /* -t_IlAc * E_kJlB */ - Gac = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Gb = Gkj ^ Gl; /* assumes totally symmetric! */ + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, FAB->matrix[Gjd][0], nrows, &(T2AB->matrix[Gik][ik][bd]), + nlinks, 1.0, W2[Gac][0], ncols); - lb = EBA->col_offset[Gkj][Gl]; - il = T2AB->row_offset[Gil][I]; + global_dpd_->free_dpd_block(FAB->matrix[Gjd], bvirtpi[Gd], FAB->params->coltot[Gjd]); + } - nrows = T2AB->params->coltot[Gil]; - ncols = avirtpi[Gb]; - nlinks = boccpi[Gl]; + for (Gl = 0; Gl < nirreps; Gl++) { + /* -t_IlAc * E_kJlB */ + Gac = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Gb = Gkj ^ Gl; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AB->matrix[Gil][il], nrows, - &(EBA->matrix[Gkj][kj][lb]), ncols, 1.0, W2[Gac][0], ncols); + lb = EBA->col_offset[Gkj][Gl]; + il = T2AB->row_offset[Gil][I]; - /* +t_JlAc * E_kIlB */ - Gac = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Gb = Gki ^ Gl; /* assumes totally symmetric! */ + nrows = T2AB->params->coltot[Gil]; + ncols = avirtpi[Gb]; + nlinks = boccpi[Gl]; - lb = EBA->col_offset[Gki][Gl]; - jl = T2AB->row_offset[Gjl][J]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AB->matrix[Gil][il], nrows, &(EBA->matrix[Gkj][kj][lb]), + ncols, 1.0, W2[Gac][0], ncols); - nrows = T2AB->params->coltot[Gjl]; - ncols = avirtpi[Gb]; - nlinks = boccpi[Gl]; + /* +t_JlAc * E_kIlB */ + Gac = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Gb = Gki ^ Gl; /* assumes totally symmetric! */ - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AB->matrix[Gjl][jl], nrows, - &(EBA->matrix[Gki][ki][lb]), ncols, 1.0, W2[Gac][0], ncols); - } + lb = EBA->col_offset[Gki][Gl]; + jl = T2AB->row_offset[Gjl][J]; - /* W(Ac,B) --> W(AB,c) */ - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FAB->params->coltot, FAB->params->colidx, - FAB->params->colorb, FAB->params->rsym, FAB->params->ssym, avir_off, - bvir_off, avirtpi, avir_off, FAA->params->colidx, acb, 1); + nrows = T2AB->params->coltot[Gjl]; + ncols = avirtpi[Gb]; + nlinks = boccpi[Gl]; - /* clean out the alpha-beta-alpha intermediate for next set of terms */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - if(FAB->params->coltot[Gab] && avirtpi[Gc]) { - memset(W2[Gab][0], 0, FAB->params->coltot[Gab]*avirtpi[Gc]*sizeof(double)); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AB->matrix[Gjl][jl], nrows, &(EBA->matrix[Gki][ki][lb]), + ncols, 1.0, W2[Gac][0], ncols); } - } - for(Gd=0; Gd < nirreps; Gd++) { - /* -t_JkAd * F_IdBc */ - Gbc = Gid = Gi ^ Gd; /* assumes totally symmetric! */ - Ga = Gjk ^ Gd; /* assumes totally symmetric! */ + /* W(Ac,B) --> W(AB,c) */ + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FAB->params->coltot, FAB->params->colidx, FAB->params->colorb, + FAB->params->rsym, FAB->params->ssym, avir_off, bvir_off, avirtpi, avir_off, + FAA->params->colidx, acb, 1); + + /* clean out the alpha-beta-alpha intermediate for next set of terms */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + if (FAB->params->coltot[Gab] && avirtpi[Gc]) { + memset(W2[Gab][0], 0, FAB->params->coltot[Gab] * avirtpi[Gc] * sizeof(double)); + } + } - ad = T2AB->col_offset[Gjk][Ga]; - id = FAB->row_offset[Gid][I]; + for (Gd = 0; Gd < nirreps; Gd++) { + /* -t_JkAd * F_IdBc */ + Gbc = Gid = Gi ^ Gd; /* assumes totally symmetric! */ + Ga = Gjk ^ Gd; /* assumes totally symmetric! */ - FAB->matrix[Gid] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(FAB, Gid, id, bvirtpi[Gd]); + ad = T2AB->col_offset[Gjk][Ga]; + id = FAB->row_offset[Gid][I]; - nrows = FAB->params->coltot[Gid]; - ncols = avirtpi[Ga]; - nlinks = bvirtpi[Gd]; + FAB->matrix[Gid] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(FAB, Gid, id, bvirtpi[Gd]); - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, -1.0, FAB->matrix[Gid][0], nrows, - &(T2AB->matrix[Gjk][jk][ad]), nlinks, 1.0, W2[Gbc][0], ncols); + nrows = FAB->params->coltot[Gid]; + ncols = avirtpi[Ga]; + nlinks = bvirtpi[Gd]; - global_dpd_->free_dpd_block(FAB->matrix[Gid], bvirtpi[Gd], FAB->params->coltot[Gid]); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, FAB->matrix[Gid][0], nrows, &(T2AB->matrix[Gjk][jk][ad]), + nlinks, 1.0, W2[Gbc][0], ncols); - /* +t_IkAd * F_JdBc */ - Gbc = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ - Ga = Gik ^ Gd; /* assumes totally symmetric! */ + global_dpd_->free_dpd_block(FAB->matrix[Gid], bvirtpi[Gd], FAB->params->coltot[Gid]); - ad = T2AB->col_offset[Gik][Ga]; - jd = FAB->row_offset[Gjd][J]; + /* +t_IkAd * F_JdBc */ + Gbc = Gjd = Gj ^ Gd; /* assumes totally symmetric! */ + Ga = Gik ^ Gd; /* assumes totally symmetric! */ - FAB->matrix[Gjd] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gjd]); - global_dpd_->buf4_mat_irrep_rd_block(FAB, Gjd, jd, bvirtpi[Gd]); + ad = T2AB->col_offset[Gik][Ga]; + jd = FAB->row_offset[Gjd][J]; - nrows = FAB->params->coltot[Gjd]; - ncols = avirtpi[Ga]; - nlinks = bvirtpi[Gd]; + FAB->matrix[Gjd] = global_dpd_->dpd_block_matrix(bvirtpi[Gd], FAB->params->coltot[Gjd]); + global_dpd_->buf4_mat_irrep_rd_block(FAB, Gjd, jd, bvirtpi[Gd]); - if(nrows && ncols && nlinks) - C_DGEMM('t','t',nrows, ncols, nlinks, 1.0, FAB->matrix[Gjd][0], nrows, - &(T2AB->matrix[Gik][ik][ad]), nlinks, 1.0, W2[Gbc][0], ncols); + nrows = FAB->params->coltot[Gjd]; + ncols = avirtpi[Ga]; + nlinks = bvirtpi[Gd]; - global_dpd_->free_dpd_block(FAB->matrix[Gjd], bvirtpi[Gd], FAB->params->coltot[Gjd]); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, FAB->matrix[Gjd][0], nrows, &(T2AB->matrix[Gik][ik][ad]), + nlinks, 1.0, W2[Gbc][0], ncols); - } + global_dpd_->free_dpd_block(FAB->matrix[Gjd], bvirtpi[Gd], FAB->params->coltot[Gjd]); + } - for(Gl=0; Gl < nirreps; Gl++) { - /* +t_IlBc * E_kJlA */ - Gbc = Gil = Gi ^ Gl; /* assumes totally symmetric! */ - Ga = Gkj ^ Gl; /* assumes totally symmetric! */ + for (Gl = 0; Gl < nirreps; Gl++) { + /* +t_IlBc * E_kJlA */ + Gbc = Gil = Gi ^ Gl; /* assumes totally symmetric! */ + Ga = Gkj ^ Gl; /* assumes totally symmetric! */ - la = EBA->col_offset[Gkj][Gl]; - il = T2AB->row_offset[Gil][I]; + la = EBA->col_offset[Gkj][Gl]; + il = T2AB->row_offset[Gil][I]; - nrows = T2AB->params->coltot[Gil]; - ncols = avirtpi[Ga]; - nlinks = boccpi[Gl]; + nrows = T2AB->params->coltot[Gil]; + ncols = avirtpi[Ga]; + nlinks = boccpi[Gl]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AB->matrix[Gil][il], nrows, - &(EBA->matrix[Gkj][kj][la]), ncols, 1.0, W2[Gbc][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2AB->matrix[Gil][il], nrows, &(EBA->matrix[Gkj][kj][la]), + ncols, 1.0, W2[Gbc][0], ncols); - /* -t_JlBc * E_kIlA */ - Gbc = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ - Ga = Gki ^ Gl; /* assumes totally symmetric! */ + /* -t_JlBc * E_kIlA */ + Gbc = Gjl = Gj ^ Gl; /* assumes totally symmetric! */ + Ga = Gki ^ Gl; /* assumes totally symmetric! */ - la = EBA->col_offset[Gki][Gl]; - jl = T2AB->row_offset[Gjl][J]; + la = EBA->col_offset[Gki][Gl]; + jl = T2AB->row_offset[Gjl][J]; - nrows = T2AB->params->coltot[Gjl]; - ncols = avirtpi[Ga]; - nlinks = boccpi[Gl]; + nrows = T2AB->params->coltot[Gjl]; + ncols = avirtpi[Ga]; + nlinks = boccpi[Gl]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AB->matrix[Gjl][jl], nrows, - &(EBA->matrix[Gki][ki][la]), ncols, 1.0, W2[Gbc][0], ncols); - } + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2AB->matrix[Gjl][jl], nrows, &(EBA->matrix[Gki][ki][la]), + ncols, 1.0, W2[Gbc][0], ncols); + } - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FAB->params->coltot, FAB->params->colidx, - FAB->params->colorb, FAB->params->rsym, FAB->params->ssym, avir_off, - bvir_off, avirtpi, avir_off, FAA->params->colidx, cab, 1); - /* Close the alpha-beta-alpha array and open a beta-alpha-alpha array */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FAB->params->coltot, FAB->params->colidx, FAB->params->colorb, + FAB->params->rsym, FAB->params->ssym, avir_off, bvir_off, avirtpi, avir_off, + FAA->params->colidx, cab, 1); + /* Close the alpha-beta-alpha array and open a beta-alpha-alpha array */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - global_dpd_->free_dpd_block(W2[Gab], FAB->params->coltot[Gab], avirtpi[Gc]); - W2[Gab] = global_dpd_->dpd_block_matrix(FBA->params->coltot[Gab], avirtpi[Gc]); - } + global_dpd_->free_dpd_block(W2[Gab], FAB->params->coltot[Gab], avirtpi[Gc]); + W2[Gab] = global_dpd_->dpd_block_matrix(FBA->params->coltot[Gab], avirtpi[Gc]); + } - /* Insert cBA terms */ - for(Gd=0; Gd < nirreps; Gd++) { - /* -t_JIAD * F_kDcB */ - Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ - Ga = Gji ^ Gd; /* assumes totally symmetric! */ + /* Insert cBA terms */ + for (Gd = 0; Gd < nirreps; Gd++) { + /* -t_JIAD * F_kDcB */ + Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ + Ga = Gji ^ Gd; /* assumes totally symmetric! */ - ad = T2AA->col_offset[Gji][Ga]; - kd = FBA->row_offset[Gkd][K]; + ad = T2AA->col_offset[Gji][Ga]; + kd = FBA->row_offset[Gkd][K]; - FBA->matrix[Gkd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FBA->params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(FBA, Gkd, kd, avirtpi[Gd]); + FBA->matrix[Gkd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FBA->params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(FBA, Gkd, kd, avirtpi[Gd]); - nrows = FBA->params->coltot[Gkd]; - ncols = avirtpi[Ga]; - nlinks = avirtpi[Gd]; + nrows = FBA->params->coltot[Gkd]; + ncols = avirtpi[Ga]; + nlinks = avirtpi[Gd]; - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, FBA->matrix[Gkd][0], nrows, - &(T2AA->matrix[Gji][ji][ad]), nlinks, 1.0, W2[Gcb][0], ncols); + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, -1.0, FBA->matrix[Gkd][0], nrows, &(T2AA->matrix[Gji][ji][ad]), + nlinks, 1.0, W2[Gcb][0], ncols); - global_dpd_->free_dpd_block(FBA->matrix[Gkd], avirtpi[Gd], FBA->params->coltot[Gkd]); - } + global_dpd_->free_dpd_block(FBA->matrix[Gkd], avirtpi[Gd], FBA->params->coltot[Gkd]); + } - for(Gl=0; Gl < nirreps; Gl++) { + for (Gl = 0; Gl < nirreps; Gl++) { + /* -t_kLcB * E_JILA */ + Gcb = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ + Ga = Gji ^ Gl; /* assumes totally symmetric! */ - /* -t_kLcB * E_JILA */ - Gcb = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ - Ga = Gji ^ Gl; /* assumes totally symmetric! */ + la = EAA->col_offset[Gji][Gl]; + kl = T2BA->row_offset[Gkl][K]; - la = EAA->col_offset[Gji][Gl]; - kl = T2BA->row_offset[Gkl][K]; + nrows = T2BA->params->coltot[Gkl]; + ncols = avirtpi[Ga]; + nlinks = aoccpi[Gl]; - nrows = T2BA->params->coltot[Gkl]; - ncols = avirtpi[Ga]; - nlinks = aoccpi[Gl]; + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2BA->matrix[Gkl][kl], nrows, &(EAA->matrix[Gji][ji][la]), + ncols, 1.0, W2[Gcb][0], ncols); + } - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, -1.0, T2BA->matrix[Gkl][kl], nrows, - &(EAA->matrix[Gji][ji][la]), ncols, 1.0, W2[Gcb][0], ncols); - } + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FBA->params->coltot, FBA->params->colidx, FBA->params->colorb, + FBA->params->rsym, FBA->params->ssym, bvir_off, avir_off, avirtpi, avir_off, + FAA->params->colidx, cba, 1); - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FBA->params->coltot, FBA->params->colidx, - FBA->params->colorb, FBA->params->rsym, FBA->params->ssym, bvir_off, - avir_off, avirtpi, avir_off, FAA->params->colidx, cba, 1); + /* clean out the beta-alpha-alpha intermediate for next set of terms */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + if (FBA->params->coltot[Gab] && avirtpi[Gc]) { + memset(W2[Gab][0], 0, FBA->params->coltot[Gab] * avirtpi[Gc] * sizeof(double)); + } + } + + for (Gd = 0; Gd < nirreps; Gd++) { + /* +t_JIBD * F_kDcA */ + Gca = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ + Gb = Gji ^ Gd; /* assumes totally symmetric! */ + + bd = T2AA->col_offset[Gji][Gb]; + kd = FBA->row_offset[Gkd][K]; + + FBA->matrix[Gkd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FBA->params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(FBA, Gkd, kd, avirtpi[Gd]); - /* clean out the beta-alpha-alpha intermediate for next set of terms */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - if(FBA->params->coltot[Gab] && avirtpi[Gc]) { - memset(W2[Gab][0], 0, FBA->params->coltot[Gab]*avirtpi[Gc]*sizeof(double)); + nrows = FBA->params->coltot[Gkd]; + ncols = avirtpi[Gb]; + nlinks = avirtpi[Gd]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, FBA->matrix[Gkd][0], nrows, &(T2AA->matrix[Gji][ji][bd]), + nlinks, 1.0, W2[Gca][0], ncols); + + global_dpd_->free_dpd_block(FBA->matrix[Gkd], avirtpi[Gd], FBA->params->coltot[Gkd]); } - } - - for(Gd=0; Gd < nirreps; Gd++) { - - /* +t_JIBD * F_kDcA */ - Gca = Gkd = Gk ^ Gd; /* assumes totally symmetric! */ - Gb = Gji ^ Gd; /* assumes totally symmetric! */ - - bd = T2AA->col_offset[Gji][Gb]; - kd = FBA->row_offset[Gkd][K]; - - FBA->matrix[Gkd] = global_dpd_->dpd_block_matrix(avirtpi[Gd], FBA->params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(FBA, Gkd, kd, avirtpi[Gd]); - - nrows = FBA->params->coltot[Gkd]; - ncols = avirtpi[Gb]; - nlinks = avirtpi[Gd]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, FBA->matrix[Gkd][0], nrows, - &(T2AA->matrix[Gji][ji][bd]), nlinks, 1.0, W2[Gca][0], ncols); - - global_dpd_->free_dpd_block(FBA->matrix[Gkd], avirtpi[Gd], FBA->params->coltot[Gkd]); - } - - for(Gl=0; Gl < nirreps; Gl++) { - - /* +t_kLcA * E_JILB */ - Gca = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ - Gb = Gji ^ Gl; /* assumes totally symmetric! */ - - lb = EAA->col_offset[Gji][Gl]; - kl = T2BA->row_offset[Gkl][K]; - - nrows = T2BA->params->coltot[Gkl]; - ncols = avirtpi[Gb]; - nlinks = aoccpi[Gl]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2BA->matrix[Gkl][kl], nrows, - &(EAA->matrix[Gji][ji][lb]), ncols, 1.0, W2[Gca][0], ncols); - } - - global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FBA->params->coltot, FBA->params->colidx, - FBA->params->colorb, FBA->params->rsym, FBA->params->ssym, - bvir_off, avir_off, avirtpi, avir_off, FAA->params->colidx, bca, 1); - - /* Add disconnected terms */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - Gba = Gab; - for(ab=0; ab < FAA->params->coltot[Gab]; ab++) { - A = FAA->params->colorb[Gab][ab][0]; - B = FAA->params->colorb[Gab][ab][1]; - Ga = FAA->params->rsym[A]; - Gb = FAA->params->ssym[B]; - a = A - avir_off[Ga]; - b = B - avir_off[Gb]; - - Gbc = Gcb = Gb ^ Gc; - Gac = Gca = Ga ^ Gc; - - ba = LIJAB->params->colidx[B][A]; - - for(c=0; c < bvirtpi[Gc]; c++) { - C = bvir_off[Gc] + c; - - bc = LIJAB->params->colidx[B][C]; - cb = LIJAB->params->colidx[C][B]; - ac = LIJAB->params->colidx[A][C]; - ca = LIJAB->params->colidx[C][A]; - - /* +L_IA * D_JkBc + F_IA * L_JkBc */ - if(Gi == Ga && Gjk == Gbc) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { - L1 = LIA->matrix[Gi][i][a]; - F1 = FME->matrix[Gi][i][a]; - } - if(DAB->params->rowtot[Gjk] && DAB->params->coltot[Gjk]) { - D2 = DAB->matrix[Gjk][jk][bc]; - L2 = LIjAb->matrix[Gjk][jk][bc]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - - /* -L_IB * D_JkAc - F_IB * L_JkAc */ - if(Gi == Gb && Gjk == Gac) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { - L1 = LIA->matrix[Gi][i][b]; - F1 = FME->matrix[Gi][i][b]; - } - if(DAB->params->rowtot[Gjk] && DAB->params->coltot[Gjk]) { - D2 = DAB->matrix[Gjk][jk][ac]; - L2 = LIjAb->matrix[Gjk][jk][ac]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - - /* -L_JA * D_IkBc - F_JA * L_IkBc */ - if(Gj == Ga && Gik == Gbc) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { - L1 = LIA->matrix[Gj][j][a]; - F1 = FME->matrix[Gj][j][a]; - } - if(DAB->params->rowtot[Gik] && DAB->params->coltot[Gik]) { - D2 = DAB->matrix[Gik][ik][bc]; - L2 = LIjAb->matrix[Gik][ik][bc]; - } - W1[Gab][ab][c] -= L1 * D2 + F1 * L2; - } - - /* +L_JB * D_IkAc + F_JB * L_IkAc */ - if(Gj == Gb && Gik == Gac) { - L1 = D2 = F1 = L2 = 0.0; - if(LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { - L1 = LIA->matrix[Gj][j][b]; - F1 = FME->matrix[Gj][j][b]; - } - if(DAB->params->rowtot[Gik] && DAB->params->coltot[Gik]) { - D2 = DAB->matrix[Gik][ik][ac]; - L2 = LIjAb->matrix[Gik][ik][ac]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - /* +L_kc * D_IJAB + F_kc * L_IJAB */ - if(Gk == Gc && Gij == Gab) { - L1 = D2 = F1 = L2 = 0.0; - if(Lia->params->rowtot[Gk] && Lia->params->coltot[Gk]) { - L1 = Lia->matrix[Gk][k][c]; - F1 = Fme->matrix[Gk][k][c]; - } - if(DAA->params->rowtot[Gij] && DAA->params->coltot[Gij]) { - D2 = DAA->matrix[Gij][ij][ab]; - L2 = LIJAB->matrix[Gij][ij][ab]; - } - W1[Gab][ab][c] += L1 * D2 + F1 * L2; - } - - } + + for (Gl = 0; Gl < nirreps; Gl++) { + /* +t_kLcA * E_JILB */ + Gca = Gkl = Gk ^ Gl; /* assumes totally symmetric! */ + Gb = Gji ^ Gl; /* assumes totally symmetric! */ + + lb = EAA->col_offset[Gji][Gl]; + kl = T2BA->row_offset[Gkl][K]; + + nrows = T2BA->params->coltot[Gkl]; + ncols = avirtpi[Gb]; + nlinks = aoccpi[Gl]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, T2BA->matrix[Gkl][kl], nrows, &(EAA->matrix[Gji][ji][lb]), + ncols, 1.0, W2[Gca][0], ncols); } - } - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + global_dpd_->sort_3d(W2, W1, nirreps, Gijk, FBA->params->coltot, FBA->params->colidx, FBA->params->colorb, + FBA->params->rsym, FBA->params->ssym, bvir_off, avir_off, avirtpi, avir_off, + FAA->params->colidx, bca, 1); + + /* Add disconnected terms */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + Gba = Gab; + for (ab = 0; ab < FAA->params->coltot[Gab]; ab++) { + A = FAA->params->colorb[Gab][ab][0]; + B = FAA->params->colorb[Gab][ab][1]; + Ga = FAA->params->rsym[A]; + Gb = FAA->params->ssym[B]; + a = A - avir_off[Ga]; + b = B - avir_off[Gb]; + + Gbc = Gcb = Gb ^ Gc; + Gac = Gca = Ga ^ Gc; + + ba = LIJAB->params->colidx[B][A]; + + for (c = 0; c < bvirtpi[Gc]; c++) { + C = bvir_off[Gc] + c; + + bc = LIJAB->params->colidx[B][C]; + cb = LIJAB->params->colidx[C][B]; + ac = LIJAB->params->colidx[A][C]; + ca = LIJAB->params->colidx[C][A]; + + /* +L_IA * D_JkBc + F_IA * L_JkBc */ + if (Gi == Ga && Gjk == Gbc) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { + L1 = LIA->matrix[Gi][i][a]; + F1 = FME->matrix[Gi][i][a]; + } + if (DAB->params->rowtot[Gjk] && DAB->params->coltot[Gjk]) { + D2 = DAB->matrix[Gjk][jk][bc]; + L2 = LIjAb->matrix[Gjk][jk][bc]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + + /* -L_IB * D_JkAc - F_IB * L_JkAc */ + if (Gi == Gb && Gjk == Gac) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gi] && LIA->params->coltot[Gi]) { + L1 = LIA->matrix[Gi][i][b]; + F1 = FME->matrix[Gi][i][b]; + } + if (DAB->params->rowtot[Gjk] && DAB->params->coltot[Gjk]) { + D2 = DAB->matrix[Gjk][jk][ac]; + L2 = LIjAb->matrix[Gjk][jk][ac]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + + /* -L_JA * D_IkBc - F_JA * L_IkBc */ + if (Gj == Ga && Gik == Gbc) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { + L1 = LIA->matrix[Gj][j][a]; + F1 = FME->matrix[Gj][j][a]; + } + if (DAB->params->rowtot[Gik] && DAB->params->coltot[Gik]) { + D2 = DAB->matrix[Gik][ik][bc]; + L2 = LIjAb->matrix[Gik][ik][bc]; + } + W1[Gab][ab][c] -= L1 * D2 + F1 * L2; + } + + /* +L_JB * D_IkAc + F_JB * L_IkAc */ + if (Gj == Gb && Gik == Gac) { + L1 = D2 = F1 = L2 = 0.0; + if (LIA->params->rowtot[Gj] && LIA->params->coltot[Gj]) { + L1 = LIA->matrix[Gj][j][b]; + F1 = FME->matrix[Gj][j][b]; + } + if (DAB->params->rowtot[Gik] && DAB->params->coltot[Gik]) { + D2 = DAB->matrix[Gik][ik][ac]; + L2 = LIjAb->matrix[Gik][ik][ac]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + /* +L_kc * D_IJAB + F_kc * L_IJAB */ + if (Gk == Gc && Gij == Gab) { + L1 = D2 = F1 = L2 = 0.0; + if (Lia->params->rowtot[Gk] && Lia->params->coltot[Gk]) { + L1 = Lia->matrix[Gk][k][c]; + F1 = Fme->matrix[Gk][k][c]; + } + if (DAA->params->rowtot[Gij] && DAA->params->coltot[Gij]) { + D2 = DAA->matrix[Gij][ij][ab]; + L2 = LIJAB->matrix[Gij][ij][ab]; + } + W1[Gab][ab][c] += L1 * D2 + F1 * L2; + } + } + } + } - for(ab=0; ab < FAA->params->coltot[Gab]; ab++) { - A = FAA->params->colorb[Gab][ab][0]; - B = FAA->params->colorb[Gab][ab][1]; - Ga = FAA->params->rsym[A]; - Gb = FAA->params->ssym[B]; - a = A - avir_off[Ga]; - b = B - avir_off[Gb]; + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - for(c=0; c < bvirtpi[Gc]; c++) { - C = bvir_off[Gc] + c; + for (ab = 0; ab < FAA->params->coltot[Gab]; ab++) { + A = FAA->params->colorb[Gab][ab][0]; + B = FAA->params->colorb[Gab][ab][1]; + Ga = FAA->params->rsym[A]; + Gb = FAA->params->ssym[B]; + a = A - avir_off[Ga]; + b = B - avir_off[Gb]; - denom = dijk; - if(fAB->params->rowtot[Ga]) denom -= fAB->matrix[Ga][a][a]; - if(fAB->params->rowtot[Gb]) denom -= fAB->matrix[Gb][b][b]; - if(fab->params->rowtot[Gc]) denom -= fab->matrix[Gc][c][c]; + for (c = 0; c < bvirtpi[Gc]; c++) { + C = bvir_off[Gc] + c; - W1[Gab][ab][c] /= denom; + denom = dijk; + if (fAB->params->rowtot[Ga]) denom -= fAB->matrix[Ga][a][a]; + if (fAB->params->rowtot[Gb]) denom -= fAB->matrix[Gb][b][b]; + if (fab->params->rowtot[Gc]) denom -= fab->matrix[Gc][c][c]; - } /* c */ - } /* ab */ - } /* Gab */ + W1[Gab][ab][c] /= denom; + } /* c */ + } /* ab */ + } /* Gab */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric! */ - global_dpd_->free_dpd_block(W2[Gab], FBA->params->coltot[Gab], avirtpi[Gc]); - } + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric! */ + global_dpd_->free_dpd_block(W2[Gab], FBA->params->coltot[Gab], avirtpi[Gc]); + } - free(W2); + free(W2); - global_dpd_->file2_mat_close(fIJ); - global_dpd_->file2_mat_close(fAB); - global_dpd_->file2_mat_close(fij); - global_dpd_->file2_mat_close(fab); + global_dpd_->file2_mat_close(fIJ); + global_dpd_->file2_mat_close(fAB); + global_dpd_->file2_mat_close(fij); + global_dpd_->file2_mat_close(fab); - global_dpd_->file2_mat_close(FME); - global_dpd_->file2_mat_close(Fme); - global_dpd_->file2_mat_close(LIA); - global_dpd_->file2_mat_close(Lia); + global_dpd_->file2_mat_close(FME); + global_dpd_->file2_mat_close(Fme); + global_dpd_->file2_mat_close(LIA); + global_dpd_->file2_mat_close(Lia); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_close(T2AA, h); - global_dpd_->buf4_mat_irrep_close(T2AB, h); - global_dpd_->buf4_mat_irrep_close(T2BA, h); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_close(T2AA, h); + global_dpd_->buf4_mat_irrep_close(T2AB, h); + global_dpd_->buf4_mat_irrep_close(T2BA, h); - global_dpd_->buf4_mat_irrep_close(EAA, h); - global_dpd_->buf4_mat_irrep_close(EAB, h); - global_dpd_->buf4_mat_irrep_close(EBA, h); + global_dpd_->buf4_mat_irrep_close(EAA, h); + global_dpd_->buf4_mat_irrep_close(EAB, h); + global_dpd_->buf4_mat_irrep_close(EBA, h); - global_dpd_->buf4_mat_irrep_close(DAA, h); - global_dpd_->buf4_mat_irrep_close(DAB, h); + global_dpd_->buf4_mat_irrep_close(DAA, h); + global_dpd_->buf4_mat_irrep_close(DAB, h); - global_dpd_->buf4_mat_irrep_close(LIJAB, h); - global_dpd_->buf4_mat_irrep_close(LIjAb, h); - } + global_dpd_->buf4_mat_irrep_close(LIJAB, h); + global_dpd_->buf4_mat_irrep_close(LIjAb, h); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Lamp_write.cc b/psi4/src/psi4/cclambda/Lamp_write.cc index f03e1743bc4..e2b6ce68db2 100644 --- a/psi4/src/psi4/cclambda/Lamp_write.cc +++ b/psi4/src/psi4/cclambda/Lamp_write.cc @@ -40,7 +40,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { struct onestack { double value; @@ -50,246 +51,244 @@ struct onestack { struct twostack { double value; - int i; int j; - int a; int b; + int i; + int j; + int a; + int b; }; -void onestack_insert(struct onestack *stack, double value, int i, int a, - int level, int stacklen); -void twostack_insert(struct twostack *stack, double value, int i, int j, - int a, int b, int level, int stacklen); +void onestack_insert(struct onestack *stack, double value, int i, int a, int level, int stacklen); +void twostack_insert(struct twostack *stack, double value, int i, int j, int a, int b, int level, int stacklen); void amp_write_L1(dpdfile2 *L1, int length, const char *label, std::string out); void amp_write_L2(dpdbuf4 *L2, int length, const char *label, std::string out); /* print largest elements in CC_LAMBDA */ void Lamp_write(struct L_Params L_params) { - dpdfile2 L1; - dpdbuf4 L2; - int L_irr; - L_irr = L_params.irrep; - - if(params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 1) { /** ROHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); - global_dpd_->file2_close(&L1); - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - amp_write_L1(&L1, params.num_amps, "\n\tLargest Lia Amplitudes:\n", "outfile"); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest LIJAB Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest Lijab Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); - global_dpd_->file2_close(&L1); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - amp_write_L1(&L1, params.num_amps, "\n\tLargest Lia Amplitudes:\n", "outfile"); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest LIJAB Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest Lijab Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); - global_dpd_->buf4_close(&L2); - } + dpdfile2 L1; + dpdbuf4 L2; + int L_irr; + L_irr = L_params.irrep; + + if (params.ref == 0) { /** RHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 1) { /** ROHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); + global_dpd_->file2_close(&L1); + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + amp_write_L1(&L1, params.num_amps, "\n\tLargest Lia Amplitudes:\n", "outfile"); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest LIJAB Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest Lijab Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + amp_write_L1(&L1, params.num_amps, "\n\tLargest LIA Amplitudes:\n", "outfile"); + global_dpd_->file2_close(&L1); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + amp_write_L1(&L1, params.num_amps, "\n\tLargest Lia Amplitudes:\n", "outfile"); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest LIJAB Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest Lijab Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + amp_write_L2(&L2, params.num_amps, "\n\tLargest LIjAb Amplitudes:\n", "outfile"); + global_dpd_->buf4_close(&L2); + } } -void amp_write_L1(dpdfile2 *L1, int length, const char *label, std::string out) -{ - int m, h, nirreps, Gia; - int i, I, a, A, numt1; - int num2print=0; - double value; - struct onestack *t1stack; - - nirreps = L1->params->nirreps; - Gia = L1->my_irrep; - - t1stack = (struct onestack *) malloc(length * sizeof(struct onestack)); - for(m=0; m < length; m++) { t1stack[m].value = 0; t1stack[m].i = 0; t1stack[m].a = 0; } - - global_dpd_->file2_mat_init(L1); - global_dpd_->file2_mat_rd(L1); - - numt1 = 0; - for(h=0; h < nirreps; h++) { - - numt1 += L1->params->rowtot[h] * L1->params->coltot[h^Gia]; - - for(i=0; i < L1->params->rowtot[h]; i++) { - I = L1->params->roworb[h][i]; - for(a=0; a < L1->params->coltot[h^Gia]; a++) { - A = L1->params->colorb[h^Gia][a]; - value = L1->matrix[h][i][a]; - for(m=0; m < length; m++) { - if((std::fabs(value) - std::fabs(t1stack[m].value)) > 1e-12) { - onestack_insert(t1stack, value, I, A, m, length); - break; - } - } - } - } - } +void amp_write_L1(dpdfile2 *L1, int length, const char *label, std::string out) { + int m, h, nirreps, Gia; + int i, I, a, A, numt1; + int num2print = 0; + double value; + struct onestack *t1stack; - global_dpd_->file2_mat_close(L1); + nirreps = L1->params->nirreps; + Gia = L1->my_irrep; - for(m=0; m < ((numt1 < length) ? numt1 : length); m++) - if(std::fabs(t1stack[m].value) > 1e-8) num2print++; + t1stack = (struct onestack *)malloc(length * sizeof(struct onestack)); + for (m = 0; m < length; m++) { + t1stack[m].value = 0; + t1stack[m].i = 0; + t1stack[m].a = 0; + } - if(num2print) outfile->Printf( "%s", label); + global_dpd_->file2_mat_init(L1); + global_dpd_->file2_mat_rd(L1); + + numt1 = 0; + for (h = 0; h < nirreps; h++) { + numt1 += L1->params->rowtot[h] * L1->params->coltot[h ^ Gia]; + + for (i = 0; i < L1->params->rowtot[h]; i++) { + I = L1->params->roworb[h][i]; + for (a = 0; a < L1->params->coltot[h ^ Gia]; a++) { + A = L1->params->colorb[h ^ Gia][a]; + value = L1->matrix[h][i][a]; + for (m = 0; m < length; m++) { + if ((std::fabs(value) - std::fabs(t1stack[m].value)) > 1e-12) { + onestack_insert(t1stack, value, I, A, m, length); + break; + } + } + } + } + } - for(m=0; m < ((numt1 < length) ? numt1 : length); m++) - if(std::fabs(t1stack[m].value) > 1e-8) - outfile->Printf( "\t %3d %3d %20.10f\n", t1stack[m].i, t1stack[m].a, t1stack[m].value); + global_dpd_->file2_mat_close(L1); - free(t1stack); -} + for (m = 0; m < ((numt1 < length) ? numt1 : length); m++) + if (std::fabs(t1stack[m].value) > 1e-8) num2print++; -void onestack_insert(struct onestack *stack, double value, int i, int a, int level, int stacklen) -{ - int l; - struct onestack temp; + if (num2print) outfile->Printf("%s", label); - temp = stack[level]; + for (m = 0; m < ((numt1 < length) ? numt1 : length); m++) + if (std::fabs(t1stack[m].value) > 1e-8) + outfile->Printf("\t %3d %3d %20.10f\n", t1stack[m].i, t1stack[m].a, t1stack[m].value); - stack[level].value = value; - stack[level].i = i; - stack[level].a = a; + free(t1stack); +} - value = temp.value; - i = temp.i; - a = temp.a; +void onestack_insert(struct onestack *stack, double value, int i, int a, int level, int stacklen) { + int l; + struct onestack temp; - for(l=level; l < stacklen-1; l++) { - temp = stack[l+1]; + temp = stack[level]; - stack[l+1].value = value; - stack[l+1].i = i; - stack[l+1].a = a; + stack[level].value = value; + stack[level].i = i; + stack[level].a = a; value = temp.value; i = temp.i; a = temp.a; - } + + for (l = level; l < stacklen - 1; l++) { + temp = stack[l + 1]; + + stack[l + 1].value = value; + stack[l + 1].i = i; + stack[l + 1].a = a; + + value = temp.value; + i = temp.i; + a = temp.a; + } } -void amp_write_L2(dpdbuf4 *L2, int length, const char *label, std::string out) -{ - int m, h, nirreps, Gijab, numt2; - int ij, ab, i, j, a, b; - int num2print=0; - double value; - struct twostack *t2stack; - - nirreps = L2->params->nirreps; - Gijab = L2->file.my_irrep; - - t2stack = (struct twostack *) malloc(length * sizeof(struct twostack)); - for(m=0; m < length; m++) { - t2stack[m].value = 0; - t2stack[m].i = 0; t2stack[m].j = 0; - t2stack[m].a = 0; t2stack[m].b = 0; - } - - numt2 = 0; - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(L2, h); - global_dpd_->buf4_mat_irrep_rd(L2, h); - - numt2 += L2->params->rowtot[h] * L2->params->coltot[h^Gijab]; - - for(ij=0; ij < L2->params->rowtot[h]; ij++) { - i = L2->params->roworb[h][ij][0]; - j = L2->params->roworb[h][ij][1]; - for(ab=0; ab < L2->params->coltot[h^Gijab]; ab++) { - a = L2->params->colorb[h^Gijab][ab][0]; - b = L2->params->colorb[h^Gijab][ab][1]; - - value = L2->matrix[h][ij][ab]; - - for(m=0; m < length; m++) { - if((std::fabs(value) - std::fabs(t2stack[m].value)) > 1e-12) { - twostack_insert(t2stack, value, i, j, a, b, m, length); - break; - } - } - } +void amp_write_L2(dpdbuf4 *L2, int length, const char *label, std::string out) { + int m, h, nirreps, Gijab, numt2; + int ij, ab, i, j, a, b; + int num2print = 0; + double value; + struct twostack *t2stack; + + nirreps = L2->params->nirreps; + Gijab = L2->file.my_irrep; + + t2stack = (struct twostack *)malloc(length * sizeof(struct twostack)); + for (m = 0; m < length; m++) { + t2stack[m].value = 0; + t2stack[m].i = 0; + t2stack[m].j = 0; + t2stack[m].a = 0; + t2stack[m].b = 0; } - global_dpd_->buf4_mat_irrep_close(L2, h); - } + numt2 = 0; + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(L2, h); + global_dpd_->buf4_mat_irrep_rd(L2, h); - for(m=0; m < ((numt2 < length) ? numt2 : length); m++) - if(std::fabs(t2stack[m].value) > 1e-8) num2print++; + numt2 += L2->params->rowtot[h] * L2->params->coltot[h ^ Gijab]; - if(num2print) outfile->Printf( "%s", label); + for (ij = 0; ij < L2->params->rowtot[h]; ij++) { + i = L2->params->roworb[h][ij][0]; + j = L2->params->roworb[h][ij][1]; + for (ab = 0; ab < L2->params->coltot[h ^ Gijab]; ab++) { + a = L2->params->colorb[h ^ Gijab][ab][0]; + b = L2->params->colorb[h ^ Gijab][ab][1]; - for(m=0; m < ((numt2 < length) ? numt2 : length); m++) - if(std::fabs(t2stack[m].value) > 1e-8) - outfile->Printf( "\t%3d %3d %3d %3d %20.10f\n", t2stack[m].i, t2stack[m].j, - t2stack[m].a, t2stack[m].b, t2stack[m].value); + value = L2->matrix[h][ij][ab]; - free(t2stack); -} + for (m = 0; m < length; m++) { + if ((std::fabs(value) - std::fabs(t2stack[m].value)) > 1e-12) { + twostack_insert(t2stack, value, i, j, a, b, m, length); + break; + } + } + } + } + + global_dpd_->buf4_mat_irrep_close(L2, h); + } + + for (m = 0; m < ((numt2 < length) ? numt2 : length); m++) + if (std::fabs(t2stack[m].value) > 1e-8) num2print++; -void twostack_insert(struct twostack *stack, double value, int i, int j, int a, int b, - int level, int stacklen) -{ - int l; - struct twostack temp; + if (num2print) outfile->Printf("%s", label); - temp = stack[level]; + for (m = 0; m < ((numt2 < length) ? numt2 : length); m++) + if (std::fabs(t2stack[m].value) > 1e-8) + outfile->Printf("\t%3d %3d %3d %3d %20.10f\n", t2stack[m].i, t2stack[m].j, t2stack[m].a, t2stack[m].b, + t2stack[m].value); - stack[level].value = value; - stack[level].i = i; - stack[level].j = j; - stack[level].a = a; - stack[level].b = b; + free(t2stack); +} - value = temp.value; - i = temp.i; - j = temp.j; - a = temp.a; - b = temp.b; +void twostack_insert(struct twostack *stack, double value, int i, int j, int a, int b, int level, int stacklen) { + int l; + struct twostack temp; - for(l=level; l < stacklen-1; l++) { - temp = stack[l+1]; + temp = stack[level]; - stack[l+1].value = value; - stack[l+1].i = i; - stack[l+1].j = j; - stack[l+1].a = a; - stack[l+1].b = b; + stack[level].value = value; + stack[level].i = i; + stack[level].j = j; + stack[level].a = a; + stack[level].b = b; value = temp.value; i = temp.i; j = temp.j; a = temp.a; b = temp.b; - } -} + for (l = level; l < stacklen - 1; l++) { + temp = stack[l + 1]; + + stack[l + 1].value = value; + stack[l + 1].i = i; + stack[l + 1].j = j; + stack[l + 1].a = a; + stack[l + 1].b = b; + + value = temp.value; + i = temp.i; + j = temp.j; + a = temp.a; + b = temp.b; + } +} -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Lmag.cc b/psi4/src/psi4/cclambda/Lmag.cc index 3c63d782fc7..555cd8ce8f6 100644 --- a/psi4/src/psi4/cclambda/Lmag.cc +++ b/psi4/src/psi4/cclambda/Lmag.cc @@ -38,35 +38,36 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -void Lmag(int L_irr) -{ - dpdfile2 R1, L1, LIA, Lia, RIA, Ria; - dpdbuf4 R2, L2, LIJAB, Lijab, LIjAb, RIJAB, Rijab, RIjAb; - double norm; +void Lmag(int L_irr) { + dpdfile2 R1, L1, LIA, Lia, RIA, Ria; + dpdbuf4 R2, L2, LIJAB, Lijab, LIjAb, RIJAB, Rijab, RIjAb; + double norm; - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - norm = global_dpd_->file2_dot_self(&LIA); - norm += global_dpd_->file2_dot_self(&Lia); - norm += global_dpd_->buf4_dot_self(&LIJAB); - norm += global_dpd_->buf4_dot_self(&Lijab); - norm += global_dpd_->buf4_dot_self(&LIjAb); - outfile->Printf("size of L %15.10lf\n",norm); + norm = global_dpd_->file2_dot_self(&LIA); + norm += global_dpd_->file2_dot_self(&Lia); + norm += global_dpd_->buf4_dot_self(&LIJAB); + norm += global_dpd_->buf4_dot_self(&Lijab); + norm += global_dpd_->buf4_dot_self(&LIjAb); + outfile->Printf("size of L %15.10lf\n", norm); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); - } + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&LIjAb); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Lnorm.cc b/psi4/src/psi4/cclambda/Lnorm.cc index 214ca31e671..5a9a2d198ca 100644 --- a/psi4/src/psi4/cclambda/Lnorm.cc +++ b/psi4/src/psi4/cclambda/Lnorm.cc @@ -39,105 +39,105 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { extern double pseudoenergy(struct L_Params L_params); -void Lnorm(struct L_Params L_params) -{ - dpdfile2 R1, L1, LIA, Lia, RIA, Ria; - dpdbuf4 R2, L2, LIJAB, Lijab, LIjAb, RIJAB, Rijab, RIjAb; - double tval, overlap, overlap0, overlap1, overlap2, L0; - char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; - int L_irr; - L_irr = L_params.irrep; - - if (L_params.ground) - L0 = 1.0; - else - L0 = 0.0; - - sprintf(R1A_lbl, "RIA %d %d", L_irr, L_params.root); - sprintf(R1B_lbl, "Ria %d %d", L_irr, L_params.root); - sprintf(R2AA_lbl, "RIJAB %d %d", L_irr, L_params.root); - sprintf(R2BB_lbl, "Rijab %d %d", L_irr, L_params.root); - sprintf(R2AB_lbl, "RIjAb %d %d", L_irr, L_params.root); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - overlap0 = L0 * L_params.R0; - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); - overlap1 = global_dpd_->file2_dot(&LIA, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); - overlap1 += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); - overlap2 = global_dpd_->buf4_dot(&LIJAB, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); - overlap2 += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); - overlap2 += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); - } - else { - overlap0 = L0 * L_params.R0; - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); - overlap1 = global_dpd_->file2_dot(&LIA, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); - overlap1 += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); - overlap2 = global_dpd_->buf4_dot(&LIJAB, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); - overlap2 += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); - overlap2 += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); - } - - overlap = overlap0 + overlap1 + overlap2; - - outfile->Printf("\n\tInitial = %15.10lf\n", overlap); - - global_dpd_->file2_scm(&LIA, 1.0/overlap); - global_dpd_->file2_scm(&Lia, 1.0/overlap); - global_dpd_->buf4_scm(&LIJAB, 1.0/overlap); - global_dpd_->buf4_scm(&Lijab, 1.0/overlap); - global_dpd_->buf4_scm(&LIjAb, 1.0/overlap); - - outfile->Printf("\tNormalizing L...\n"); - outfile->Printf("\tL0 * R0 = %15.10lf\n", overlap0/overlap); - outfile->Printf("\tL1 * R1 = %15.10lf\n", overlap1/overlap); - outfile->Printf("\tL2 * R2 = %15.10lf\n", overlap2/overlap); - outfile->Printf("\t = %15.10lf\n", overlap/overlap); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); - - tval = pseudoenergy(L_params); - outfile->Printf("\tPseudoenergy or Norm of normalized L = %20.15lf\n",tval); - - return; +void Lnorm(struct L_Params L_params) { + dpdfile2 R1, L1, LIA, Lia, RIA, Ria; + dpdbuf4 R2, L2, LIJAB, Lijab, LIjAb, RIJAB, Rijab, RIjAb; + double tval, overlap, overlap0, overlap1, overlap2, L0; + char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; + int L_irr; + L_irr = L_params.irrep; + + if (L_params.ground) + L0 = 1.0; + else + L0 = 0.0; + + sprintf(R1A_lbl, "RIA %d %d", L_irr, L_params.root); + sprintf(R1B_lbl, "Ria %d %d", L_irr, L_params.root); + sprintf(R2AA_lbl, "RIJAB %d %d", L_irr, L_params.root); + sprintf(R2BB_lbl, "Rijab %d %d", L_irr, L_params.root); + sprintf(R2AB_lbl, "RIjAb %d %d", L_irr, L_params.root); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + overlap0 = L0 * L_params.R0; + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); + overlap1 = global_dpd_->file2_dot(&LIA, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); + overlap1 += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); + overlap2 = global_dpd_->buf4_dot(&LIJAB, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); + overlap2 += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); + overlap2 += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } else { + overlap0 = L0 * L_params.R0; + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); + overlap1 = global_dpd_->file2_dot(&LIA, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); + overlap1 += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); + overlap2 = global_dpd_->buf4_dot(&LIJAB, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); + overlap2 += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); + overlap2 += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } + + overlap = overlap0 + overlap1 + overlap2; + + outfile->Printf("\n\tInitial = %15.10lf\n", overlap); + + global_dpd_->file2_scm(&LIA, 1.0 / overlap); + global_dpd_->file2_scm(&Lia, 1.0 / overlap); + global_dpd_->buf4_scm(&LIJAB, 1.0 / overlap); + global_dpd_->buf4_scm(&Lijab, 1.0 / overlap); + global_dpd_->buf4_scm(&LIjAb, 1.0 / overlap); + + outfile->Printf("\tNormalizing L...\n"); + outfile->Printf("\tL0 * R0 = %15.10lf\n", overlap0 / overlap); + outfile->Printf("\tL1 * R1 = %15.10lf\n", overlap1 / overlap); + outfile->Printf("\tL2 * R2 = %15.10lf\n", overlap2 / overlap); + outfile->Printf("\t = %15.10lf\n", overlap / overlap); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&LIjAb); + + tval = pseudoenergy(L_params); + outfile->Printf("\tPseudoenergy or Norm of normalized L = %20.15lf\n", tval); + + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Local.h b/psi4/src/psi4/cclambda/Local.h index 4691cafd5e1..ea7692acbbe 100644 --- a/psi4/src/psi4/cclambda/Local.h +++ b/psi4/src/psi4/cclambda/Local.h @@ -28,35 +28,37 @@ /*! \file \ingroup CCLAMBDA - \brief Enter brief description of file here + \brief Enter brief description of file here */ #include -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { struct Local { - int nso; - int nocc; - int nvir; - int *aostart; - int *aostop; - int **domain; - int **pairdomain; - int *pairdom_len; - int *pairdom_nrlen; - int *weak_pairs; - double ***V; - double ***W; - double *eps_occ; - double **eps_vir; - double cutoff; - std::string method; - std::string weakp; - int filter_singles; - double cphf_cutoff; - std::string freeze_core; - std::string pairdef; + int nso; + int nocc; + int nvir; + int *aostart; + int *aostop; + int **domain; + int **pairdomain; + int *pairdom_len; + int *pairdom_nrlen; + int *weak_pairs; + double ***V; + double ***W; + double *eps_occ; + double **eps_vir; + double cutoff; + std::string method; + std::string weakp; + int filter_singles; + double cphf_cutoff; + std::string freeze_core; + std::string pairdef; }; -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Lsave.cc b/psi4/src/psi4/cclambda/Lsave.cc index 52519c5de6b..4165957f8a8 100644 --- a/psi4/src/psi4/cclambda/Lsave.cc +++ b/psi4/src/psi4/cclambda/Lsave.cc @@ -37,58 +37,56 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void Lsave(int L_irr) -{ - dpdfile2 L1; - dpdbuf4 L2; - - if(params.ref == 0 || params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&L1); - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&L1); - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&L2); - - } +namespace psi { +namespace cclambda { + +void Lsave(int L_irr) { + dpdfile2 L1; + dpdbuf4 L2; + + if (params.ref == 0 || params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&L1); + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&L1); + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&L2); + } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/MOInfo.h b/psi4/src/psi4/cclambda/MOInfo.h index 562988f67b8..3c822f77d94 100644 --- a/psi4/src/psi4/cclambda/MOInfo.h +++ b/psi4/src/psi4/cclambda/MOInfo.h @@ -28,58 +28,60 @@ /*! \file \ingroup CCLAMBDA - \brief Enter brief description of file here + \brief Enter brief description of file here */ #include #include -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { struct MOInfo { - int nirreps; /* no. of irreducible representations */ - int nmo; /* no. of molecular orbitals */ - int nso; - int nao; - int *sopi; /* no. of SOs per irrep */ - int *sosym; /* SO symmetry (Pitzer) */ - int *orbspi; /* no. of MOs per irrep */ - int *clsdpi; /* no. of closed-shells per irrep excl. frdocc */ - int *openpi; /* no. of open-shells per irrep */ - int *uoccpi; /* no. of unoccupied orbitals per irrep excl. fruocc */ - int *frdocc; /* no. of frozen core orbitals per irrep */ - int *fruocc; /* no. of frozen unoccupied orbitals per irrep */ - int nvirt; /* total no. of (active) virtual orbitals */ - std::vector labels; /* irrep labels */ - int *occpi; /* no. of occupied orbs. (incl. open) per irrep */ - int *aoccpi; /* no. of alpha occupied orbs. (incl. open) per irrep */ - int *boccpi; /* no. of beta occupied orbs. (incl. open) per irrep */ - int *virtpi; /* no. of virtual orbs. (incl. open) per irrep */ - int *avirtpi; /* no. of alpha virtual orbs. (incl. open) per irrep */ - int *bvirtpi; /* no. of beta virtual orbs. (incl. open) per irrep */ - int *occ_sym; /* relative occupied index symmetry */ - int *aocc_sym; /* relative alpha occupied index symmetry */ - int *bocc_sym; /* relative beta occupied index symmetry */ - int *vir_sym; /* relative virtual index symmetry */ - int *avir_sym; /* relative alpha virtual index symmetry */ - int *bvir_sym; /* relative beta virtual index symmetry */ - int *occ_off; /* occupied orbital offsets within each irrep */ - int *aocc_off; /* occupied alpha orbital offsets within each irrep */ - int *bocc_off; /* occupied beta orbital offsets within each irrep */ - int *vir_off; /* virtual orbital offsets within each irrep */ - int *avir_off; /* virtual alpha orbital offsets within each irrep */ - int *bvir_off; /* virtual beta orbital offsets within each irrep */ - int iter; /* Current lambda iteration */ - int sym; /* symmetry of converged CCSD state */ - double conv; /* Current convergence level */ - double enuc; /* Nuclear repulsion energy */ - double escf; /* SCF energy from wfn */ - double eref; /* Reference energy (file100) */ - double ecc; /* CC energy from ccenergy */ - double lcc; /* Current lambda pseudoenergy */ - double ***C; /* virtual orbital transformation matr5ix (for AO-basis B terms) */ - double ***Ca; /* UHF alpha virtual orbital transformation matr5ix (for AO-basis B terms) */ - double ***Cb; /* UHF beta virtual orbital transformation matr5ix (for AO-basis B terms) */ + int nirreps; /* no. of irreducible representations */ + int nmo; /* no. of molecular orbitals */ + int nso; + int nao; + int *sopi; /* no. of SOs per irrep */ + int *sosym; /* SO symmetry (Pitzer) */ + int *orbspi; /* no. of MOs per irrep */ + int *clsdpi; /* no. of closed-shells per irrep excl. frdocc */ + int *openpi; /* no. of open-shells per irrep */ + int *uoccpi; /* no. of unoccupied orbitals per irrep excl. fruocc */ + int *frdocc; /* no. of frozen core orbitals per irrep */ + int *fruocc; /* no. of frozen unoccupied orbitals per irrep */ + int nvirt; /* total no. of (active) virtual orbitals */ + std::vector labels; /* irrep labels */ + int *occpi; /* no. of occupied orbs. (incl. open) per irrep */ + int *aoccpi; /* no. of alpha occupied orbs. (incl. open) per irrep */ + int *boccpi; /* no. of beta occupied orbs. (incl. open) per irrep */ + int *virtpi; /* no. of virtual orbs. (incl. open) per irrep */ + int *avirtpi; /* no. of alpha virtual orbs. (incl. open) per irrep */ + int *bvirtpi; /* no. of beta virtual orbs. (incl. open) per irrep */ + int *occ_sym; /* relative occupied index symmetry */ + int *aocc_sym; /* relative alpha occupied index symmetry */ + int *bocc_sym; /* relative beta occupied index symmetry */ + int *vir_sym; /* relative virtual index symmetry */ + int *avir_sym; /* relative alpha virtual index symmetry */ + int *bvir_sym; /* relative beta virtual index symmetry */ + int *occ_off; /* occupied orbital offsets within each irrep */ + int *aocc_off; /* occupied alpha orbital offsets within each irrep */ + int *bocc_off; /* occupied beta orbital offsets within each irrep */ + int *vir_off; /* virtual orbital offsets within each irrep */ + int *avir_off; /* virtual alpha orbital offsets within each irrep */ + int *bvir_off; /* virtual beta orbital offsets within each irrep */ + int iter; /* Current lambda iteration */ + int sym; /* symmetry of converged CCSD state */ + double conv; /* Current convergence level */ + double enuc; /* Nuclear repulsion energy */ + double escf; /* SCF energy from wfn */ + double eref; /* Reference energy (file100) */ + double ecc; /* CC energy from ccenergy */ + double lcc; /* Current lambda pseudoenergy */ + double ***C; /* virtual orbital transformation matr5ix (for AO-basis B terms) */ + double ***Ca; /* UHF alpha virtual orbital transformation matr5ix (for AO-basis B terms) */ + double ***Cb; /* UHF beta virtual orbital transformation matr5ix (for AO-basis B terms) */ }; -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/Params.h b/psi4/src/psi4/cclambda/Params.h index adfe9349daf..7e8718cbed8 100644 --- a/psi4/src/psi4/cclambda/Params.h +++ b/psi4/src/psi4/cclambda/Params.h @@ -28,50 +28,51 @@ /*! \file \ingroup CCLAMBDA - \brief Enter brief description of file here + \brief Enter brief description of file here */ #include -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* Input parameters for cclambda */ struct Params { - int maxiter; - double convergence; - int restart; - long int memory; - int cachelev; - int aobasis; - std::string wfn; - int ref; - int local; /* boolean for using simulated local-CC framework */ - int nstates; /* total number of L vectors to compute */ - int zeta; /* boolean for solving zeta equations - implies excited state*/ - int print; - int dertype; - int diis; - std::string abcd; - int sekino; /* Sekino-Bartlett size-extensive models */ - /* the following should be obseleted now or soon */ - int all; /* find Ls for all excited states plus ground state */ - int ground; /* find L for only ground state */ - int num_amps; + int maxiter; + double convergence; + int restart; + long int memory; + int cachelev; + int aobasis; + std::string wfn; + int ref; + int local; /* boolean for using simulated local-CC framework */ + int nstates; /* total number of L vectors to compute */ + int zeta; /* boolean for solving zeta equations - implies excited state*/ + int print; + int dertype; + int diis; + std::string abcd; + int sekino; /* Sekino-Bartlett size-extensive models */ + /* the following should be obseleted now or soon */ + int all; /* find Ls for all excited states plus ground state */ + int ground; /* find L for only ground state */ + int num_amps; }; struct L_Params { - int irrep; /* same as corresponding R */ - double R0; /* same as corresponding R */ - double cceom_energy; /* same as corresponding R */ - int root; /* index of root within irrep */ - int ground; /* boolean, is this a ground state L ? */ - char L1A_lbl[32]; - char L1B_lbl[32]; - char L2AA_lbl[32]; - char L2BB_lbl[32]; - char L2AB_lbl[32]; - char L2RHF_lbl[32]; + int irrep; /* same as corresponding R */ + double R0; /* same as corresponding R */ + double cceom_energy; /* same as corresponding R */ + int root; /* index of root within irrep */ + int ground; /* boolean, is this a ground state L ? */ + char L1A_lbl[32]; + char L1B_lbl[32]; + char L2AA_lbl[32]; + char L2BB_lbl[32]; + char L2AB_lbl[32]; + char L2RHF_lbl[32]; }; - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WabeiL1.cc b/psi4/src/psi4/cclambda/WabeiL1.cc index 770f7b0aac4..581d7014f83 100644 --- a/psi4/src/psi4/cclambda/WabeiL1.cc +++ b/psi4/src/psi4/cclambda/WabeiL1.cc @@ -37,38 +37,39 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -void WabeiL1(int L_irr) -{ - dpdfile2 newL1; - dpdbuf4 W, L2; +void WabeiL1(int L_irr) { + dpdfile2 newL1; + dpdbuf4 W, L2; - global_dpd_->file2_init(&newL1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New L(I,A)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "W(AM,EF)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "L2(IM,EF)"); - global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "W(Am,Ef)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "L2(Im,Ef)"); - global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->file2_close(&newL1); + global_dpd_->file2_init(&newL1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New L(I,A)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "W(AM,EF)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "L2(IM,EF)"); + global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "W(Am,Ef)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "L2(Im,Ef)"); + global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->file2_close(&newL1); - global_dpd_->file2_init(&newL1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New L(i,a)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "W(am,ef)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "L2(im,ef)"); - global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "W(aM,eF)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "L2(iM,eF)"); - global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->file2_close(&newL1); + global_dpd_->file2_init(&newL1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New L(i,a)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "W(am,ef)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "L2(im,ef)"); + global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "W(aM,eF)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "L2(iM,eF)"); + global_dpd_->contract442(&L2, &W, &newL1, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->file2_close(&newL1); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WefabL2.cc b/psi4/src/psi4/cclambda/WefabL2.cc index b53c40969c1..2e8695c779f 100644 --- a/psi4/src/psi4/cclambda/WefabL2.cc +++ b/psi4/src/psi4/cclambda/WefabL2.cc @@ -42,7 +42,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* WefabL2(): Computes the contribution of the Wefab HBAR matrix ** elements to the Lambda double de-excitation amplitude equations. @@ -107,439 +108,431 @@ namespace psi { namespace cclambda { ** TDC, July 2002 */ -void WefabL2(int L_irr) -{ - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLijab, newLIJAB, newLIjAb; - dpdbuf4 Tau, T2, Z, Z1, Z2, L, L2, B, D, F, Ltmp; - dpdfile2 tIA, tia; - dpdbuf4 tau_a, tau_s, tau; - dpdbuf4 B_a, B_s; - dpdbuf4 S, A; - int h; - double **B_diag, **tau_diag; - int ij, Gc, C, c, cc; - int nbuckets, rows_per_bucket, rows_left, m, row_start, ab, cd, dc, d; - int nrows, ncols, nlinks; - psio_address next; - - /* RHS += Wefab*Lijef */ - if(params.ref == 0) { /** RHF **/ - - if(params.abcd == "OLD") { - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "ZAbIj"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 5, 5, 5, 5, 0, "B "); - global_dpd_->contract444(&B, &LIjAb, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&LIjAb); +void WefabL2(int L_irr) { + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLijab, newLIJAB, newLIjAb; + dpdbuf4 Tau, T2, Z, Z1, Z2, L, L2, B, D, F, Ltmp; + dpdfile2 tIA, tia; + dpdbuf4 tau_a, tau_s, tau; + dpdbuf4 B_a, B_s; + dpdbuf4 S, A; + int h; + double **B_diag, **tau_diag; + int ij, Gc, C, c, cc; + int nbuckets, rows_per_bucket, rows_left, m, row_start, ab, cd, dc, d; + int nrows, ncols, nlinks; + psio_address next; + + /* RHS += Wefab*Lijef */ + if (params.ref == 0) { /** RHF **/ + + if (params.abcd == "OLD") { + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "ZAbIj"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 5, 5, 5, 5, 0, "B "); + global_dpd_->contract444(&B, &LIjAb, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&LIjAb); + } else if (params.abcd == "NEW") { + timer_on("ABCD:new"); + + /* L_a(-)(ij,ab) (i>j, a>b) = L(ij,ab) - L(ij,ba) */ + global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 4, 9, 0, 5, 1, "LIjAb"); + global_dpd_->buf4_copy(&tau_a, PSIF_CC_LAMBDA, "L(-)(ij,ab)"); + global_dpd_->buf4_close(&tau_a); + + /* L_s(+)(ij,ab) (i>=j, a>=b) = L(ij,ab) + L(ij,ba) */ + global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_copy(&tau_a, PSIF_CC_TMP0, "L(+)(ij,ab)"); + global_dpd_->buf4_sort_axpy(&tau_a, PSIF_CC_TMP0, pqsr, 0, 5, "L(+)(ij,ab)", 1); + global_dpd_->buf4_close(&tau_a); + global_dpd_->buf4_init(&tau_a, PSIF_CC_TMP0, L_irr, 3, 8, 0, 5, 0, "L(+)(ij,ab)"); + global_dpd_->buf4_copy(&tau_a, PSIF_CC_LAMBDA, "L(+)(ij,ab)"); + global_dpd_->buf4_close(&tau_a); + + timer_on("ABCD:S"); + global_dpd_->buf4_init(&tau_s, PSIF_CC_LAMBDA, L_irr, 3, 8, 3, 8, 0, "L(+)(ij,ab)"); + global_dpd_->buf4_init(&B_s, PSIF_CC_BINTS, 0, 8, 8, 8, 8, 0, "B(+) + "); + global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 8, 3, 8, 3, 0, "S(ab,ij)"); + global_dpd_->contract444(&B_s, &tau_s, &S, 0, 0, 0.5, 0); + global_dpd_->buf4_close(&S); + global_dpd_->buf4_close(&B_s); + global_dpd_->buf4_close(&tau_s); + timer_off("ABCD:S"); + + /* L_diag(ij,c) = 2 * L(ij,cc)*/ + + /* NB: Gcc = 0, and B is totally symmetric, so Gab = 0 */ + /* But Gij = L_irr ^ Gab = L_irr */ + global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 3, 8, 3, 8, 0, "L(+)(ij,ab)"); + global_dpd_->buf4_mat_irrep_init(&tau, L_irr); + global_dpd_->buf4_mat_irrep_rd(&tau, L_irr); + tau_diag = global_dpd_->dpd_block_matrix(tau.params->rowtot[L_irr], moinfo.nvirt); + for (ij = 0; ij < tau.params->rowtot[L_irr]; ij++) + for (Gc = 0; Gc < moinfo.nirreps; Gc++) + for (C = 0; C < moinfo.virtpi[Gc]; C++) { + c = C + moinfo.vir_off[Gc]; + cc = tau.params->colidx[c][c]; + tau_diag[ij][c] = tau.matrix[L_irr][ij][cc]; + } + global_dpd_->buf4_mat_irrep_close(&tau, L_irr); + + global_dpd_->buf4_init(&B_s, PSIF_CC_BINTS, 0, 8, 8, 8, 8, 0, "B(+) + "); + global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 8, 3, 8, 3, 0, "S(ab,ij)"); + global_dpd_->buf4_mat_irrep_init(&S, 0); + global_dpd_->buf4_mat_irrep_rd(&S, 0); + + rows_per_bucket = dpd_memfree() / (B_s.params->coltot[0] + moinfo.nvirt); + if (rows_per_bucket > B_s.params->rowtot[0]) rows_per_bucket = B_s.params->rowtot[0]; + nbuckets = (int)ceil((double)B_s.params->rowtot[0] / (double)rows_per_bucket); + rows_left = B_s.params->rowtot[0] % rows_per_bucket; + + B_diag = global_dpd_->dpd_block_matrix(rows_per_bucket, moinfo.nvirt); + next = PSIO_ZERO; + ncols = tau.params->rowtot[L_irr]; + nlinks = moinfo.nvirt; + for (m = 0; m < (rows_left ? nbuckets - 1 : nbuckets); m++) { + row_start = m * rows_per_bucket; + nrows = rows_per_bucket; + if (nrows && ncols && nlinks) { + psio_read(PSIF_CC_BINTS, "B(+) ", (char *)B_diag[0], nrows * nlinks * sizeof(double), next, + &next); + C_DGEMM('n', 't', nrows, ncols, nlinks, -0.25, B_diag[0], nlinks, tau_diag[0], nlinks, 1, + S.matrix[0][row_start], ncols); + } + } + if (rows_left) { + row_start = m * rows_per_bucket; + nrows = rows_left; + if (nrows && ncols && nlinks) { + psio_read(PSIF_CC_BINTS, "B(+) ", (char *)B_diag[0], nrows * nlinks * sizeof(double), next, + &next); + C_DGEMM('n', 't', nrows, ncols, nlinks, -0.25, B_diag[0], nlinks, tau_diag[0], nlinks, 1, + S.matrix[0][row_start], ncols); + } + } + global_dpd_->buf4_mat_irrep_wrt(&S, 0); + global_dpd_->buf4_mat_irrep_close(&S, 0); + global_dpd_->buf4_close(&S); + global_dpd_->buf4_close(&B_s); + global_dpd_->free_dpd_block(B_diag, rows_per_bucket, moinfo.nvirt); + global_dpd_->free_dpd_block(tau_diag, tau.params->rowtot[L_irr], moinfo.nvirt); + global_dpd_->buf4_close(&tau); + + timer_on("ABCD:A"); + global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 4, 9, 4, 9, 0, "L(-)(ij,ab)"); + global_dpd_->buf4_init(&B_a, PSIF_CC_BINTS, 0, 9, 9, 9, 9, 0, "B(-) - "); + global_dpd_->buf4_init(&A, PSIF_CC_TMP0, L_irr, 9, 4, 9, 4, 0, "A(ab,ij)"); + global_dpd_->contract444(&B_a, &tau_a, &A, 0, 0, 0.5, 0); + global_dpd_->buf4_close(&A); + global_dpd_->buf4_close(&B_a); + global_dpd_->buf4_close(&tau_a); + timer_off("ABCD:A"); + + timer_on("ABCD:axpy"); + global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 5, 0, 8, 3, 0, "S(ab,ij)"); + global_dpd_->buf4_sort_axpy(&S, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&S); + global_dpd_->buf4_init(&A, PSIF_CC_TMP0, L_irr, 5, 0, 9, 4, 0, "A(ab,ij)"); + global_dpd_->buf4_sort_axpy(&A, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&A); + timer_off("ABCD:axpy"); + timer_off("ABCD:new"); + } + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 0, 10, 0, 0, "Z(Mf,Ij)"); + global_dpd_->contract244(&tIA, &LIjAb, &Z, 1, 2, 0, 1, 0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->file2_close(&tIA); + + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 5, 10, 5, 0, "F "); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 0, 10, 0, 0, "Z(Mf,Ij)"); + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "Z(Ab,Ij)"); + global_dpd_->contract444(&F, &Z, &Z1, 1, 1, -1, 0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&newLIjAb); + global_dpd_->buf4_sort_axpy(&Z1, PSIF_CC_LAMBDA, srqp, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_sort_axpy(&Z1, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_close(&Z1); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 0, 0, 0, 0, "Z(Ij,Mn)"); + global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tauIjAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Tau); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract444(&Z, &D, &newLIjAb, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_close(&newLIjAb); + + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_init(&tia, PSIF_CC_OEI, 0, 0, 1, "tia"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 7, 2, 7, 2, 0, "ZABIJ"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); + global_dpd_->contract444(&B, &LIJAB, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New LIJAB", 1); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP0, L_irr, 2, 10, 2, 10, 0, "Ltmp (I>J,MF)"); + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 7, 10, 5, 1, "F "); + global_dpd_->contract244(&tIA, &LIJAB, &Ltmp, 1, 2, 1, 1.0, 0.0); + global_dpd_->contract444(&Ltmp, &F, &newLIJAB, 0, 1, -1.0, 1.0); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&Ltmp); + global_dpd_->buf4_close(&LIJAB); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 2, 2, 2, 2, 0, "Z(IJ,MN)"); + global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauIJAB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Tau); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); + global_dpd_->contract444(&Z, &D, &newLIJAB, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 7, 2, 7, 2, 0, "Zabij"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); + global_dpd_->contract444(&B, &Lijab, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New Lijab", 1); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP0, L_irr, 2, 10, 2, 10, 0, "Ltmp (i>j,mf)"); + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 7, 10, 5, 1, "F "); + global_dpd_->contract244(&tia, &Lijab, &Ltmp, 1, 2, 1, 1.0, 0.0); + global_dpd_->contract444(&Ltmp, &F, &newLijab, 0, 1, -1.0, 1.0); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&Ltmp); + global_dpd_->buf4_close(&Lijab); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 2, 2, 2, 2, 0, "Z(ij,mn)"); + global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauijab"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Tau); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); + global_dpd_->contract444(&Z, &D, &newLijab, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 5, 0, 5, 0, 0, "ZAbIj"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 5, 5, 5, 5, 0, "B "); + global_dpd_->contract444(&B, &LIjAb, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP1, L_irr, 0, 11, 0, 11, 0, "Lt (Ij,Em)"); + global_dpd_->contract424(&LIjAb, &tia, &Ltmp, 3, 1, 0, 1.0, 0.0); + global_dpd_->buf4_sort(&Ltmp, PSIF_CC_TMP2, pqsr, 0, 10, "Lt (Ij,mE)"); + global_dpd_->buf4_close(&Ltmp); + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP3, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,Mf)"); + global_dpd_->contract244(&tIA, &LIjAb, &Ltmp, 1, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&Ltmp); + + global_dpd_->buf4_close(&LIjAb); + + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 5, 10, 5, 0, "F "); + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP3, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,Mf)"); + global_dpd_->contract444(&Ltmp, &F, &newLIjAb, 0, 1, -1.0, 1.0); + global_dpd_->buf4_close(&Ltmp); + global_dpd_->buf4_sort(&F, PSIF_CC_TMP0, pqsr, 10, 5, " (mE,Ab)"); + global_dpd_->buf4_close(&F); + + global_dpd_->buf4_init(&F, PSIF_CC_TMP0, 0, 10, 5, 10, 5, 0, " (mE,Ab)"); + global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP2, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,mE)"); + global_dpd_->contract444(&Ltmp, &F, &newLIjAb, 0, 1, -1.0, 1.0); + global_dpd_->buf4_close(&Ltmp); + global_dpd_->buf4_close(&F); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 0, 0, 0, 0, "Z(Ij,Mn)"); + global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tauIjAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Tau); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->contract444(&Z, &D, &newLIjAb, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&tIA); + global_dpd_->file2_close(&tia); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_init(&tia, PSIF_CC_OEI, 0, 2, 3, "tia"); + + /** Z(AB,IJ) = L(IJ,CD) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 7, 2, 7, 2, 0, "Z(AB,IJ)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); + global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_close(&L2); + /** Z(AB,IJ) --> New L(IJ,AB) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New LIJAB", 1); + global_dpd_->buf4_close(&Z); + + /** Z(IJ,EM) = -L(IJ,EFf) t(M,F) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 2, 21, 2, 21, 0, "Z(IJ,EM)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract424(&L2, &tIA, &Z, 3, 1, 0, -1, 0); + global_dpd_->buf4_close(&L2); + /** New L(IJ,AB) <-- Z(IJ,EM) **/ + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 21, 7, 21, 5, 1, "F "); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&Z); + + /** Z(IJ,MN) = 1/2 L(IJ,EF) tau_MN^EF **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 2, 2, 2, 2, 0, "Z(IJ,MN)"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauIJAB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&T2); + /** New L(IJ,AB) <-- 1/2 Z(IJ,MN) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); + global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z); + + /** Z(ab,ij) = L(ij,cd) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 17, 12, 17, 12, 0, "Z(ab,ij)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 17, 17, 15, 15, 1, "B "); + global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_close(&L2); + /** Z(ab,ij) --> New L(ij,ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 12, 17, "New Lijab", 1); + global_dpd_->buf4_close(&Z); + + /** Z(ij,em) = -L(ij,ef) t(m,f) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 12, 31, 12, 31, 0, "Z(ij,em)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract424(&L2, &tia, &Z, 3, 1, 0, -1, 0); + global_dpd_->buf4_close(&L2); + /** New L(ij,ab) <-- Z(ij,em) **/ + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 31, 17, 31, 15, 1, "F "); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&Z); + + /** Z(ij,mn) = 1/2 L(ij,ef) tau_mn^ef **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 12, 12, 12, 12, 0, "Z(ij,mn)"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tauijab"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&T2); + /** New L(ij,ab) <-- 1/2 Z(ij,mn) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); + global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z); + + /** Z(Ab,Ij) = L(Ij,Cd) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 28, 22, 28, 22, 0, "Z(Ab,Ij)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 28, 28, 28, 28, 0, "B "); + global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&B); + global_dpd_->buf4_close(&L2); + /** Z(Ab,Ij) --> New L(Ij,Ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + /** Z(Ij,Em) = -L(Ij,Ef) t(m,f) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 26, 22, 26, 0, "Z(Ij,Em)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract424(&L2, &tia, &Z, 3, 1, 0, -1, 0); + global_dpd_->buf4_close(&L2); + /** New L(Ij,Ab) <-- Z(Ij,Em) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 26, 28, 26, 28, 0, "F "); + global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z); + + /** Z(Ij,Mf) = -t(M,E) L(Ij,Ef) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 24, 22, 24, 0, "Z(Ij,Mf)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract244(&tIA, &L2, &Z, 1, 2, 1, -1, 0); + global_dpd_->buf4_close(&L2); + /** New L(Ij,Ab) <-- Z(Ij,Mf) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 24, 28, 24, 28, 0, "F "); + global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z); + + /** Z(Ij,Mn) = L(Ij,Ef) tau(Mn,Ef) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 22, 22, 22, 0, "Z(Ij,Mn)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tauIjAb"); + global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + /** New L(Ij,Ab) <-- Z(Ij,Mn) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); + global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&tIA); + global_dpd_->file2_close(&tia); } - else if(params.abcd == "NEW") { - timer_on("ABCD:new"); - - /* L_a(-)(ij,ab) (i>j, a>b) = L(ij,ab) - L(ij,ba) */ - global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 4, 9, 0, 5, 1, "LIjAb"); - global_dpd_->buf4_copy(&tau_a, PSIF_CC_LAMBDA, "L(-)(ij,ab)"); - global_dpd_->buf4_close(&tau_a); - - /* L_s(+)(ij,ab) (i>=j, a>=b) = L(ij,ab) + L(ij,ba) */ - global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_copy(&tau_a, PSIF_CC_TMP0, "L(+)(ij,ab)"); - global_dpd_->buf4_sort_axpy(&tau_a, PSIF_CC_TMP0, pqsr, 0, 5, "L(+)(ij,ab)", 1); - global_dpd_->buf4_close(&tau_a); - global_dpd_->buf4_init(&tau_a, PSIF_CC_TMP0, L_irr, 3, 8, 0, 5, 0, "L(+)(ij,ab)"); - global_dpd_->buf4_copy(&tau_a, PSIF_CC_LAMBDA, "L(+)(ij,ab)"); - global_dpd_->buf4_close(&tau_a); - - timer_on("ABCD:S"); - global_dpd_->buf4_init(&tau_s, PSIF_CC_LAMBDA, L_irr, 3, 8, 3, 8, 0, "L(+)(ij,ab)"); - global_dpd_->buf4_init(&B_s, PSIF_CC_BINTS, 0, 8, 8, 8, 8, 0, "B(+) + "); - global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 8, 3, 8, 3, 0, "S(ab,ij)"); - global_dpd_->contract444(&B_s, &tau_s, &S, 0, 0, 0.5, 0); - global_dpd_->buf4_close(&S); - global_dpd_->buf4_close(&B_s); - global_dpd_->buf4_close(&tau_s); - timer_off("ABCD:S"); - - /* L_diag(ij,c) = 2 * L(ij,cc)*/ - - /* NB: Gcc = 0, and B is totally symmetric, so Gab = 0 */ - /* But Gij = L_irr ^ Gab = L_irr */ - global_dpd_->buf4_init(&tau, PSIF_CC_LAMBDA, L_irr, 3, 8, 3, 8, 0, "L(+)(ij,ab)"); - global_dpd_->buf4_mat_irrep_init(&tau, L_irr); - global_dpd_->buf4_mat_irrep_rd(&tau, L_irr); - tau_diag = global_dpd_->dpd_block_matrix(tau.params->rowtot[L_irr], moinfo.nvirt); - for(ij=0; ij < tau.params->rowtot[L_irr]; ij++) - for(Gc=0; Gc < moinfo.nirreps; Gc++) - for(C=0; C < moinfo.virtpi[Gc]; C++) { - c = C + moinfo.vir_off[Gc]; - cc = tau.params->colidx[c][c]; - tau_diag[ij][c] = tau.matrix[L_irr][ij][cc]; - } - global_dpd_->buf4_mat_irrep_close(&tau, L_irr); - - global_dpd_->buf4_init(&B_s, PSIF_CC_BINTS, 0, 8, 8, 8, 8, 0, "B(+) + "); - global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 8, 3, 8, 3, 0, "S(ab,ij)"); - global_dpd_->buf4_mat_irrep_init(&S, 0); - global_dpd_->buf4_mat_irrep_rd(&S, 0); - - rows_per_bucket = dpd_memfree()/(B_s.params->coltot[0] + moinfo.nvirt); - if(rows_per_bucket > B_s.params->rowtot[0]) rows_per_bucket = B_s.params->rowtot[0]; - nbuckets = (int) ceil((double) B_s.params->rowtot[0]/(double) rows_per_bucket); - rows_left = B_s.params->rowtot[0] % rows_per_bucket; - - B_diag = global_dpd_->dpd_block_matrix(rows_per_bucket, moinfo.nvirt); - next = PSIO_ZERO; - ncols = tau.params->rowtot[L_irr]; - nlinks = moinfo.nvirt; - for(m=0; m < (rows_left ? nbuckets-1:nbuckets); m++) { - row_start = m * rows_per_bucket; - nrows = rows_per_bucket; - if(nrows && ncols && nlinks) { - psio_read(PSIF_CC_BINTS,"B(+) ",(char *) B_diag[0],nrows*nlinks*sizeof(double),next, &next); - C_DGEMM('n', 't', nrows, ncols, nlinks, -0.25, B_diag[0], nlinks, - tau_diag[0], nlinks, 1, S.matrix[0][row_start], ncols); - } - - } - if(rows_left) { - row_start = m * rows_per_bucket; - nrows = rows_left; - if(nrows && ncols && nlinks) { - psio_read(PSIF_CC_BINTS,"B(+) ",(char *) B_diag[0],nrows*nlinks*sizeof(double),next, &next); - C_DGEMM('n', 't', nrows, ncols, nlinks, -0.25, B_diag[0], nlinks, - tau_diag[0], nlinks, 1, S.matrix[0][row_start], ncols); - } - } - global_dpd_->buf4_mat_irrep_wrt(&S, 0); - global_dpd_->buf4_mat_irrep_close(&S, 0); - global_dpd_->buf4_close(&S); - global_dpd_->buf4_close(&B_s); - global_dpd_->free_dpd_block(B_diag, rows_per_bucket, moinfo.nvirt); - global_dpd_->free_dpd_block(tau_diag, tau.params->rowtot[L_irr], moinfo.nvirt); - global_dpd_->buf4_close(&tau); - - timer_on("ABCD:A"); - global_dpd_->buf4_init(&tau_a, PSIF_CC_LAMBDA, L_irr, 4, 9, 4, 9, 0, "L(-)(ij,ab)"); - global_dpd_->buf4_init(&B_a, PSIF_CC_BINTS, 0, 9, 9, 9, 9, 0, "B(-) - "); - global_dpd_->buf4_init(&A, PSIF_CC_TMP0, L_irr, 9, 4, 9, 4, 0, "A(ab,ij)"); - global_dpd_->contract444(&B_a, &tau_a, &A, 0, 0, 0.5, 0); - global_dpd_->buf4_close(&A); - global_dpd_->buf4_close(&B_a); - global_dpd_->buf4_close(&tau_a); - timer_off("ABCD:A"); - - timer_on("ABCD:axpy"); - global_dpd_->buf4_init(&S, PSIF_CC_TMP0, L_irr, 5, 0, 8, 3, 0, "S(ab,ij)"); - global_dpd_->buf4_sort_axpy(&S, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&S); - global_dpd_->buf4_init(&A, PSIF_CC_TMP0, L_irr, 5, 0, 9, 4, 0, "A(ab,ij)"); - global_dpd_->buf4_sort_axpy(&A, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&A); - timer_off("ABCD:axpy"); - timer_off("ABCD:new"); - } - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 0, 10, 0, 0, "Z(Mf,Ij)"); - global_dpd_->contract244(&tIA, &LIjAb, &Z, 1, 2, 0, 1, 0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->file2_close(&tIA); - - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 5, 10, 5, 0, "F "); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 0, 10, 0, 0, "Z(Mf,Ij)"); - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "Z(Ab,Ij)"); - global_dpd_->contract444(&F, &Z, &Z1, 1, 1, -1, 0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&newLIjAb); - global_dpd_->buf4_sort_axpy(&Z1, PSIF_CC_LAMBDA, srqp, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_sort_axpy(&Z1, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_close(&Z1); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 0, 0, 0, 0, "Z(Ij,Mn)"); - global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tauIjAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Tau); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract444(&Z, &D, &newLIjAb, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_close(&newLIjAb); - - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_init(&tia, PSIF_CC_OEI, 0, 0, 1, "tia"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 7, 2, 7, 2, 0, "ZABIJ"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); - global_dpd_->contract444(&B, &LIJAB, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New LIJAB", 1); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP0, L_irr, 2, 10, 2, 10, 0, "Ltmp (I>J,MF)"); - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 7, 10, 5, 1, "F "); - global_dpd_->contract244(&tIA, &LIJAB, &Ltmp, 1, 2, 1, 1.0, 0.0); - global_dpd_->contract444(&Ltmp, &F, &newLIJAB, 0, 1, -1.0, 1.0); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&Ltmp); - global_dpd_->buf4_close(&LIJAB); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 2, 2, 2, 2, 0, "Z(IJ,MN)"); - global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauIJAB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Tau); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); - global_dpd_->contract444(&Z, &D, &newLIJAB, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 7, 2, 7, 2, 0, "Zabij"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); - global_dpd_->contract444(&B, &Lijab, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New Lijab", 1); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP0, L_irr, 2, 10, 2, 10, 0, "Ltmp (i>j,mf)"); - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 7, 10, 5, 1, "F "); - global_dpd_->contract244(&tia, &Lijab, &Ltmp, 1, 2, 1, 1.0, 0.0); - global_dpd_->contract444(&Ltmp, &F, &newLijab, 0, 1, -1.0, 1.0); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&Ltmp); - global_dpd_->buf4_close(&Lijab); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 2, 2, 2, 2, 0, "Z(ij,mn)"); - global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauijab"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Tau); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); - global_dpd_->contract444(&Z, &D, &newLijab, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newLijab); - - - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 5, 0, 5, 0, 0, "ZAbIj"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 5, 5, 5, 5, 0, "B "); - global_dpd_->contract444(&B, &LIjAb, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP1, L_irr, 0, 11, 0, 11, 0, "Lt (Ij,Em)"); - global_dpd_->contract424(&LIjAb, &tia, &Ltmp, 3, 1, 0, 1.0, 0.0); - global_dpd_->buf4_sort(&Ltmp, PSIF_CC_TMP2, pqsr, 0, 10, "Lt (Ij,mE)"); - global_dpd_->buf4_close(&Ltmp); - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP3, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,Mf)"); - global_dpd_->contract244(&tIA, &LIjAb, &Ltmp, 1, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&Ltmp); - - global_dpd_->buf4_close(&LIjAb); - - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 10, 5, 10, 5, 0, "F "); - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP3, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,Mf)"); - global_dpd_->contract444(&Ltmp, &F, &newLIjAb, 0, 1, -1.0, 1.0); - global_dpd_->buf4_close(&Ltmp); - global_dpd_->buf4_sort(&F, PSIF_CC_TMP0, pqsr, 10, 5, " (mE,Ab)"); - global_dpd_->buf4_close(&F); - - global_dpd_->buf4_init(&F, PSIF_CC_TMP0, 0, 10, 5, 10, 5, 0, " (mE,Ab)"); - global_dpd_->buf4_init(&Ltmp, PSIF_CC_TMP2, L_irr, 0, 10, 0, 10, 0, "Lt (Ij,mE)"); - global_dpd_->contract444(&Ltmp, &F, &newLIjAb, 0, 1, -1.0, 1.0); - global_dpd_->buf4_close(&Ltmp); - global_dpd_->buf4_close(&F); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 0, 0, 0, 0, "Z(Ij,Mn)"); - global_dpd_->buf4_init(&Tau, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tauIjAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract444(&L2, &Tau, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Tau); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->contract444(&Z, &D, &newLIjAb, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&tIA); - global_dpd_->file2_close(&tia); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&tIA, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_init(&tia, PSIF_CC_OEI, 0, 2, 3, "tia"); - - - /** Z(AB,IJ) = L(IJ,CD) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 7, 2, 7, 2, 0, "Z(AB,IJ)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 7, 7, 5, 5, 1, "B "); - global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_close(&L2); - /** Z(AB,IJ) --> New L(IJ,AB) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 2, 7, "New LIJAB", 1); - global_dpd_->buf4_close(&Z); - - /** Z(IJ,EM) = -L(IJ,EFf) t(M,F) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 2, 21, 2, 21, 0, "Z(IJ,EM)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract424(&L2, &tIA, &Z, 3, 1, 0, -1, 0); - global_dpd_->buf4_close(&L2); - /** New L(IJ,AB) <-- Z(IJ,EM) **/ - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 21, 7, 21, 5, 1, "F "); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&Z); - - /** Z(IJ,MN) = 1/2 L(IJ,EF) tau_MN^EF **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 2, 2, 2, 2, 0, "Z(IJ,MN)"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tauIJAB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&T2); - /** New L(IJ,AB) <-- 1/2 Z(IJ,MN) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); - global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z); - - - /** Z(ab,ij) = L(ij,cd) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 17, 12, 17, 12, 0, "Z(ab,ij)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 17, 17, 15, 15, 1, "B "); - global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_close(&L2); - /** Z(ab,ij) --> New L(ij,ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 12, 17, "New Lijab", 1); - global_dpd_->buf4_close(&Z); - - /** Z(ij,em) = -L(ij,ef) t(m,f) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 12, 31, 12, 31, 0, "Z(ij,em)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract424(&L2, &tia, &Z, 3, 1, 0, -1, 0); - global_dpd_->buf4_close(&L2); - /** New L(ij,ab) <-- Z(ij,em) **/ - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 31, 17, 31, 15, 1, "F "); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&Z); - - /** Z(ij,mn) = 1/2 L(ij,ef) tau_mn^ef **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 12, 12, 12, 12, 0, "Z(ij,mn)"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tauijab"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&T2); - /** New L(ij,ab) <-- 1/2 Z(ij,mn) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); - global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z); - - - /** Z(Ab,Ij) = L(Ij,Cd) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 28, 22, 28, 22, 0, "Z(Ab,Ij)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&B, PSIF_CC_BINTS, 0, 28, 28, 28, 28, 0, "B "); - global_dpd_->contract444(&B, &L2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&B); - global_dpd_->buf4_close(&L2); - /** Z(Ab,Ij) --> New L(Ij,Ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rspq, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - /** Z(Ij,Em) = -L(Ij,Ef) t(m,f) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 26, 22, 26, 0, "Z(Ij,Em)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract424(&L2, &tia, &Z, 3, 1, 0, -1, 0); - global_dpd_->buf4_close(&L2); - /** New L(Ij,Ab) <-- Z(Ij,Em) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 26, 28, 26, 28, 0, "F "); - global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z); - - /** Z(Ij,Mf) = -t(M,E) L(Ij,Ef) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 24, 22, 24, 0, "Z(Ij,Mf)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract244(&tIA, &L2, &Z, 1, 2, 1, -1, 0); - global_dpd_->buf4_close(&L2); - /** New L(Ij,Ab) <-- Z(Ij,Mf) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&F, PSIF_CC_FINTS, 0, 24, 28, 24, 28, 0, "F "); - global_dpd_->contract444(&Z, &F, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z); - - /** Z(Ij,Mn) = L(Ij,Ef) tau(Mn,Ef) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 22, 22, 22, 22, 0, "Z(Ij,Mn)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tauIjAb"); - global_dpd_->contract444(&L2, &T2, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - /** New L(Ij,Ab) <-- Z(Ij,Mn) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); - global_dpd_->contract444(&Z, &D, &L2, 0, 1, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&tIA); - global_dpd_->file2_close(&tia); - - } - } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WejabL2.cc b/psi4/src/psi4/cclambda/WejabL2.cc index e333854c624..21e36655840 100644 --- a/psi4/src/psi4/cclambda/WejabL2.cc +++ b/psi4/src/psi4/cclambda/WejabL2.cc @@ -39,7 +39,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* WejabL2(): Computes the contribution of the Wamef HBAR matrix ** elements to the Lambda double de-excitation amplitude equations. @@ -65,202 +66,197 @@ namespace psi { namespace cclambda { ** for the Wamef matrix elements, as I've done for the UHF case. */ -void WejabL2(int L_irr) -{ - int GW, GL1, GZ, Gej, Gab, Gi, Ge, Gij, Gj, Ga; - int e, E, i, I, num_j, num_i, num_e, nlinks; - dpdbuf4 W, L2; - dpdfile2 LIA, Lia; - dpdbuf4 Z, Z1, Z2; - - /* RHS += P(ij) Lie * Wejab */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "ZIjAb"); - global_dpd_->buf4_scm(&Z, 0); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); - /* dpd_contract244(&LIA, &W, &Z, 1, 2, 1, 1, 0); */ - /* Out-of-core contract244 */ - GW = W.file.my_irrep; - GZ = Z.file.my_irrep; - GL1 = LIA.my_irrep; - - global_dpd_->file2_mat_init(&LIA); - global_dpd_->file2_mat_rd(&LIA); - - for(Gej=0; Gej < moinfo.nirreps; Gej++) { - Gab = Gej^GW; - Gij = Gab^GZ; - - global_dpd_->buf4_mat_irrep_init(&Z, Gij); - - for(Ge=0; Ge < moinfo.nirreps; Ge++) { - Gi = Ge^GL1; - Gj = GZ^Gab^Gi; - - num_j = Z.params->qpi[Gj]; - num_i = LIA.params->rowtot[Gi]; - num_e = LIA.params->coltot[Ge]; - - global_dpd_->buf4_mat_irrep_init_block(&W, Gej, num_j); - - for(e=0; e < num_e; e++) { - - E = W.params->poff[Ge] + e; - global_dpd_->buf4_mat_irrep_rd_block(&W, Gej, W.row_offset[Gej][E], num_j); - - for(i=0; i < num_i; i++) { - I = Z.params->poff[Gi] + i; - - nlinks = Z.params->coltot[Gab] * num_j; - if(nlinks) { - C_DAXPY(nlinks, LIA.matrix[Gi][i][e], - &(W.matrix[Gej][0][0]),1, - &(Z.matrix[Gij][Z.row_offset[Gij][I]][0]),1); - } - } - } - global_dpd_->buf4_mat_irrep_close_block(&W, Gej, num_j); - } - global_dpd_->buf4_mat_irrep_wrt(&Z, Gij); - global_dpd_->buf4_mat_irrep_close(&Z, Gij); +void WejabL2(int L_irr) { + int GW, GL1, GZ, Gej, Gab, Gi, Ge, Gij, Gj, Ga; + int e, E, i, I, num_j, num_i, num_e, nlinks; + dpdbuf4 W, L2; + dpdfile2 LIA, Lia; + dpdbuf4 Z, Z1, Z2; + + /* RHS += P(ij) Lie * Wejab */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "ZIjAb"); + global_dpd_->buf4_scm(&Z, 0); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); + /* dpd_contract244(&LIA, &W, &Z, 1, 2, 1, 1, 0); */ + /* Out-of-core contract244 */ + GW = W.file.my_irrep; + GZ = Z.file.my_irrep; + GL1 = LIA.my_irrep; + + global_dpd_->file2_mat_init(&LIA); + global_dpd_->file2_mat_rd(&LIA); + + for (Gej = 0; Gej < moinfo.nirreps; Gej++) { + Gab = Gej ^ GW; + Gij = Gab ^ GZ; + + global_dpd_->buf4_mat_irrep_init(&Z, Gij); + + for (Ge = 0; Ge < moinfo.nirreps; Ge++) { + Gi = Ge ^ GL1; + Gj = GZ ^ Gab ^ Gi; + + num_j = Z.params->qpi[Gj]; + num_i = LIA.params->rowtot[Gi]; + num_e = LIA.params->coltot[Ge]; + + global_dpd_->buf4_mat_irrep_init_block(&W, Gej, num_j); + + for (e = 0; e < num_e; e++) { + E = W.params->poff[Ge] + e; + global_dpd_->buf4_mat_irrep_rd_block(&W, Gej, W.row_offset[Gej][E], num_j); + + for (i = 0; i < num_i; i++) { + I = Z.params->poff[Gi] + i; + + nlinks = Z.params->coltot[Gab] * num_j; + if (nlinks) { + C_DAXPY(nlinks, LIA.matrix[Gi][i][e], &(W.matrix[Gej][0][0]), 1, + &(Z.matrix[Gij][Z.row_offset[Gij][I]][0]), 1); + } + } + } + global_dpd_->buf4_mat_irrep_close_block(&W, Gej, num_j); + } + global_dpd_->buf4_mat_irrep_wrt(&Z, Gij); + global_dpd_->buf4_mat_irrep_close(&Z, Gij); + } + global_dpd_->file2_mat_close(&LIA); + + /* End out-of-core contract244 */ + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&Z, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + global_dpd_->file2_close(&LIA); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + + /** Z(IJ,AB) = L(I,E) W(EJ,AB) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,A>B)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "WAMEF"); + global_dpd_->contract244(&LIA, &W, &Z1, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(IJ,AB) --> Z(JI,AB) **/ + global_dpd_->buf4_sort(&Z1, PSIF_CC_TMP1, qprs, 0, 7, "Z(JI,A>B)"); + /** Z(IJ,AB) = Z(IJ,AB) - Z(JI,AB) **/ + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(JI,A>B)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(IJ,AB) --> New L(IJ,AB) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** Z(ij,ab) = L(i,e) W(ej,ab) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(ij,a>b)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "Wamef"); + global_dpd_->contract244(&Lia, &W, &Z1, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(ij,ab) --> Z(ji,ab) **/ + global_dpd_->buf4_sort(&Z1, PSIF_CC_TMP1, qprs, 0, 7, "Z(ji,a>b)"); + /** Z(ij,ab) = Z(ij,ab) - Z(ji,ab) **/ + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(ji,a>b)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(ij,ab) --> New L(ij,ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** New L(Ij,Ab) <-- L(I,E) W(Ej,Ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); + global_dpd_->contract244(&LIA, &W, &L2, 1, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + /** Z(jI,bA) = -L(j,e) W(eI,bA) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(jI,bA)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WaMeF"); + global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(jI,bA) --> New L(Ij,Ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + + /** Z(IJ,AB) = L(I,E) W(EJ,AB) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,AB)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 7, 21, 7, 0, "WAMEF"); + global_dpd_->contract244(&LIA, &W, &Z, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(IJ,AB) --> Z(JI,AB) **/ + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, qprs, 0, 7, "Z(JI,AB)"); + global_dpd_->buf4_close(&Z); + /** Z(IJ,AB) = Z(IJ,AB) - Z(JI,AB) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,AB)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(JI,AB)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(IJ,AB) --> New L(IJ,AB) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** Z(ij,ab) = L(i,e) W(ej,ab) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ij,ab)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 17, 31, 17, 0, "Wamef"); + global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(ij,ab) --> Z(ji,ab) **/ + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, qprs, 10, 17, "Z(ji,ab)"); + global_dpd_->buf4_close(&Z); + /** Z(ij,ab) = Z(ij,ab) - Z(ji,ab) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ij,ab)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ji,ab)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(ij,ab) --> New L(ij,ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** New L(Ij,Ab) <-- L(I,E) W(Ej,Ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WAmEf"); + global_dpd_->contract244(&LIA, &W, &L2, 1, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + /** Z(jI,bA) = -L(j,e) W(eI,bA) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 23, 29, 23, 29, 0, "Z(jI,bA)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WaMeF"); + global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(jI,bA) --> New L(Ij,Ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); } - global_dpd_->file2_mat_close(&LIA); - - /* End out-of-core contract244 */ - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&Z, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - global_dpd_->file2_close(&LIA); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - - /** Z(IJ,AB) = L(I,E) W(EJ,AB) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,A>B)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "WAMEF"); - global_dpd_->contract244(&LIA, &W, &Z1, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(IJ,AB) --> Z(JI,AB) **/ - global_dpd_->buf4_sort(&Z1, PSIF_CC_TMP1, qprs, 0, 7, "Z(JI,A>B)"); - /** Z(IJ,AB) = Z(IJ,AB) - Z(JI,AB) **/ - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(JI,A>B)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(IJ,AB) --> New L(IJ,AB) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - /** Z(ij,ab) = L(i,e) W(ej,ab) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(ij,a>b)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 7, 11, 7, 0, "Wamef"); - global_dpd_->contract244(&Lia, &W, &Z1, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(ij,ab) --> Z(ji,ab) **/ - global_dpd_->buf4_sort(&Z1, PSIF_CC_TMP1, qprs, 0, 7, "Z(ji,a>b)"); - /** Z(ij,ab) = Z(ij,ab) - Z(ji,ab) **/ - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(ji,a>b)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(ij,ab) --> New L(ij,ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - /** New L(Ij,Ab) <-- L(I,E) W(Ej,Ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); - global_dpd_->contract244(&LIA, &W, &L2, 1, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - /** Z(jI,bA) = -L(j,e) W(eI,bA) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(jI,bA)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 11, 5, 11, 5, 0, "WaMeF"); - global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(jI,bA) --> New L(Ij,Ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - - /** Z(IJ,AB) = L(I,E) W(EJ,AB) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,AB)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 21, 7, 21, 7, 0, "WAMEF"); - global_dpd_->contract244(&LIA, &W, &Z, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(IJ,AB) --> Z(JI,AB) **/ - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, qprs, 0, 7, "Z(JI,AB)"); - global_dpd_->buf4_close(&Z); - /** Z(IJ,AB) = Z(IJ,AB) - Z(JI,AB) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(IJ,AB)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "Z(JI,AB)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(IJ,AB) --> New L(IJ,AB) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - /** Z(ij,ab) = L(i,e) W(ej,ab) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ij,ab)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 31, 17, 31, 17, 0, "Wamef"); - global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(ij,ab) --> Z(ji,ab) **/ - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, qprs, 10, 17, "Z(ji,ab)"); - global_dpd_->buf4_close(&Z); - /** Z(ij,ab) = Z(ij,ab) - Z(ji,ab) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ij,ab)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "Z(ji,ab)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(ij,ab) --> New L(ij,ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - - /** New L(Ij,Ab) <-- L(I,E) W(Ej,Ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 26, 28, 26, 28, 0, "WAmEf"); - global_dpd_->contract244(&LIA, &W, &L2, 1, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - /** Z(jI,bA) = -L(j,e) W(eI,bA) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 23, 29, 23, 29, 0, "Z(jI,bA)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 25, 29, 25, 29, 0, "WaMeF"); - global_dpd_->contract244(&Lia, &W, &Z, 1, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(jI,bA) --> New L(Ij,Ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qpsr, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WijmbL2.cc b/psi4/src/psi4/cclambda/WijmbL2.cc index 63d9883681d..557d65177b4 100644 --- a/psi4/src/psi4/cclambda/WijmbL2.cc +++ b/psi4/src/psi4/cclambda/WijmbL2.cc @@ -37,7 +37,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* WijmbL2(): Computes the contributions of the Wmnie HBAR matrix ** elements to the Lambda double de-excitation amplitude equations. @@ -63,145 +64,139 @@ namespace psi { namespace cclambda { ** TDC, July 2002 */ -void WijmbL2(int L_irr) -{ - dpdfile2 LIA, Lia; - dpdbuf4 L2, newLijab, newLIJAB, newLIjAb; - dpdbuf4 W, WMNIE, Wmnie, WMnIe, WmNiE; - dpdbuf4 X1, X2, Z, Z1, Z2; - - /* RHS += -P(ab) Lma * Wijmb */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,bA)"); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WMnIe (Mn,eI)"); - global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - global_dpd_->file2_close(&LIA); - - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, pqsr, 0, 5, "New LIjAb", -1); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qprs, 0, 5, "New LIjAb", -1); - global_dpd_->buf4_close(&Z); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - - global_dpd_->buf4_init(&WMNIE, PSIF_CC_HBAR, 0, 2, 11, 2, 11, 0, "WMNIE (M>N,EI)"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&WMNIE, &LIA, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&WMNIE); - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP1, pqsr, 2, 5, "X(2,5) 2"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); - global_dpd_->buf4_close(&newLIJAB); - - - global_dpd_->buf4_init(&Wmnie, PSIF_CC_HBAR, 0, 2, 11, 2, 11, 0, "Wmnie (m>n,ei)"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&Wmnie, &Lia, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&Wmnie); - global_dpd_->buf4_sort(&X1, PSIF_CC_TMP1, pqsr, 2, 5, "X(2,5) 2"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X1, &newLijab, 1.0); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - global_dpd_->buf4_init(&WMnIe, PSIF_CC_HBAR, 0, 0, 10, 0, 10, 0, "WMnIe"); - global_dpd_->contract244(&LIA, &WMnIe, &newLIjAb, 0, 2, 1, -1.0, 1.0); - global_dpd_->buf4_close(&WMnIe); - - global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WmNiE (mN,Ei)"); - global_dpd_->buf4_sort(&WmNiE, PSIF_CC_TMP0, qprs, 0, 11, "WmNiE (Nm,Ei)"); - global_dpd_->buf4_close(&WmNiE); - - /* W(Nm,Ei) * L(i,b) --> L(Nm,Eb) */ - global_dpd_->buf4_init(&WmNiE, PSIF_CC_TMP0, 0, 0, 11, 0, 11, 0, "WmNiE (Nm,Ei)"); - global_dpd_->contract424(&WmNiE, &Lia, &newLIjAb, 3, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&WmNiE); - - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - - /** W(IJ,AM) L(M,B) --> Z(IJ,AB) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,AB)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 2, 21, 2, 21, 0, "WMNIE (M>N,EI)"); - global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(IJ,AB) --> Z(IJ,BA) **/ - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, pqsr, 2, 5, "Z'(IJ,BA)"); - global_dpd_->buf4_close(&Z); - /** Z(IJ,AB) = Z(IJ,AB) - Z(IJ,BA) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,AB)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,BA)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(IJ,AB) --> New L(IJ,AB) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - - /** W(ij,am) L(m,b) --> Z(ij,ab) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ab)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 12, 31, 12, 31, 0, "Wmnie (m>n,ei)"); - global_dpd_->contract424(&W, &Lia, &Z, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - /** Z(ij,ab) --> Z(ij,ba) **/ - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, pqsr, 12, 15, "Z'(ij,ba)"); - global_dpd_->buf4_close(&Z); - /** Z(ij,ab) = Z(ij,ab) - Z(ij,ba) **/ - global_dpd_->buf4_init(&Z1, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ab)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ba)"); - global_dpd_->buf4_axpy(&Z2, &Z1, -1); - global_dpd_->buf4_close(&Z2); - /** Z(ij,ab) --> New L(ij,ab) **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&Z1, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&Z1); - - - /** Z(jI,Ab) = W(jI,Am) L(m,b) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 23, 28, 23, 28, 0, "Z(jI,Ab)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 23, 26, 23, 26, 0, "WmNiE (mN,Ei)"); - global_dpd_->contract424(&W, &Lia, &Z, 3, 0, 0, -1, 0); - global_dpd_->buf4_close(&W); - /** Z(jI,Ab) --> New L(Ij,Ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qprs, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - /** Z(Ij,bA) = W(Ij,bM) L(M,A) **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 22, 29, 22, 29, 0, "Z(Ij,bA)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 22, 25, 22, 25, 0, "WMnIe (Mn,eI)"); - global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, -1, 0); - global_dpd_->buf4_close(&W); - /** Z(Ij,bA) --> New L(Ij,Ab) **/ - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, pqsr, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - } +void WijmbL2(int L_irr) { + dpdfile2 LIA, Lia; + dpdbuf4 L2, newLijab, newLIJAB, newLIjAb; + dpdbuf4 W, WMNIE, Wmnie, WMnIe, WmNiE; + dpdbuf4 X1, X2, Z, Z1, Z2; + + /* RHS += -P(ab) Lma * Wijmb */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,bA)"); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WMnIe (Mn,eI)"); + global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + global_dpd_->file2_close(&LIA); + + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, pqsr, 0, 5, "New LIjAb", -1); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qprs, 0, 5, "New LIjAb", -1); + global_dpd_->buf4_close(&Z); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + + global_dpd_->buf4_init(&WMNIE, PSIF_CC_HBAR, 0, 2, 11, 2, 11, 0, "WMNIE (M>N,EI)"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&WMNIE, &LIA, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&WMNIE); + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP1, pqsr, 2, 5, "X(2,5) 2"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Wmnie, PSIF_CC_HBAR, 0, 2, 11, 2, 11, 0, "Wmnie (m>n,ei)"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&Wmnie, &Lia, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&Wmnie); + global_dpd_->buf4_sort(&X1, PSIF_CC_TMP1, pqsr, 2, 5, "X(2,5) 2"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X1, &newLijab, 1.0); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + + global_dpd_->buf4_init(&WMnIe, PSIF_CC_HBAR, 0, 0, 10, 0, 10, 0, "WMnIe"); + global_dpd_->contract244(&LIA, &WMnIe, &newLIjAb, 0, 2, 1, -1.0, 1.0); + global_dpd_->buf4_close(&WMnIe); + + global_dpd_->buf4_init(&WmNiE, PSIF_CC_HBAR, 0, 0, 11, 0, 11, 0, "WmNiE (mN,Ei)"); + global_dpd_->buf4_sort(&WmNiE, PSIF_CC_TMP0, qprs, 0, 11, "WmNiE (Nm,Ei)"); + global_dpd_->buf4_close(&WmNiE); + + /* W(Nm,Ei) * L(i,b) --> L(Nm,Eb) */ + global_dpd_->buf4_init(&WmNiE, PSIF_CC_TMP0, 0, 0, 11, 0, 11, 0, "WmNiE (Nm,Ei)"); + global_dpd_->contract424(&WmNiE, &Lia, &newLIjAb, 3, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&WmNiE); + + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + + /** W(IJ,AM) L(M,B) --> Z(IJ,AB) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,AB)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 2, 21, 2, 21, 0, "WMNIE (M>N,EI)"); + global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(IJ,AB) --> Z(IJ,BA) **/ + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, pqsr, 2, 5, "Z'(IJ,BA)"); + global_dpd_->buf4_close(&Z); + /** Z(IJ,AB) = Z(IJ,AB) - Z(IJ,BA) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,AB)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 2, 5, 2, 5, 0, "Z'(IJ,BA)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(IJ,AB) --> New L(IJ,AB) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** W(ij,am) L(m,b) --> Z(ij,ab) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ab)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 12, 31, 12, 31, 0, "Wmnie (m>n,ei)"); + global_dpd_->contract424(&W, &Lia, &Z, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + /** Z(ij,ab) --> Z(ij,ba) **/ + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, pqsr, 12, 15, "Z'(ij,ba)"); + global_dpd_->buf4_close(&Z); + /** Z(ij,ab) = Z(ij,ab) - Z(ij,ba) **/ + global_dpd_->buf4_init(&Z1, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ab)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 12, 15, 12, 15, 0, "Z'(ij,ba)"); + global_dpd_->buf4_axpy(&Z2, &Z1, -1); + global_dpd_->buf4_close(&Z2); + /** Z(ij,ab) --> New L(ij,ab) **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&Z1, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&Z1); + + /** Z(jI,Ab) = W(jI,Am) L(m,b) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 23, 28, 23, 28, 0, "Z(jI,Ab)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 23, 26, 23, 26, 0, "WmNiE (mN,Ei)"); + global_dpd_->contract424(&W, &Lia, &Z, 3, 0, 0, -1, 0); + global_dpd_->buf4_close(&W); + /** Z(jI,Ab) --> New L(Ij,Ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, qprs, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + /** Z(Ij,bA) = W(Ij,bM) L(M,A) **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 22, 29, 22, 29, 0, "Z(Ij,bA)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 22, 25, 22, 25, 0, "WMnIe (Mn,eI)"); + global_dpd_->contract424(&W, &LIA, &Z, 3, 0, 0, -1, 0); + global_dpd_->buf4_close(&W); + /** Z(Ij,bA) --> New L(Ij,Ab) **/ + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, pqsr, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WijmnL2.cc b/psi4/src/psi4/cclambda/WijmnL2.cc index 0ff531a2629..f1fe00225e5 100644 --- a/psi4/src/psi4/cclambda/WijmnL2.cc +++ b/psi4/src/psi4/cclambda/WijmnL2.cc @@ -37,77 +37,75 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -void WijmnL2(int L_irr) -{ - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLijab, newLIJAB, newLIjAb; - dpdbuf4 WMNIJ, Wmnij, WMnIj; +void WijmnL2(int L_irr) { + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLijab, newLIJAB, newLIjAb; + dpdbuf4 WMNIJ, Wmnij, WMnIj; - /* RHS += Lmnab*Wijmn */ - if(params.ref == 0) { /** RHF **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 0, 0, 0, 0, 0, "WMnIj"); - global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&WMnIj); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - } - else if(params.ref == 1) { /** ROHF **/ + /* RHS += Lmnab*Wijmn */ + if (params.ref == 0) { /** RHF **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 0, 0, 0, 0, 0, "WMnIj"); + global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&WMnIj); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + } else if (params.ref == 1) { /** ROHF **/ - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&WMNIJ, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "WMNIJ"); - global_dpd_->contract444(&WMNIJ, &LIJAB, &newLIJAB, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&WMNIJ); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&newLIJAB); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&WMNIJ, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "WMNIJ"); + global_dpd_->contract444(&WMNIJ, &LIJAB, &newLIJAB, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&WMNIJ); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&newLIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&Wmnij, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "Wmnij"); - global_dpd_->contract444(&Wmnij, &Lijab, &newLijab, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&Wmnij); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&newLijab); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&Wmnij, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "Wmnij"); + global_dpd_->contract444(&Wmnij, &Lijab, &newLijab, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&Wmnij); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&newLijab); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 0, 0, 0, 0, 0, "WMnIj"); - global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1.0, 1.0); - global_dpd_->buf4_close(&WMnIj); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - } - else if(params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 0, 0, 0, 0, 0, "WMnIj"); + global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1.0, 1.0); + global_dpd_->buf4_close(&WMnIj); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + } else if (params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&WMNIJ, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "WMNIJ"); - global_dpd_->contract444(&WMNIJ, &LIJAB, &newLIJAB, 0, 1, 1, 1); - global_dpd_->buf4_close(&WMNIJ); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&newLIJAB); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&WMNIJ, PSIF_CC_HBAR, 0, 2, 2, 2, 2, 0, "WMNIJ"); + global_dpd_->contract444(&WMNIJ, &LIJAB, &newLIJAB, 0, 1, 1, 1); + global_dpd_->buf4_close(&WMNIJ); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&newLIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&Wmnij, PSIF_CC_HBAR, 0, 12, 12, 12, 12, 0, "Wmnij"); - global_dpd_->contract444(&Wmnij, &Lijab, &newLijab, 0, 1, 1, 1); - global_dpd_->buf4_close(&Wmnij); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&newLijab); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&Wmnij, PSIF_CC_HBAR, 0, 12, 12, 12, 12, 0, "Wmnij"); + global_dpd_->contract444(&Wmnij, &Lijab, &newLijab, 0, 1, 1, 1); + global_dpd_->buf4_close(&Wmnij); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&newLijab); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 22, 22, 22, 22, 0, "WMnIj"); - global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1, 1); - global_dpd_->buf4_close(&WMnIj); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - } + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&WMnIj, PSIF_CC_HBAR, 0, 22, 22, 22, 22, 0, "WMnIj"); + global_dpd_->contract444(&WMnIj, &LIjAb, &newLIjAb, 0, 1, 1, 1); + global_dpd_->buf4_close(&WMnIj); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/WmbejL2.cc b/psi4/src/psi4/cclambda/WmbejL2.cc index 27f95f0be31..23bd6b7d461 100644 --- a/psi4/src/psi4/cclambda/WmbejL2.cc +++ b/psi4/src/psi4/cclambda/WmbejL2.cc @@ -37,7 +37,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* WmbejL2(): Computes the contributions of the Wmbej HBAR matrix ** elements to the Lambda double deexcitation amplitude equations. @@ -87,261 +88,257 @@ namespace psi { namespace cclambda { ** */ -void WmbejL2(int L_irr) -{ - dpdbuf4 newL2, L2, W, Z, Z2; +void WmbejL2(int L_irr) { + dpdbuf4 newL2, L2, W, Z, Z2; - /* RHS += P(ij)P(ab)Limae * Wjebm */ - if(params.ref == 0) { /** RHF **/ + /* RHS += P(ij)P(ab)Limae * Wjebm */ + if (params.ref == 0) { /** RHF **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIbjA"); - global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP0, psrq, 10, 10, "Z(IA,jb) III"); - global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIbjA"); + global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP0, psrq, 10, 10, "Z(IA,jb) III"); + global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb) I"); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb) I"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "2 LIAjb - LIbjA"); - global_dpd_->contract444(&W, &L2, &Z, 0, 1, 0.5, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "2 LIAjb - LIbjA"); + global_dpd_->contract444(&W, &L2, &Z, 0, 1, 0.5, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); - global_dpd_->buf4_axpy(&Z2, &Z, 0.5); - global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); + global_dpd_->buf4_axpy(&Z2, &Z, 0.5); + global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb) III"); - global_dpd_->buf4_axpy(&Z2, &Z, 1); - global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb) III"); + global_dpd_->buf4_axpy(&Z2, &Z, 1); + global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prqs, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rpsq, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prqs, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, rpsq, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); - } - else if(params.ref == 1) { /** ROHF **/ + } else if (params.ref == 1) { /** ROHF **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,JB)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, rqps, 10, 10, "Z(JA,IB)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 10, 10, "Z(IB,JA)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP3, rspq, 10, 10, "Z(JB,IA)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 10, 10, 10, 0, "Z(JA,IB)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 10, 10, 10, 10, 0, "Z(IB,JA)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP3, L_irr, 10, 10, 10, 10, 0, "Z(JB,IA)"); - global_dpd_->buf4_axpy(&Z2, &Z, 1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(IJ,AB)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(IJ,AB)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&Z, &newL2, 1.0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,JB)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, rqps, 10, 10, "Z(JA,IB)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 10, 10, "Z(IB,JA)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP3, rspq, 10, 10, "Z(JB,IA)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 10, 10, 10, 0, "Z(JA,IB)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 10, 10, 10, 10, 0, "Z(IB,JA)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP3, L_irr, 10, 10, 10, 10, 0, "Z(JB,IA)"); + global_dpd_->buf4_axpy(&Z2, &Z, 1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(IJ,AB)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(IJ,AB)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&Z, &newL2, 1.0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(ia,jb)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "Liajb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LiaJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, rqps, 10, 10, "Z(ja,ib)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 10, 10, "Z(ib,ja)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP3, rspq, 10, 10, "Z(jb,ia)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 10, 10, 10, 0, "Z(ja,ib)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 10, 10, 10, 10, 0, "Z(ib,ja)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP3, L_irr, 10, 10, 10, 10, 0, "Z(jb,ia)"); - global_dpd_->buf4_axpy(&Z2, &Z, 1.0); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(ij,ab)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(ij,ab)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&Z, &newL2, 1.0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(ia,jb)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "Liajb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LiaJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, rqps, 10, 10, "Z(ja,ib)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 10, 10, "Z(ib,ja)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP3, rspq, 10, 10, "Z(jb,ia)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP1, L_irr, 10, 10, 10, 10, 0, "Z(ja,ib)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 10, 10, 10, 10, 0, "Z(ib,ja)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP3, L_irr, 10, 10, 10, 10, 0, "Z(jb,ia)"); + global_dpd_->buf4_axpy(&Z2, &Z, 1.0); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(ij,ab)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(ij,ab)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&Z, &newL2, 1.0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "Liajb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); + global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LiaJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); + global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(Ij,Ab)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&Z, &newL2, 1.0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(IA,jb)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBeJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "Wmbej"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "Liajb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); - global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LiaJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMBEJ"); - global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(Ij,Ab)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&Z, &newL2, 1.0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIbjA"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); + global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LjAIb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBEj"); + global_dpd_->contract444(&L2, &W, &Z, 1, 0, 1.0, 1.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(Ij,bA)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(Ij,bA)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP0, pqsr, 0, 5, "Z(Ij,Ab)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&Z, &newL2, 1.0); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); + } else if (params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 10, 10, 10, 10, 0, "Z(Ib,jA)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIbjA"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); - global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LjAIb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WmBEj"); - global_dpd_->contract444(&L2, &W, &Z, 1, 0, 1.0, 1.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP1, prqs, 0, 5, "Z(Ij,bA)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP1, L_irr, 0, 5, 0, 5, 0, "Z(Ij,bA)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP0, pqsr, 0, 5, "Z(Ij,Ab)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "Z(Ij,Ab)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&Z, &newL2, 1.0); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); - } - else if(params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(IA,JB)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 20, 20, 20, 0, "LIAJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rqps, 20, 20, "Z(JA,IB)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 20, 20, "Z(IB,JA)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rspq, 20, 20, "Z(JB,IA)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(JA,IB)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(IB,JA)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(JB,IA)"); + global_dpd_->buf4_axpy(&Z2, &Z, 1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, prqs, 0, 5, "Z(IJ,AB)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 0, 5, 0, 5, 0, "Z(IJ,AB)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&Z, &newL2, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(IA,JB)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 20, 20, 20, 0, "LIAJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rqps, 20, 20, "Z(JA,IB)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 20, 20, "Z(IB,JA)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rspq, 20, 20, "Z(JB,IA)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(JA,IB)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(IB,JA)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 20, 20, 20, 20, 0, "Z(JB,IA)"); - global_dpd_->buf4_axpy(&Z2, &Z, 1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, prqs, 0, 5, "Z(IJ,AB)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 0, 5, 0, 5, 0, "Z(IJ,AB)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&Z, &newL2, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ia,jb)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 30, 30, 30, 0, "Liajb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 20, 30, 20, 0, "LiaJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rqps, 30, 30, "Z(ja,ib)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 30, 30, "Z(ib,ja)"); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rspq, 30, 30, "Z(jb,ia)"); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ja,ib)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ib,ja)"); + global_dpd_->buf4_axpy(&Z2, &Z, -1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(jb,ia)"); + global_dpd_->buf4_axpy(&Z2, &Z, 1); + global_dpd_->buf4_close(&Z2); + global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, prqs, 10, 15, "Z(ij,ab)"); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 10, 15, 10, 15, 0, "Z(ij,ab)"); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 10, 15, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&Z, &newL2, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&newL2); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ia,jb)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 30, 30, 30, 0, "Liajb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 20, 30, 20, 0, "LiaJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rqps, 30, 30, "Z(ja,ib)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, psrq, 30, 30, "Z(ib,ja)"); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, rspq, 30, 30, "Z(jb,ia)"); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ja,ib)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(ib,ja)"); - global_dpd_->buf4_axpy(&Z2, &Z, -1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_init(&Z2, PSIF_CC_TMP2, L_irr, 30, 30, 30, 30, 0, "Z(jb,ia)"); - global_dpd_->buf4_axpy(&Z2, &Z, 1); - global_dpd_->buf4_close(&Z2); - global_dpd_->buf4_sort(&Z, PSIF_CC_TMP2, prqs, 10, 15, "Z(ij,ab)"); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 10, 15, 10, 15, 0, "Z(ij,ab)"); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 10, 15, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&Z, &newL2, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&newL2); - - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 20, 30, 20, 30, 0, "Z(IA,jb)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 20, 20, 20, 0, "LIAJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); - global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 30, 30, 30, 0, "Liajb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); - global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 20, 30, 20, 0, "LiaJB"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); - global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prqs, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 24, 27, 24, 27, 0, "Z(Ib,jA)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 24, 27, 24, 27, 0, "LIbjA"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 24, 24, 24, 24, 0, "WMbeJ"); - global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1, 0); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 27, 24, 27, 24, 0, "LjAIb"); - global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 27, 27, 27, 27, 0, "WmBEj"); - global_dpd_->contract444(&L2, &W, &Z, 1, 0, 1, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prsq, 22, 28, "New LIjAb", 1); - global_dpd_->buf4_close(&Z); - - } + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 20, 30, 20, 30, 0, "Z(IA,jb)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 20, 20, 20, 0, "LIAJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 20, 30, 20, 0, "WmBeJ"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 30, 30, 30, 30, 0, "Wmbej"); + global_dpd_->contract444(&L2, &W, &Z, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 30, 30, 30, 0, "Liajb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 30, 20, 30, 0, "WMbEj"); + global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 30, 20, 30, 20, 0, "LiaJB"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 20, 20, 20, 20, 0, "WMBEJ"); + global_dpd_->contract444(&W, &L2, &Z, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prqs, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_init(&Z, PSIF_CC_TMP2, L_irr, 24, 27, 24, 27, 0, "Z(Ib,jA)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 24, 27, 24, 27, 0, "LIbjA"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 24, 24, 24, 24, 0, "WMbeJ"); + global_dpd_->contract444(&W, &L2, &Z, 0, 1, 1, 0); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 27, 24, 27, 24, 0, "LjAIb"); + global_dpd_->buf4_init(&W, PSIF_CC_HBAR, 0, 27, 27, 27, 27, 0, "WmBEj"); + global_dpd_->contract444(&L2, &W, &Z, 1, 0, 1, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_sort_axpy(&Z, PSIF_CC_LAMBDA, prsq, 22, 28, "New LIjAb", 1); + global_dpd_->buf4_close(&Z); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/c_clean.cc b/psi4/src/psi4/cclambda/c_clean.cc index 473e764353c..b232ff5f587 100644 --- a/psi4/src/psi4/cclambda/c_clean.cc +++ b/psi4/src/psi4/cclambda/c_clean.cc @@ -28,7 +28,7 @@ /*! \file \ingroup CCLAMBDA - \brief Enter brief description of file here + \brief Enter brief description of file here */ #include #include @@ -37,143 +37,141 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /*** This function removes incorrectly non-zero elements from *** *** a vector. The non-zero elements are due to the *** *** specification of open-shell orbitals as both occupied *** *** and virtual orbitals. ***/ -void c_clean(dpdfile2 *CME, dpdfile2 *Cme, - dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf) { - - int *occpi, *virtpi, *occ_off, *vir_off, *openpi, C_irr; - int nirreps, *occ_sym, *vir_sym; - int mn, ef, m, n, e, f, h, M, N, E, F; - int msym, nsym, esym, fsym; - - C_irr = CME->my_irrep; - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; virtpi = moinfo.virtpi; - occ_off = moinfo.occ_off; vir_off = moinfo.vir_off; - occ_sym = moinfo.occ_sym; vir_sym = moinfo.vir_sym; - openpi = moinfo.openpi; - - global_dpd_->file2_mat_init(CME); - global_dpd_->file2_mat_rd(CME); - for(h=0; h < nirreps; h++) { - for(m=0; mmatrix[h][m][e] = 0.0; - } - global_dpd_->file2_mat_wrt(CME); - - global_dpd_->file2_mat_init(Cme); - global_dpd_->file2_mat_rd(Cme); - for(h=0; h < nirreps; h++) { - for(m=(occpi[h]-openpi[h]); mmatrix[h][m][e] = 0.0; - } - global_dpd_->file2_mat_wrt(Cme); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(CMNEF, h); - global_dpd_->buf4_mat_irrep_rd(CMNEF, h); - for(mn=0; mn < CMNEF->params->rowtot[h]; mn++) { - for(ef=0; ef < CMNEF->params->coltot[h^C_irr]; ef++) { - e = CMNEF->params->colorb[h^C_irr][ef][0]; - f = CMNEF->params->colorb[h^C_irr][ef][1]; - esym = CMNEF->params->rsym[e]; - fsym = CMNEF->params->ssym[f]; - E = e - vir_off[esym]; - F = f - vir_off[fsym]; - if ((E >= (virtpi[esym] - openpi[esym])) || - (F >= (virtpi[fsym] - openpi[fsym])) ) - CMNEF->matrix[h][mn][ef] = 0.0; - } +void c_clean(dpdfile2 *CME, dpdfile2 *Cme, dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf) { + int *occpi, *virtpi, *occ_off, *vir_off, *openpi, C_irr; + int nirreps, *occ_sym, *vir_sym; + int mn, ef, m, n, e, f, h, M, N, E, F; + int msym, nsym, esym, fsym; + + C_irr = CME->my_irrep; + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + virtpi = moinfo.virtpi; + occ_off = moinfo.occ_off; + vir_off = moinfo.vir_off; + occ_sym = moinfo.occ_sym; + vir_sym = moinfo.vir_sym; + openpi = moinfo.openpi; + + global_dpd_->file2_mat_init(CME); + global_dpd_->file2_mat_rd(CME); + for (h = 0; h < nirreps; h++) { + for (m = 0; m < occpi[h]; m++) + for (e = (virtpi[h ^ C_irr] - openpi[h ^ C_irr]); e < virtpi[h ^ C_irr]; e++) CME->matrix[h][m][e] = 0.0; } - global_dpd_->buf4_mat_irrep_wrt(CMNEF, h); - global_dpd_->buf4_mat_irrep_close(CMNEF, h); - } - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(Cmnef, h); - global_dpd_->buf4_mat_irrep_rd(Cmnef, h); - for(mn=0; mn < Cmnef->params->rowtot[h]; mn++) { - m = Cmnef->params->roworb[h][mn][0]; - n = Cmnef->params->roworb[h][mn][1]; - msym = Cmnef->params->psym[m]; - nsym = Cmnef->params->qsym[n]; - M = m - occ_off[msym]; - N = n - occ_off[nsym]; - for(ef=0; ef < Cmnef->params->coltot[h^C_irr]; ef++) { - if ((M >= (occpi[msym] - openpi[msym])) || - (N >= (occpi[nsym] - openpi[nsym])) ) - Cmnef->matrix[h][mn][ef] = 0.0; - } + global_dpd_->file2_mat_wrt(CME); + + global_dpd_->file2_mat_init(Cme); + global_dpd_->file2_mat_rd(Cme); + for (h = 0; h < nirreps; h++) { + for (m = (occpi[h] - openpi[h]); m < occpi[h]; m++) + for (e = 0; e < virtpi[h ^ C_irr]; e++) Cme->matrix[h][m][e] = 0.0; } - global_dpd_->buf4_mat_irrep_wrt(Cmnef, h); - global_dpd_->buf4_mat_irrep_close(Cmnef, h); - } - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(CMnEf, h); - global_dpd_->buf4_mat_irrep_rd(CMnEf, h); - for(mn=0; mn < CMnEf->params->rowtot[h]; mn++) { - n = CMnEf->params->roworb[h][mn][1]; - nsym = CMnEf->params->qsym[n]; - N = n - occ_off[nsym]; - for(ef=0; ef < CMnEf->params->coltot[h^C_irr]; ef++) { - e = CMnEf->params->colorb[h^C_irr][ef][0]; - esym = CMnEf->params->rsym[e]; - E = e - vir_off[esym]; - if ((N >= (occpi[nsym] - openpi[nsym])) || - (E >= (virtpi[esym] - openpi[esym])) ) - CMnEf->matrix[h][mn][ef] = 0.0; - } + global_dpd_->file2_mat_wrt(Cme); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(CMNEF, h); + global_dpd_->buf4_mat_irrep_rd(CMNEF, h); + for (mn = 0; mn < CMNEF->params->rowtot[h]; mn++) { + for (ef = 0; ef < CMNEF->params->coltot[h ^ C_irr]; ef++) { + e = CMNEF->params->colorb[h ^ C_irr][ef][0]; + f = CMNEF->params->colorb[h ^ C_irr][ef][1]; + esym = CMNEF->params->rsym[e]; + fsym = CMNEF->params->ssym[f]; + E = e - vir_off[esym]; + F = f - vir_off[fsym]; + if ((E >= (virtpi[esym] - openpi[esym])) || (F >= (virtpi[fsym] - openpi[fsym]))) + CMNEF->matrix[h][mn][ef] = 0.0; + } + } + global_dpd_->buf4_mat_irrep_wrt(CMNEF, h); + global_dpd_->buf4_mat_irrep_close(CMNEF, h); } - global_dpd_->buf4_mat_irrep_wrt(CMnEf, h); - global_dpd_->buf4_mat_irrep_close(CMnEf, h); - } - return; -} + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(Cmnef, h); + global_dpd_->buf4_mat_irrep_rd(Cmnef, h); + for (mn = 0; mn < Cmnef->params->rowtot[h]; mn++) { + m = Cmnef->params->roworb[h][mn][0]; + n = Cmnef->params->roworb[h][mn][1]; + msym = Cmnef->params->psym[m]; + nsym = Cmnef->params->qsym[n]; + M = m - occ_off[msym]; + N = n - occ_off[nsym]; + for (ef = 0; ef < Cmnef->params->coltot[h ^ C_irr]; ef++) { + if ((M >= (occpi[msym] - openpi[msym])) || (N >= (occpi[nsym] - openpi[nsym]))) + Cmnef->matrix[h][mn][ef] = 0.0; + } + } + global_dpd_->buf4_mat_irrep_wrt(Cmnef, h); + global_dpd_->buf4_mat_irrep_close(Cmnef, h); + } + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(CMnEf, h); + global_dpd_->buf4_mat_irrep_rd(CMnEf, h); + for (mn = 0; mn < CMnEf->params->rowtot[h]; mn++) { + n = CMnEf->params->roworb[h][mn][1]; + nsym = CMnEf->params->qsym[n]; + N = n - occ_off[nsym]; + for (ef = 0; ef < CMnEf->params->coltot[h ^ C_irr]; ef++) { + e = CMnEf->params->colorb[h ^ C_irr][ef][0]; + esym = CMnEf->params->rsym[e]; + E = e - vir_off[esym]; + if ((N >= (occpi[nsym] - openpi[nsym])) || (E >= (virtpi[esym] - openpi[esym]))) + CMnEf->matrix[h][mn][ef] = 0.0; + } + } + global_dpd_->buf4_mat_irrep_wrt(CMnEf, h); + global_dpd_->buf4_mat_irrep_close(CMnEf, h); + } + return; +} void c_cleanSS(dpdfile2 *CME, dpdfile2 *Cme) { - int *occpi, *virtpi, *occ_off, *vir_off, *openpi; - int nirreps, *occ_sym, *vir_sym; - int mn, ef, m, n, e, f; - int h, M, N, E, F; - int msym, nsym, esym, fsym, C_irr; - - C_irr = CME->my_irrep; - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; virtpi = moinfo.virtpi; - occ_off = moinfo.occ_off; vir_off = moinfo.vir_off; - occ_sym = moinfo.occ_sym; vir_sym = moinfo.vir_sym; - openpi = moinfo.openpi; - - global_dpd_->file2_mat_init(CME); - global_dpd_->file2_mat_rd(CME); - for(h=0; h < nirreps; h++) { - for(m=0; mmatrix[h][m][e] = 0.0; - } - global_dpd_->file2_mat_wrt(CME); - - global_dpd_->file2_mat_init(Cme); - global_dpd_->file2_mat_rd(Cme); - for(h=0; h < nirreps; h++) { - for(m=(occpi[h]-openpi[h]); mmatrix[h][m][e] = 0.0; - } - global_dpd_->file2_mat_wrt(Cme); - - return; + int *occpi, *virtpi, *occ_off, *vir_off, *openpi; + int nirreps, *occ_sym, *vir_sym; + int mn, ef, m, n, e, f; + int h, M, N, E, F; + int msym, nsym, esym, fsym, C_irr; + + C_irr = CME->my_irrep; + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + virtpi = moinfo.virtpi; + occ_off = moinfo.occ_off; + vir_off = moinfo.vir_off; + occ_sym = moinfo.occ_sym; + vir_sym = moinfo.vir_sym; + openpi = moinfo.openpi; + + global_dpd_->file2_mat_init(CME); + global_dpd_->file2_mat_rd(CME); + for (h = 0; h < nirreps; h++) { + for (m = 0; m < occpi[h]; m++) + for (e = (virtpi[h ^ C_irr] - openpi[h ^ C_irr]); e < virtpi[h ^ C_irr]; e++) CME->matrix[h][m][e] = 0.0; + } + global_dpd_->file2_mat_wrt(CME); + + global_dpd_->file2_mat_init(Cme); + global_dpd_->file2_mat_rd(Cme); + for (h = 0; h < nirreps; h++) { + for (m = (occpi[h] - openpi[h]); m < occpi[h]; m++) + for (e = 0; e < virtpi[h ^ C_irr]; e++) Cme->matrix[h][m][e] = 0.0; + } + global_dpd_->file2_mat_wrt(Cme); + + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cache.cc b/psi4/src/psi4/cclambda/cache.cc index f0291cf068d..71c7616df52 100644 --- a/psi4/src/psi4/cclambda/cache.cc +++ b/psi4/src/psi4/cclambda/cache.cc @@ -38,7 +38,7 @@ #include "psi4/cclambda/cclambda.h" namespace psi { -extern FILE* outfile; +extern FILE *outfile; namespace cclambda { void cache_abcd_rhf(int **cachelist); @@ -55,705 +55,672 @@ void cache_iajb_uhf(int **cachelist); void cache_ijka_uhf(int **cachelist); void cache_ijkl_uhf(int **cachelist); -int **CCLambdaWavefunction::cacheprep_uhf(int level, int *cachefiles) -{ - int **cachelist; - - /* The listing of CC files whose entries may be cached */ - cachefiles[PSIF_CC_AINTS] = 1; - cachefiles[PSIF_CC_CINTS] = 1; - cachefiles[PSIF_CC_DINTS] = 1; - cachefiles[PSIF_CC_EINTS] = 1; - cachefiles[PSIF_CC_DENOM] = 1; - cachefiles[PSIF_CC_TAMPS] = 1; - cachefiles[PSIF_CC_LAMBDA] = 1; - cachefiles[PSIF_CC_HBAR] = 1; - - /* The listing of DPD patterns which may be cached */ - cachelist = init_int_matrix(32,32); - - if(level == 0) return cachelist; - else if(level == 1) { - - /*** Cache oooo and ooov ***/ - cache_ijkl_uhf(cachelist); - cache_ijka_uhf(cachelist); - - return cachelist; +int **CCLambdaWavefunction::cacheprep_uhf(int level, int *cachefiles) { + int **cachelist; + + /* The listing of CC files whose entries may be cached */ + cachefiles[PSIF_CC_AINTS] = 1; + cachefiles[PSIF_CC_CINTS] = 1; + cachefiles[PSIF_CC_DINTS] = 1; + cachefiles[PSIF_CC_EINTS] = 1; + cachefiles[PSIF_CC_DENOM] = 1; + cachefiles[PSIF_CC_TAMPS] = 1; + cachefiles[PSIF_CC_LAMBDA] = 1; + cachefiles[PSIF_CC_HBAR] = 1; + + /* The listing of DPD patterns which may be cached */ + cachelist = init_int_matrix(32, 32); + + if (level == 0) + return cachelist; + else if (level == 1) { + /*** Cache oooo and ooov ***/ + cache_ijkl_uhf(cachelist); + cache_ijka_uhf(cachelist); + + return cachelist; + } else if (level == 2) { + /*** Cache oooo, ooov, oovv, and ovov ***/ + cache_ijkl_uhf(cachelist); + cache_ijka_uhf(cachelist); + cache_ijab_uhf(cachelist); + cache_iajb_uhf(cachelist); + + return cachelist; + } else if (level == 3) { + /*** Cache, oooo, oov, oovv, ovov, and ovvv ***/ + + cache_ijkl_uhf(cachelist); + cache_ijka_uhf(cachelist); + cache_ijab_uhf(cachelist); + cache_iajb_uhf(cachelist); + cache_iabc_uhf(cachelist); + + return cachelist; + } else if (level == 4) { + /*** Cache everything ***/ + cache_ijkl_uhf(cachelist); + cache_ijka_uhf(cachelist); + cache_ijab_uhf(cachelist); + cache_iajb_uhf(cachelist); + cache_iabc_uhf(cachelist); + cache_abcd_uhf(cachelist); + + return cachelist; + } else { + printf("Error: invalid cache level!\n"); + throw PsiException("cclambda: error", __FILE__, __LINE__); } - else if(level == 2) { - - /*** Cache oooo, ooov, oovv, and ovov ***/ - cache_ijkl_uhf(cachelist); - cache_ijka_uhf(cachelist); - cache_ijab_uhf(cachelist); - cache_iajb_uhf(cachelist); - - return cachelist; - } - else if(level == 3) { - - /*** Cache, oooo, oov, oovv, ovov, and ovvv ***/ - - cache_ijkl_uhf(cachelist); - cache_ijka_uhf(cachelist); - cache_ijab_uhf(cachelist); - cache_iajb_uhf(cachelist); - cache_iabc_uhf(cachelist); - - return cachelist; - } - else if(level == 4) { - - /*** Cache everything ***/ - cache_ijkl_uhf(cachelist); - cache_ijka_uhf(cachelist); - cache_ijab_uhf(cachelist); - cache_iajb_uhf(cachelist); - cache_iabc_uhf(cachelist); - cache_abcd_uhf(cachelist); - - return cachelist; - } - else { - printf("Error: invalid cache level!\n"); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } } -int **CCLambdaWavefunction::cacheprep_rhf(int level, int *cachefiles) -{ - int **cachelist; - - /* The listing of CC files whose entries may be cached */ - cachefiles[PSIF_CC_AINTS] = 1; - cachefiles[PSIF_CC_CINTS] = 1; - cachefiles[PSIF_CC_DINTS] = 1; - cachefiles[PSIF_CC_EINTS] = 1; - cachefiles[PSIF_CC_DENOM] = 1; - cachefiles[PSIF_CC_TAMPS] = 1; - cachefiles[PSIF_CC_LAMBDA] = 1; - cachefiles[PSIF_CC_HBAR] = 1; - - /* The listing of DPD patterns which may be cached */ - cachelist = init_int_matrix(12,12); - - if(level == 0) return cachelist; - else if(level == 1) { - - /*** Cache oooo and ooov ***/ - cache_ijkl_rhf(cachelist); - cache_ijka_rhf(cachelist); - - return cachelist; - } - else if(level == 2) { - - /*** Cache oooo, ooov, oovv, and ovov ***/ - cache_ijkl_rhf(cachelist); - cache_ijka_rhf(cachelist); - cache_ijab_rhf(cachelist); - cache_iajb_rhf(cachelist); - - return cachelist; - } - else if(level == 3) { - - /*** Cache, oooo, oov, oovv, ovov, and ovvv ***/ - - cache_ijkl_rhf(cachelist); - cache_ijka_rhf(cachelist); - cache_ijab_rhf(cachelist); - cache_iajb_rhf(cachelist); - cache_iabc_rhf(cachelist); - - return cachelist; - } - else if(level == 4) { - - /*** Cache everything ***/ - cache_ijkl_rhf(cachelist); - cache_ijka_rhf(cachelist); - cache_ijab_rhf(cachelist); - cache_iajb_rhf(cachelist); - cache_iabc_rhf(cachelist); - cache_abcd_rhf(cachelist); - - return cachelist; - } - else { - printf("Error: invalid cache level!\n"); - throw PsiException("cclambda: error", __FILE__, __LINE__); +int **CCLambdaWavefunction::cacheprep_rhf(int level, int *cachefiles) { + int **cachelist; + + /* The listing of CC files whose entries may be cached */ + cachefiles[PSIF_CC_AINTS] = 1; + cachefiles[PSIF_CC_CINTS] = 1; + cachefiles[PSIF_CC_DINTS] = 1; + cachefiles[PSIF_CC_EINTS] = 1; + cachefiles[PSIF_CC_DENOM] = 1; + cachefiles[PSIF_CC_TAMPS] = 1; + cachefiles[PSIF_CC_LAMBDA] = 1; + cachefiles[PSIF_CC_HBAR] = 1; + + /* The listing of DPD patterns which may be cached */ + cachelist = init_int_matrix(12, 12); + + if (level == 0) + return cachelist; + else if (level == 1) { + /*** Cache oooo and ooov ***/ + cache_ijkl_rhf(cachelist); + cache_ijka_rhf(cachelist); + + return cachelist; + } else if (level == 2) { + /*** Cache oooo, ooov, oovv, and ovov ***/ + cache_ijkl_rhf(cachelist); + cache_ijka_rhf(cachelist); + cache_ijab_rhf(cachelist); + cache_iajb_rhf(cachelist); + + return cachelist; + } else if (level == 3) { + /*** Cache, oooo, oov, oovv, ovov, and ovvv ***/ + + cache_ijkl_rhf(cachelist); + cache_ijka_rhf(cachelist); + cache_ijab_rhf(cachelist); + cache_iajb_rhf(cachelist); + cache_iabc_rhf(cachelist); + + return cachelist; + } else if (level == 4) { + /*** Cache everything ***/ + cache_ijkl_rhf(cachelist); + cache_ijka_rhf(cachelist); + cache_ijab_rhf(cachelist); + cache_iajb_rhf(cachelist); + cache_iabc_rhf(cachelist); + cache_abcd_rhf(cachelist); + + return cachelist; + } else { + printf("Error: invalid cache level!\n"); + throw PsiException("cclambda: error", __FILE__, __LINE__); } } -void cache_abcd_uhf(int **cachelist) -{ - /* */ - cachelist[5][5] = 1; - cachelist[5][6] = 1; - cachelist[5][7] = 1; - cachelist[5][8] = 1; - cachelist[5][9] = 1; - cachelist[6][5] = 1; - cachelist[6][6] = 1; - cachelist[6][7] = 1; - cachelist[6][8] = 1; - cachelist[6][9] = 1; - cachelist[7][5] = 1; - cachelist[7][6] = 1; - cachelist[7][7] = 1; - cachelist[7][8] = 1; - cachelist[7][9] = 1; - cachelist[8][5] = 1; - cachelist[8][6] = 1; - cachelist[8][7] = 1; - cachelist[8][8] = 1; - cachelist[8][9] = 1; - cachelist[9][5] = 1; - cachelist[9][6] = 1; - cachelist[9][7] = 1; - cachelist[9][8] = 1; - cachelist[9][9] = 1; - /* */ - cachelist[15][15] = 1; - cachelist[15][16] = 1; - cachelist[15][17] = 1; - cachelist[15][18] = 1; - cachelist[15][19] = 1; - cachelist[16][15] = 1; - cachelist[16][16] = 1; - cachelist[16][17] = 1; - cachelist[16][18] = 1; - cachelist[16][19] = 1; - cachelist[17][15] = 1; - cachelist[17][16] = 1; - cachelist[17][17] = 1; - cachelist[17][18] = 1; - cachelist[17][19] = 1; - cachelist[18][15] = 1; - cachelist[18][16] = 1; - cachelist[18][17] = 1; - cachelist[18][18] = 1; - cachelist[18][19] = 1; - cachelist[19][15] = 1; - cachelist[19][16] = 1; - cachelist[19][17] = 1; - cachelist[19][18] = 1; - cachelist[19][19] = 1; - /* */ - cachelist[28][28] = 1; - cachelist[29][29] = 1; - cachelist[28][29] = 1; - cachelist[29][28] = 1; +void cache_abcd_uhf(int **cachelist) { + /* */ + cachelist[5][5] = 1; + cachelist[5][6] = 1; + cachelist[5][7] = 1; + cachelist[5][8] = 1; + cachelist[5][9] = 1; + cachelist[6][5] = 1; + cachelist[6][6] = 1; + cachelist[6][7] = 1; + cachelist[6][8] = 1; + cachelist[6][9] = 1; + cachelist[7][5] = 1; + cachelist[7][6] = 1; + cachelist[7][7] = 1; + cachelist[7][8] = 1; + cachelist[7][9] = 1; + cachelist[8][5] = 1; + cachelist[8][6] = 1; + cachelist[8][7] = 1; + cachelist[8][8] = 1; + cachelist[8][9] = 1; + cachelist[9][5] = 1; + cachelist[9][6] = 1; + cachelist[9][7] = 1; + cachelist[9][8] = 1; + cachelist[9][9] = 1; + /* */ + cachelist[15][15] = 1; + cachelist[15][16] = 1; + cachelist[15][17] = 1; + cachelist[15][18] = 1; + cachelist[15][19] = 1; + cachelist[16][15] = 1; + cachelist[16][16] = 1; + cachelist[16][17] = 1; + cachelist[16][18] = 1; + cachelist[16][19] = 1; + cachelist[17][15] = 1; + cachelist[17][16] = 1; + cachelist[17][17] = 1; + cachelist[17][18] = 1; + cachelist[17][19] = 1; + cachelist[18][15] = 1; + cachelist[18][16] = 1; + cachelist[18][17] = 1; + cachelist[18][18] = 1; + cachelist[18][19] = 1; + cachelist[19][15] = 1; + cachelist[19][16] = 1; + cachelist[19][17] = 1; + cachelist[19][18] = 1; + cachelist[19][19] = 1; + /* */ + cachelist[28][28] = 1; + cachelist[29][29] = 1; + cachelist[28][29] = 1; + cachelist[29][28] = 1; } -void cache_abcd_rhf(int **cachelist) -{ - /* */ - cachelist[5][5] = 1; - cachelist[5][6] = 1; - cachelist[5][7] = 1; - cachelist[5][8] = 1; - cachelist[5][9] = 1; - cachelist[6][5] = 1; - cachelist[6][6] = 1; - cachelist[6][7] = 1; - cachelist[6][8] = 1; - cachelist[6][9] = 1; - cachelist[7][5] = 1; - cachelist[7][6] = 1; - cachelist[7][7] = 1; - cachelist[7][8] = 1; - cachelist[7][9] = 1; - cachelist[8][5] = 1; - cachelist[8][6] = 1; - cachelist[8][7] = 1; - cachelist[8][8] = 1; - cachelist[8][9] = 1; - cachelist[9][5] = 1; - cachelist[9][6] = 1; - cachelist[9][7] = 1; - cachelist[9][8] = 1; - cachelist[9][9] = 1; +void cache_abcd_rhf(int **cachelist) { + /* */ + cachelist[5][5] = 1; + cachelist[5][6] = 1; + cachelist[5][7] = 1; + cachelist[5][8] = 1; + cachelist[5][9] = 1; + cachelist[6][5] = 1; + cachelist[6][6] = 1; + cachelist[6][7] = 1; + cachelist[6][8] = 1; + cachelist[6][9] = 1; + cachelist[7][5] = 1; + cachelist[7][6] = 1; + cachelist[7][7] = 1; + cachelist[7][8] = 1; + cachelist[7][9] = 1; + cachelist[8][5] = 1; + cachelist[8][6] = 1; + cachelist[8][7] = 1; + cachelist[8][8] = 1; + cachelist[8][9] = 1; + cachelist[9][5] = 1; + cachelist[9][6] = 1; + cachelist[9][7] = 1; + cachelist[9][8] = 1; + cachelist[9][9] = 1; } -void cache_iabc_rhf(int **cachelist) -{ - /* */ - cachelist[10][5] = 1; - cachelist[10][6] = 1; - cachelist[10][7] = 1; - cachelist[10][8] = 1; - cachelist[10][9] = 1; - cachelist[11][5] = 1; - cachelist[11][6] = 1; - cachelist[11][7] = 1; - cachelist[11][8] = 1; - cachelist[11][9] = 1; - /* */ - cachelist[5][10] = 1; - cachelist[5][11] = 1; - cachelist[6][10] = 1; - cachelist[6][11] = 1; - cachelist[7][10] = 1; - cachelist[7][11] = 1; - cachelist[8][10] = 1; - cachelist[8][11] = 1; - cachelist[9][10] = 1; - cachelist[9][11] = 1; +void cache_iabc_rhf(int **cachelist) { + /* */ + cachelist[10][5] = 1; + cachelist[10][6] = 1; + cachelist[10][7] = 1; + cachelist[10][8] = 1; + cachelist[10][9] = 1; + cachelist[11][5] = 1; + cachelist[11][6] = 1; + cachelist[11][7] = 1; + cachelist[11][8] = 1; + cachelist[11][9] = 1; + /* */ + cachelist[5][10] = 1; + cachelist[5][11] = 1; + cachelist[6][10] = 1; + cachelist[6][11] = 1; + cachelist[7][10] = 1; + cachelist[7][11] = 1; + cachelist[8][10] = 1; + cachelist[8][11] = 1; + cachelist[9][10] = 1; + cachelist[9][11] = 1; } -void cache_iabc_uhf(int **cachelist) -{ - /* */ - cachelist[20][5] = 1; - cachelist[20][6] = 1; - cachelist[20][7] = 1; - cachelist[20][8] = 1; - cachelist[20][9] = 1; - cachelist[21][5] = 1; - cachelist[21][6] = 1; - cachelist[21][7] = 1; - cachelist[21][8] = 1; - cachelist[21][9] = 1; - /* */ - cachelist[5][20] = 1; - cachelist[5][21] = 1; - cachelist[6][20] = 1; - cachelist[6][21] = 1; - cachelist[7][20] = 1; - cachelist[7][21] = 1; - cachelist[8][20] = 1; - cachelist[8][21] = 1; - cachelist[9][20] = 1; - cachelist[9][21] = 1; - - /* */ - cachelist[30][15] = 1; - cachelist[30][16] = 1; - cachelist[30][17] = 1; - cachelist[30][18] = 1; - cachelist[30][19] = 1; - cachelist[31][15] = 1; - cachelist[31][16] = 1; - cachelist[31][17] = 1; - cachelist[31][18] = 1; - cachelist[31][19] = 1; - /* */ - cachelist[15][30] = 1; - cachelist[15][31] = 1; - cachelist[16][30] = 1; - cachelist[16][31] = 1; - cachelist[17][30] = 1; - cachelist[17][31] = 1; - cachelist[18][30] = 1; - cachelist[18][31] = 1; - cachelist[19][30] = 1; - cachelist[19][31] = 1; - - /* */ - cachelist[24][28] = 1; - cachelist[24][29] = 1; - cachelist[25][28] = 1; - cachelist[25][29] = 1; - - /* */ - cachelist[28][24] = 1; - cachelist[28][25] = 1; - cachelist[29][24] = 1; - cachelist[29][25] = 1; +void cache_iabc_uhf(int **cachelist) { + /* */ + cachelist[20][5] = 1; + cachelist[20][6] = 1; + cachelist[20][7] = 1; + cachelist[20][8] = 1; + cachelist[20][9] = 1; + cachelist[21][5] = 1; + cachelist[21][6] = 1; + cachelist[21][7] = 1; + cachelist[21][8] = 1; + cachelist[21][9] = 1; + /* */ + cachelist[5][20] = 1; + cachelist[5][21] = 1; + cachelist[6][20] = 1; + cachelist[6][21] = 1; + cachelist[7][20] = 1; + cachelist[7][21] = 1; + cachelist[8][20] = 1; + cachelist[8][21] = 1; + cachelist[9][20] = 1; + cachelist[9][21] = 1; + + /* */ + cachelist[30][15] = 1; + cachelist[30][16] = 1; + cachelist[30][17] = 1; + cachelist[30][18] = 1; + cachelist[30][19] = 1; + cachelist[31][15] = 1; + cachelist[31][16] = 1; + cachelist[31][17] = 1; + cachelist[31][18] = 1; + cachelist[31][19] = 1; + /* */ + cachelist[15][30] = 1; + cachelist[15][31] = 1; + cachelist[16][30] = 1; + cachelist[16][31] = 1; + cachelist[17][30] = 1; + cachelist[17][31] = 1; + cachelist[18][30] = 1; + cachelist[18][31] = 1; + cachelist[19][30] = 1; + cachelist[19][31] = 1; + + /* */ + cachelist[24][28] = 1; + cachelist[24][29] = 1; + cachelist[25][28] = 1; + cachelist[25][29] = 1; + + /* */ + cachelist[28][24] = 1; + cachelist[28][25] = 1; + cachelist[29][24] = 1; + cachelist[29][25] = 1; } -void cache_ijab_rhf(int **cachelist) -{ - /* */ - cachelist[0][5] = 1; - cachelist[0][6] = 1; - cachelist[0][7] = 1; - cachelist[0][8] = 1; - cachelist[0][9] = 1; - cachelist[1][5] = 1; - cachelist[1][6] = 1; - cachelist[1][7] = 1; - cachelist[1][8] = 1; - cachelist[1][9] = 1; - cachelist[2][5] = 1; - cachelist[2][6] = 1; - cachelist[2][7] = 1; - cachelist[2][8] = 1; - cachelist[2][9] = 1; - cachelist[3][5] = 1; - cachelist[3][6] = 1; - cachelist[3][7] = 1; - cachelist[3][8] = 1; - cachelist[3][9] = 1; - cachelist[4][5] = 1; - cachelist[4][6] = 1; - cachelist[4][7] = 1; - cachelist[4][8] = 1; - cachelist[4][9] = 1; - /* */ - cachelist[5][0] = 1; - cachelist[5][1] = 1; - cachelist[5][2] = 1; - cachelist[5][3] = 1; - cachelist[5][4] = 1; - cachelist[6][0] = 1; - cachelist[6][1] = 1; - cachelist[6][2] = 1; - cachelist[6][3] = 1; - cachelist[6][4] = 1; - cachelist[7][0] = 1; - cachelist[7][1] = 1; - cachelist[7][2] = 1; - cachelist[7][3] = 1; - cachelist[7][4] = 1; - cachelist[8][0] = 1; - cachelist[8][1] = 1; - cachelist[8][2] = 1; - cachelist[8][3] = 1; - cachelist[8][4] = 1; - cachelist[9][0] = 1; - cachelist[9][1] = 1; - cachelist[9][2] = 1; - cachelist[9][3] = 1; - cachelist[9][4] = 1; +void cache_ijab_rhf(int **cachelist) { + /* */ + cachelist[0][5] = 1; + cachelist[0][6] = 1; + cachelist[0][7] = 1; + cachelist[0][8] = 1; + cachelist[0][9] = 1; + cachelist[1][5] = 1; + cachelist[1][6] = 1; + cachelist[1][7] = 1; + cachelist[1][8] = 1; + cachelist[1][9] = 1; + cachelist[2][5] = 1; + cachelist[2][6] = 1; + cachelist[2][7] = 1; + cachelist[2][8] = 1; + cachelist[2][9] = 1; + cachelist[3][5] = 1; + cachelist[3][6] = 1; + cachelist[3][7] = 1; + cachelist[3][8] = 1; + cachelist[3][9] = 1; + cachelist[4][5] = 1; + cachelist[4][6] = 1; + cachelist[4][7] = 1; + cachelist[4][8] = 1; + cachelist[4][9] = 1; + /* */ + cachelist[5][0] = 1; + cachelist[5][1] = 1; + cachelist[5][2] = 1; + cachelist[5][3] = 1; + cachelist[5][4] = 1; + cachelist[6][0] = 1; + cachelist[6][1] = 1; + cachelist[6][2] = 1; + cachelist[6][3] = 1; + cachelist[6][4] = 1; + cachelist[7][0] = 1; + cachelist[7][1] = 1; + cachelist[7][2] = 1; + cachelist[7][3] = 1; + cachelist[7][4] = 1; + cachelist[8][0] = 1; + cachelist[8][1] = 1; + cachelist[8][2] = 1; + cachelist[8][3] = 1; + cachelist[8][4] = 1; + cachelist[9][0] = 1; + cachelist[9][1] = 1; + cachelist[9][2] = 1; + cachelist[9][3] = 1; + cachelist[9][4] = 1; } -void cache_ijab_uhf(int **cachelist) -{ - /* */ - cachelist[0][5] = 1; - cachelist[0][6] = 1; - cachelist[0][7] = 1; - cachelist[0][8] = 1; - cachelist[0][9] = 1; - cachelist[1][5] = 1; - cachelist[1][6] = 1; - cachelist[1][7] = 1; - cachelist[1][8] = 1; - cachelist[1][9] = 1; - cachelist[2][5] = 1; - cachelist[2][6] = 1; - cachelist[2][7] = 1; - cachelist[2][8] = 1; - cachelist[2][9] = 1; - cachelist[3][5] = 1; - cachelist[3][6] = 1; - cachelist[3][7] = 1; - cachelist[3][8] = 1; - cachelist[3][9] = 1; - cachelist[4][5] = 1; - cachelist[4][6] = 1; - cachelist[4][7] = 1; - cachelist[4][8] = 1; - cachelist[4][9] = 1; - /* */ - cachelist[5][0] = 1; - cachelist[5][1] = 1; - cachelist[5][2] = 1; - cachelist[5][3] = 1; - cachelist[5][4] = 1; - cachelist[6][0] = 1; - cachelist[6][1] = 1; - cachelist[6][2] = 1; - cachelist[6][3] = 1; - cachelist[6][4] = 1; - cachelist[7][0] = 1; - cachelist[7][1] = 1; - cachelist[7][2] = 1; - cachelist[7][3] = 1; - cachelist[7][4] = 1; - cachelist[8][0] = 1; - cachelist[8][1] = 1; - cachelist[8][2] = 1; - cachelist[8][3] = 1; - cachelist[8][4] = 1; - cachelist[9][0] = 1; - cachelist[9][1] = 1; - cachelist[9][2] = 1; - cachelist[9][3] = 1; - cachelist[9][4] = 1; - - /* */ - cachelist[10][15] = 1; - cachelist[10][16] = 1; - cachelist[10][17] = 1; - cachelist[10][18] = 1; - cachelist[10][19] = 1; - cachelist[11][15] = 1; - cachelist[11][16] = 1; - cachelist[11][17] = 1; - cachelist[11][18] = 1; - cachelist[11][19] = 1; - cachelist[12][15] = 1; - cachelist[12][16] = 1; - cachelist[12][17] = 1; - cachelist[12][18] = 1; - cachelist[12][19] = 1; - cachelist[13][15] = 1; - cachelist[13][16] = 1; - cachelist[13][17] = 1; - cachelist[13][18] = 1; - cachelist[13][19] = 1; - cachelist[14][15] = 1; - cachelist[14][16] = 1; - cachelist[14][17] = 1; - cachelist[14][18] = 1; - cachelist[14][19] = 1; - /* */ - cachelist[15][10] = 1; - cachelist[15][11] = 1; - cachelist[15][12] = 1; - cachelist[15][13] = 1; - cachelist[15][14] = 1; - cachelist[16][10] = 1; - cachelist[16][11] = 1; - cachelist[16][12] = 1; - cachelist[16][13] = 1; - cachelist[16][14] = 1; - cachelist[17][10] = 1; - cachelist[17][11] = 1; - cachelist[17][12] = 1; - cachelist[17][13] = 1; - cachelist[17][14] = 1; - cachelist[18][10] = 1; - cachelist[18][11] = 1; - cachelist[18][12] = 1; - cachelist[18][13] = 1; - cachelist[18][14] = 1; - cachelist[19][10] = 1; - cachelist[19][11] = 1; - cachelist[19][12] = 1; - cachelist[19][13] = 1; - cachelist[19][14] = 1; - - /* */ - cachelist[22][28] = 1; - cachelist[23][28] = 1; - cachelist[22][29] = 1; - cachelist[23][29] = 1; - /* */ - cachelist[28][22] = 1; - cachelist[28][23] = 1; - cachelist[29][22] = 1; - cachelist[29][23] = 1; +void cache_ijab_uhf(int **cachelist) { + /* */ + cachelist[0][5] = 1; + cachelist[0][6] = 1; + cachelist[0][7] = 1; + cachelist[0][8] = 1; + cachelist[0][9] = 1; + cachelist[1][5] = 1; + cachelist[1][6] = 1; + cachelist[1][7] = 1; + cachelist[1][8] = 1; + cachelist[1][9] = 1; + cachelist[2][5] = 1; + cachelist[2][6] = 1; + cachelist[2][7] = 1; + cachelist[2][8] = 1; + cachelist[2][9] = 1; + cachelist[3][5] = 1; + cachelist[3][6] = 1; + cachelist[3][7] = 1; + cachelist[3][8] = 1; + cachelist[3][9] = 1; + cachelist[4][5] = 1; + cachelist[4][6] = 1; + cachelist[4][7] = 1; + cachelist[4][8] = 1; + cachelist[4][9] = 1; + /* */ + cachelist[5][0] = 1; + cachelist[5][1] = 1; + cachelist[5][2] = 1; + cachelist[5][3] = 1; + cachelist[5][4] = 1; + cachelist[6][0] = 1; + cachelist[6][1] = 1; + cachelist[6][2] = 1; + cachelist[6][3] = 1; + cachelist[6][4] = 1; + cachelist[7][0] = 1; + cachelist[7][1] = 1; + cachelist[7][2] = 1; + cachelist[7][3] = 1; + cachelist[7][4] = 1; + cachelist[8][0] = 1; + cachelist[8][1] = 1; + cachelist[8][2] = 1; + cachelist[8][3] = 1; + cachelist[8][4] = 1; + cachelist[9][0] = 1; + cachelist[9][1] = 1; + cachelist[9][2] = 1; + cachelist[9][3] = 1; + cachelist[9][4] = 1; + + /* */ + cachelist[10][15] = 1; + cachelist[10][16] = 1; + cachelist[10][17] = 1; + cachelist[10][18] = 1; + cachelist[10][19] = 1; + cachelist[11][15] = 1; + cachelist[11][16] = 1; + cachelist[11][17] = 1; + cachelist[11][18] = 1; + cachelist[11][19] = 1; + cachelist[12][15] = 1; + cachelist[12][16] = 1; + cachelist[12][17] = 1; + cachelist[12][18] = 1; + cachelist[12][19] = 1; + cachelist[13][15] = 1; + cachelist[13][16] = 1; + cachelist[13][17] = 1; + cachelist[13][18] = 1; + cachelist[13][19] = 1; + cachelist[14][15] = 1; + cachelist[14][16] = 1; + cachelist[14][17] = 1; + cachelist[14][18] = 1; + cachelist[14][19] = 1; + /* */ + cachelist[15][10] = 1; + cachelist[15][11] = 1; + cachelist[15][12] = 1; + cachelist[15][13] = 1; + cachelist[15][14] = 1; + cachelist[16][10] = 1; + cachelist[16][11] = 1; + cachelist[16][12] = 1; + cachelist[16][13] = 1; + cachelist[16][14] = 1; + cachelist[17][10] = 1; + cachelist[17][11] = 1; + cachelist[17][12] = 1; + cachelist[17][13] = 1; + cachelist[17][14] = 1; + cachelist[18][10] = 1; + cachelist[18][11] = 1; + cachelist[18][12] = 1; + cachelist[18][13] = 1; + cachelist[18][14] = 1; + cachelist[19][10] = 1; + cachelist[19][11] = 1; + cachelist[19][12] = 1; + cachelist[19][13] = 1; + cachelist[19][14] = 1; + + /* */ + cachelist[22][28] = 1; + cachelist[23][28] = 1; + cachelist[22][29] = 1; + cachelist[23][29] = 1; + /* */ + cachelist[28][22] = 1; + cachelist[28][23] = 1; + cachelist[29][22] = 1; + cachelist[29][23] = 1; } -void cache_iajb_rhf(int **cachelist) -{ - /* */ - cachelist[10][10] = 1; - cachelist[10][11] = 1; - cachelist[11][10] = 1; - cachelist[11][11] = 1; +void cache_iajb_rhf(int **cachelist) { + /* */ + cachelist[10][10] = 1; + cachelist[10][11] = 1; + cachelist[11][10] = 1; + cachelist[11][11] = 1; } -void cache_iajb_uhf(int **cachelist) -{ - /* */ - cachelist[20][20] = 1; - cachelist[20][21] = 1; - cachelist[21][20] = 1; - cachelist[21][21] = 1; - /* */ - cachelist[30][30] = 1; - cachelist[30][31] = 1; - cachelist[31][30] = 1; - cachelist[31][31] = 1; - /* */ - cachelist[24][24] = 1; - cachelist[24][25] = 1; - cachelist[25][24] = 1; - cachelist[25][25] = 1; +void cache_iajb_uhf(int **cachelist) { + /* */ + cachelist[20][20] = 1; + cachelist[20][21] = 1; + cachelist[21][20] = 1; + cachelist[21][21] = 1; + /* */ + cachelist[30][30] = 1; + cachelist[30][31] = 1; + cachelist[31][30] = 1; + cachelist[31][31] = 1; + /* */ + cachelist[24][24] = 1; + cachelist[24][25] = 1; + cachelist[25][24] = 1; + cachelist[25][25] = 1; } -void cache_ijka_rhf(int **cachelist) -{ - /* */ - cachelist[0][10] = 1; - cachelist[0][11] = 1; - cachelist[1][10] = 1; - cachelist[1][11] = 1; - cachelist[2][10] = 1; - cachelist[2][11] = 1; - cachelist[3][10] = 1; - cachelist[3][11] = 1; - cachelist[4][10] = 1; - cachelist[4][11] = 1; - /* */ - cachelist[10][0] = 1; - cachelist[10][1] = 1; - cachelist[10][2] = 1; - cachelist[10][3] = 1; - cachelist[10][4] = 1; - cachelist[11][0] = 1; - cachelist[11][1] = 1; - cachelist[11][2] = 1; - cachelist[11][3] = 1; - cachelist[11][4] = 1; +void cache_ijka_rhf(int **cachelist) { + /* */ + cachelist[0][10] = 1; + cachelist[0][11] = 1; + cachelist[1][10] = 1; + cachelist[1][11] = 1; + cachelist[2][10] = 1; + cachelist[2][11] = 1; + cachelist[3][10] = 1; + cachelist[3][11] = 1; + cachelist[4][10] = 1; + cachelist[4][11] = 1; + /* */ + cachelist[10][0] = 1; + cachelist[10][1] = 1; + cachelist[10][2] = 1; + cachelist[10][3] = 1; + cachelist[10][4] = 1; + cachelist[11][0] = 1; + cachelist[11][1] = 1; + cachelist[11][2] = 1; + cachelist[11][3] = 1; + cachelist[11][4] = 1; } -void cache_ijka_uhf(int **cachelist) -{ - /* */ - cachelist[0][20] = 1; - cachelist[0][21] = 1; - cachelist[1][20] = 1; - cachelist[1][21] = 1; - cachelist[2][20] = 1; - cachelist[2][21] = 1; - cachelist[3][20] = 1; - cachelist[3][21] = 1; - cachelist[4][20] = 1; - cachelist[4][21] = 1; - /* */ - cachelist[20][0] = 1; - cachelist[20][1] = 1; - cachelist[20][2] = 1; - cachelist[20][3] = 1; - cachelist[20][4] = 1; - cachelist[21][0] = 1; - cachelist[21][1] = 1; - cachelist[21][2] = 1; - cachelist[21][3] = 1; - cachelist[21][4] = 1; - - /* */ - cachelist[10][30] = 1; - cachelist[10][31] = 1; - cachelist[11][30] = 1; - cachelist[11][31] = 1; - cachelist[12][30] = 1; - cachelist[12][31] = 1; - cachelist[13][30] = 1; - cachelist[13][31] = 1; - cachelist[14][30] = 1; - cachelist[14][31] = 1; - /* */ - cachelist[30][10] = 1; - cachelist[30][11] = 1; - cachelist[30][12] = 1; - cachelist[30][13] = 1; - cachelist[30][14] = 1; - cachelist[31][10] = 1; - cachelist[31][11] = 1; - cachelist[31][12] = 1; - cachelist[31][13] = 1; - cachelist[31][14] = 1; - - /* */ - cachelist[22][24] = 1; - cachelist[22][25] = 1; - cachelist[23][24] = 1; - cachelist[23][25] = 1; - /* */ - cachelist[24][22] = 1; - cachelist[25][22] = 1; - cachelist[24][23] = 1; - cachelist[25][23] = 1; +void cache_ijka_uhf(int **cachelist) { + /* */ + cachelist[0][20] = 1; + cachelist[0][21] = 1; + cachelist[1][20] = 1; + cachelist[1][21] = 1; + cachelist[2][20] = 1; + cachelist[2][21] = 1; + cachelist[3][20] = 1; + cachelist[3][21] = 1; + cachelist[4][20] = 1; + cachelist[4][21] = 1; + /* */ + cachelist[20][0] = 1; + cachelist[20][1] = 1; + cachelist[20][2] = 1; + cachelist[20][3] = 1; + cachelist[20][4] = 1; + cachelist[21][0] = 1; + cachelist[21][1] = 1; + cachelist[21][2] = 1; + cachelist[21][3] = 1; + cachelist[21][4] = 1; + + /* */ + cachelist[10][30] = 1; + cachelist[10][31] = 1; + cachelist[11][30] = 1; + cachelist[11][31] = 1; + cachelist[12][30] = 1; + cachelist[12][31] = 1; + cachelist[13][30] = 1; + cachelist[13][31] = 1; + cachelist[14][30] = 1; + cachelist[14][31] = 1; + /* */ + cachelist[30][10] = 1; + cachelist[30][11] = 1; + cachelist[30][12] = 1; + cachelist[30][13] = 1; + cachelist[30][14] = 1; + cachelist[31][10] = 1; + cachelist[31][11] = 1; + cachelist[31][12] = 1; + cachelist[31][13] = 1; + cachelist[31][14] = 1; + + /* */ + cachelist[22][24] = 1; + cachelist[22][25] = 1; + cachelist[23][24] = 1; + cachelist[23][25] = 1; + /* */ + cachelist[24][22] = 1; + cachelist[25][22] = 1; + cachelist[24][23] = 1; + cachelist[25][23] = 1; } -void cache_ijkl_rhf(int **cachelist) -{ - /* */ - cachelist[0][0] = 1; - cachelist[0][1] = 1; - cachelist[0][2] = 1; - cachelist[0][3] = 1; - cachelist[0][4] = 1; - cachelist[1][0] = 1; - cachelist[1][1] = 1; - cachelist[1][2] = 1; - cachelist[1][3] = 1; - cachelist[1][4] = 1; - cachelist[2][0] = 1; - cachelist[2][1] = 1; - cachelist[2][2] = 1; - cachelist[2][3] = 1; - cachelist[2][4] = 1; - cachelist[3][0] = 1; - cachelist[3][1] = 1; - cachelist[3][2] = 1; - cachelist[3][3] = 1; - cachelist[3][4] = 1; - cachelist[4][0] = 1; - cachelist[4][1] = 1; - cachelist[4][2] = 1; - cachelist[4][3] = 1; - cachelist[4][4] = 1; +void cache_ijkl_rhf(int **cachelist) { + /* */ + cachelist[0][0] = 1; + cachelist[0][1] = 1; + cachelist[0][2] = 1; + cachelist[0][3] = 1; + cachelist[0][4] = 1; + cachelist[1][0] = 1; + cachelist[1][1] = 1; + cachelist[1][2] = 1; + cachelist[1][3] = 1; + cachelist[1][4] = 1; + cachelist[2][0] = 1; + cachelist[2][1] = 1; + cachelist[2][2] = 1; + cachelist[2][3] = 1; + cachelist[2][4] = 1; + cachelist[3][0] = 1; + cachelist[3][1] = 1; + cachelist[3][2] = 1; + cachelist[3][3] = 1; + cachelist[3][4] = 1; + cachelist[4][0] = 1; + cachelist[4][1] = 1; + cachelist[4][2] = 1; + cachelist[4][3] = 1; + cachelist[4][4] = 1; } -void cache_ijkl_uhf(int **cachelist) -{ - /* */ - cachelist[0][0] = 1; - cachelist[0][1] = 1; - cachelist[0][2] = 1; - cachelist[0][3] = 1; - cachelist[0][4] = 1; - cachelist[1][0] = 1; - cachelist[1][1] = 1; - cachelist[1][2] = 1; - cachelist[1][3] = 1; - cachelist[1][4] = 1; - cachelist[2][0] = 1; - cachelist[2][1] = 1; - cachelist[2][2] = 1; - cachelist[2][3] = 1; - cachelist[2][4] = 1; - cachelist[3][0] = 1; - cachelist[3][1] = 1; - cachelist[3][2] = 1; - cachelist[3][3] = 1; - cachelist[3][4] = 1; - cachelist[4][0] = 1; - cachelist[4][1] = 1; - cachelist[4][2] = 1; - cachelist[4][3] = 1; - cachelist[4][4] = 1; - /* */ - cachelist[10][10] = 1; - cachelist[10][11] = 1; - cachelist[10][12] = 1; - cachelist[10][13] = 1; - cachelist[10][14] = 1; - cachelist[11][10] = 1; - cachelist[11][11] = 1; - cachelist[11][12] = 1; - cachelist[11][13] = 1; - cachelist[11][14] = 1; - cachelist[12][10] = 1; - cachelist[12][11] = 1; - cachelist[12][12] = 1; - cachelist[12][13] = 1; - cachelist[12][14] = 1; - cachelist[13][10] = 1; - cachelist[13][11] = 1; - cachelist[13][12] = 1; - cachelist[13][13] = 1; - cachelist[13][14] = 1; - cachelist[14][10] = 1; - cachelist[14][11] = 1; - cachelist[14][12] = 1; - cachelist[14][13] = 1; - cachelist[14][14] = 1; - /* */ - cachelist[22][22] = 1; - cachelist[22][23] = 1; - cachelist[23][22] = 1; - cachelist[23][23] = 1; +void cache_ijkl_uhf(int **cachelist) { + /* */ + cachelist[0][0] = 1; + cachelist[0][1] = 1; + cachelist[0][2] = 1; + cachelist[0][3] = 1; + cachelist[0][4] = 1; + cachelist[1][0] = 1; + cachelist[1][1] = 1; + cachelist[1][2] = 1; + cachelist[1][3] = 1; + cachelist[1][4] = 1; + cachelist[2][0] = 1; + cachelist[2][1] = 1; + cachelist[2][2] = 1; + cachelist[2][3] = 1; + cachelist[2][4] = 1; + cachelist[3][0] = 1; + cachelist[3][1] = 1; + cachelist[3][2] = 1; + cachelist[3][3] = 1; + cachelist[3][4] = 1; + cachelist[4][0] = 1; + cachelist[4][1] = 1; + cachelist[4][2] = 1; + cachelist[4][3] = 1; + cachelist[4][4] = 1; + /* */ + cachelist[10][10] = 1; + cachelist[10][11] = 1; + cachelist[10][12] = 1; + cachelist[10][13] = 1; + cachelist[10][14] = 1; + cachelist[11][10] = 1; + cachelist[11][11] = 1; + cachelist[11][12] = 1; + cachelist[11][13] = 1; + cachelist[11][14] = 1; + cachelist[12][10] = 1; + cachelist[12][11] = 1; + cachelist[12][12] = 1; + cachelist[12][13] = 1; + cachelist[12][14] = 1; + cachelist[13][10] = 1; + cachelist[13][11] = 1; + cachelist[13][12] = 1; + cachelist[13][13] = 1; + cachelist[13][14] = 1; + cachelist[14][10] = 1; + cachelist[14][11] = 1; + cachelist[14][12] = 1; + cachelist[14][13] = 1; + cachelist[14][14] = 1; + /* */ + cachelist[22][22] = 1; + cachelist[22][23] = 1; + cachelist[23][22] = 1; + cachelist[23][23] = 1; } -void CCLambdaWavefunction::cachedone_uhf(int **cachelist) -{ - free_int_matrix(cachelist); -} +void CCLambdaWavefunction::cachedone_uhf(int **cachelist) { free_int_matrix(cachelist); } -void CCLambdaWavefunction::cachedone_rhf(int **cachelist) -{ - free_int_matrix(cachelist); -} +void CCLambdaWavefunction::cachedone_rhf(int **cachelist) { free_int_matrix(cachelist); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_Gai.cc b/psi4/src/psi4/cclambda/cc2_Gai.cc index 745567d8da2..a437be646ea 100644 --- a/psi4/src/psi4/cclambda/cc2_Gai.cc +++ b/psi4/src/psi4/cclambda/cc2_Gai.cc @@ -37,100 +37,100 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void cc2_Gai_build(int L_irr) { - dpdbuf4 tIJAB, tijab, tiJaB, tIjAb, tijAB, tIJab, t2; - dpdfile2 G, GAI, Gai, L1, LIA, Lia; - dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB; + dpdbuf4 tIJAB, tijab, tiJaB, tIjAb, tijAB, tIJab, t2; + dpdfile2 G, GAI, Gai, L1, LIA, Lia; + dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB; - if(params.ref == 0) { - global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); + if (params.ref == 0) { + global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&t2, PSIF_CC_TAMPS, 0, 10, 10, 10, 10, 0, "2 tIAjb - tIBja"); - global_dpd_->contract422(&t2, &L1, &G, 0, 1, 1, 0); - global_dpd_->buf4_close(&t2); - global_dpd_->file2_close(&L1); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->buf4_init(&t2, PSIF_CC_TAMPS, 0, 10, 10, 10, 10, 0, "2 tIAjb - tIBja"); + global_dpd_->contract422(&t2, &L1, &G, 0, 1, 1, 0); + global_dpd_->buf4_close(&t2); + global_dpd_->file2_close(&L1); - global_dpd_->file2_close(&G); + global_dpd_->file2_close(&G); } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "GAI"); - global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 4, 3, "Gai"); - - /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&tIJAB, &LIJAB, &G, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&tIJAB); - global_dpd_->buf4_close(&LIJAB); - - /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->contract442(&tIjAb, &LIjAb, &G, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&tIjAb); - global_dpd_->buf4_close(&LIjAb); - - /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tijab"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); - global_dpd_->contract442(&tijab, &Lijab, &G, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&tijab); - global_dpd_->buf4_close(&Lijab); - - /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->contract442(&tiJaB, &LiJaB, &G, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&tiJaB); - global_dpd_->buf4_close(&LiJaB); - - global_dpd_->file2_close(&G); - global_dpd_->file2_close(&G); + else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "GAI"); + global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 4, 3, "Gai"); + + /* T2(MJ,AB) * L2(IJ,AB) --> G(M,I) */ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&tIJAB, &LIJAB, &G, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&tIJAB); + global_dpd_->buf4_close(&LIJAB); + + /* T2(Mj,Ab) * L2(Ij,Ab) --> G(M,I) */ + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->contract442(&tIjAb, &LIjAb, &G, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&tIjAb); + global_dpd_->buf4_close(&LIjAb); + + /* T2(mj,ab) * L2(ij,ab) --> G(m,i) */ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 0, 7, 2, 7, 0, "tijab"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); + global_dpd_->contract442(&tijab, &Lijab, &G, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&tijab); + global_dpd_->buf4_close(&Lijab); + + /* T2(mJ,aB) * L2(iJ,aB) --> G(m,i) */ + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->contract442(&tiJaB, &LiJaB, &G, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&tiJaB); + global_dpd_->buf4_close(&LiJaB); + + global_dpd_->file2_close(&G); + global_dpd_->file2_close(&G); } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&GAI, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); - global_dpd_->file2_init(&Gai, PSIF_CC_TMP0, L_irr, 3, 2, "CC2 Gai"); - - /** AA **/ - global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 20, 20, 20, 20, 0, "tIAJB"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->contract422(&tIJAB, &LIA, &GAI, 0, 1, 1, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->buf4_close(&tIJAB); - - global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 20, 30, 20, 30, 0, "tIAjb"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->contract422(&tIjAb, &Lia, &GAI, 0, 1, 1, 1); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&tIjAb); - - /** BB **/ - global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 30, 30, 30, 30, 0, "tiajb"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->contract422(&tijab, &Lia, &Gai, 0, 1, 1, 0); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&tijab); - - global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 30, 20, 30, 20, 0, "tiaJB"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->contract422(&tiJaB, &LIA, &Gai, 0, 1, 1, 1); - global_dpd_->file2_close(&LIA); - global_dpd_->buf4_close(&tiJaB); - - global_dpd_->file2_close(&Gai); - global_dpd_->file2_close(&GAI); + else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&GAI, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); + global_dpd_->file2_init(&Gai, PSIF_CC_TMP0, L_irr, 3, 2, "CC2 Gai"); + + /** AA **/ + global_dpd_->buf4_init(&tIJAB, PSIF_CC_TAMPS, 0, 20, 20, 20, 20, 0, "tIAJB"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->contract422(&tIJAB, &LIA, &GAI, 0, 1, 1, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->buf4_close(&tIJAB); + + global_dpd_->buf4_init(&tIjAb, PSIF_CC_TAMPS, 0, 20, 30, 20, 30, 0, "tIAjb"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->contract422(&tIjAb, &Lia, &GAI, 0, 1, 1, 1); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&tIjAb); + + /** BB **/ + global_dpd_->buf4_init(&tijab, PSIF_CC_TAMPS, 0, 30, 30, 30, 30, 0, "tiajb"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->contract422(&tijab, &Lia, &Gai, 0, 1, 1, 0); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&tijab); + + global_dpd_->buf4_init(&tiJaB, PSIF_CC_TAMPS, 0, 30, 20, 30, 20, 0, "tiaJB"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->contract422(&tiJaB, &LIA, &Gai, 0, 1, 1, 1); + global_dpd_->file2_close(&LIA); + global_dpd_->buf4_close(&tiJaB); + + global_dpd_->file2_close(&Gai); + global_dpd_->file2_close(&GAI); } - return; + return; } - - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_L1.cc b/psi4/src/psi4/cclambda/cc2_L1.cc index 1824c20a1ab..1f2f008accd 100644 --- a/psi4/src/psi4/cclambda/cc2_L1.cc +++ b/psi4/src/psi4/cclambda/cc2_L1.cc @@ -39,452 +39,434 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void local_filter_T1(dpdfile2 *T1); void cc2_L1_build(struct L_Params L_params) { - - int GW, GL1, GL2, Gab, Gij, Gei, Gi, Ga, Gm; - int a, A, i, I, ab, nlinks, nrows, ncols; - dpdfile2 newLIA, newLia, LIA, Lia; - dpdfile2 dIA, dia, Fme, FME; - dpdfile2 Fae, FAE, Fmi, FMI; - dpdfile2 GMI, Gmi, Gae, XIA, Xia; - dpdfile2 GAE, G, GAI, Gai; - dpdbuf4 WMBEJ, Wmbej, WMbEj, WmBeJ; - dpdbuf4 WMBIJ, Wmbij, WMbIj, WmBiJ; - dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB, L2; - dpdbuf4 WMNIE, Wmnie, WMnIe, WmNiE; - dpdbuf4 WAMEF, Wamef, WAmEf, WaMeF, W; - dpdbuf4 Z, D, E; - dpdfile2 XLD; - int L_irr; - L_irr = L_params.irrep; - - /* ground state inhomogeneous term is Fme */ - if (L_params.ground) { - if(params.ref == 0) { - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&FME); - } - else if(params.ref == 1) { - global_dpd_->file2_init(&Fme,PSIF_CC_OEI, 0, 0, 1, "Fme"); - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); - } - else if(params.ref == 2) { - global_dpd_->file2_init(&Fme,PSIF_CC_OEI, 0, 2, 3, "Fme"); - global_dpd_->file2_init(&FME,PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); + int GW, GL1, GL2, Gab, Gij, Gei, Gi, Ga, Gm; + int a, A, i, I, ab, nlinks, nrows, ncols; + dpdfile2 newLIA, newLia, LIA, Lia; + dpdfile2 dIA, dia, Fme, FME; + dpdfile2 Fae, FAE, Fmi, FMI; + dpdfile2 GMI, Gmi, Gae, XIA, Xia; + dpdfile2 GAE, G, GAI, Gai; + dpdbuf4 WMBEJ, Wmbej, WMbEj, WmBeJ; + dpdbuf4 WMBIJ, Wmbij, WMbIj, WmBiJ; + dpdbuf4 LIJAB, Lijab, LIjAb, LiJaB, L2; + dpdbuf4 WMNIE, Wmnie, WMnIe, WmNiE; + dpdbuf4 WAMEF, Wamef, WAmEf, WaMeF, W; + dpdbuf4 Z, D, E; + dpdfile2 XLD; + int L_irr; + L_irr = L_params.irrep; + + /* ground state inhomogeneous term is Fme */ + if (L_params.ground) { + if (params.ref == 0) { + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&FME); + } else if (params.ref == 1) { + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + } else if (params.ref == 2) { + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 2, 3, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_copy(&Fme, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_copy(&FME, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + } } - } - /* excited state - no inhomogenous term, first term is -energy*L*/ - else if (!params.zeta) { - if (params.ref == 0 || params.ref == 1) { - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_axpy(&LIA, &newLIA, -1.0 * L_params.cceom_energy, 0); - global_dpd_->file2_axpy(&Lia, &newLia, -1.0 * L_params.cceom_energy, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&newLia); + /* excited state - no inhomogenous term, first term is -energy*L*/ + else if (!params.zeta) { + if (params.ref == 0 || params.ref == 1) { + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_axpy(&LIA, &newLIA, -1.0 * L_params.cceom_energy, 0); + global_dpd_->file2_axpy(&Lia, &newLia, -1.0 * L_params.cceom_energy, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&newLia); + } else if (params.ref == 2) { + /* do nothing - TDC did not change to increments for the UHF case */ + } } - else if (params.ref == 2) { - /* do nothing - TDC did not change to increments for the UHF case */ - } - } - - if(params.ref == 0) { - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - /* L1 RHS += Lie*Fea */ - global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->contract222(&LIA,&FAE,&newLIA, 0, 1, 1, 1); - global_dpd_->file2_close(&FAE); - - /* L1 RHS += -Lma*Fim */ - global_dpd_->file2_init(&FMI,PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->contract222(&FMI,&LIA,&newLIA, 0, 1, -1, 1); - global_dpd_->file2_close(&FMI); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - - /* L1 RHS += Lie*Fea */ - global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->file2_init(&Fae, PSIF_CC_OEI, 0, 3, 3, "Fae"); - global_dpd_->contract222(&Lia,&Fae,&newLia, 0, 1, 1, 1); - global_dpd_->contract222(&LIA,&FAE,&newLIA, 0, 1, 1, 1); - global_dpd_->file2_close(&Fae); - global_dpd_->file2_close(&FAE); - - /* L1 RHS += -Lma*Fim */ - global_dpd_->file2_init(&FMI,PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->file2_init(&Fmi,PSIF_CC_OEI, 0, 2, 2, "Fmi"); - global_dpd_->contract222(&Fmi,&Lia,&newLia, 0, 1, -1, 1); - global_dpd_->contract222(&FMI,&LIA,&newLIA, 0, 1, -1, 1); - global_dpd_->file2_close(&Fmi); - global_dpd_->file2_close(&FMI); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); - } - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - /* L1 RHS += Lme*Wieam */ - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->contract422(&W, &LIA, &newLIA, 0, 0, 1.0, 1.0); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - } - else if(params.ref == 2) { /** UHF **/ + if (params.ref == 0) { + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + + /* L1 RHS += Lie*Fea */ + global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->contract222(&LIA, &FAE, &newLIA, 0, 1, 1, 1); + global_dpd_->file2_close(&FAE); + + /* L1 RHS += -Lma*Fim */ + global_dpd_->file2_init(&FMI, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->contract222(&FMI, &LIA, &newLIA, 0, 1, -1, 1); + global_dpd_->file2_close(&FMI); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + + /* L1 RHS += Lie*Fea */ + global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->file2_init(&Fae, PSIF_CC_OEI, 0, 3, 3, "Fae"); + global_dpd_->contract222(&Lia, &Fae, &newLia, 0, 1, 1, 1); + global_dpd_->contract222(&LIA, &FAE, &newLIA, 0, 1, 1, 1); + global_dpd_->file2_close(&Fae); + global_dpd_->file2_close(&FAE); + + /* L1 RHS += -Lma*Fim */ + global_dpd_->file2_init(&FMI, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->file2_init(&Fmi, PSIF_CC_OEI, 0, 2, 2, "Fmi"); + global_dpd_->contract222(&Fmi, &Lia, &newLia, 0, 1, -1, 1); + global_dpd_->contract222(&FMI, &LIA, &newLIA, 0, 1, -1, 1); + global_dpd_->file2_close(&Fmi); + global_dpd_->file2_close(&FMI); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); + } - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + if (params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&WMBEJ, PSIF_CC2_HET1, 0, 20, 21, 20, 21, 0, "CC2 WMBEJ (ME,BJ)"); - global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 1, 0, 1, 1); - global_dpd_->buf4_close(&WMBEJ); + /* L1 RHS += Lme*Wieam */ + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->contract422(&W, &LIA, &newLIA, 0, 0, 1.0, 1.0); + global_dpd_->buf4_close(&W); - global_dpd_->buf4_init(&Wmbej, PSIF_CC2_HET1, 0, 30, 31, 30, 31, 0, "CC2 Wmbej (me,bj)"); - global_dpd_->contract422(&Wmbej, &Lia, &newLia, 1, 0, 1, 1); - global_dpd_->buf4_close(&Wmbej); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + } else if (params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&WMbEj, PSIF_CC2_HET1, 0, 20, 31, 20, 31, 0, "CC2 WMbEj (ME,bj)"); - global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 1, 0, -1, 1); - global_dpd_->buf4_close(&WMbEj); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->buf4_init(&WmBeJ, PSIF_CC2_HET1, 0, 30, 21, 30, 21, 0, "CC2 WmBeJ (me,BJ)"); - global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 1, 0, -1, 1); - global_dpd_->buf4_close(&WmBeJ); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); + global_dpd_->buf4_init(&WMBEJ, PSIF_CC2_HET1, 0, 20, 21, 20, 21, 0, "CC2 WMBEJ (ME,BJ)"); + global_dpd_->contract422(&WMBEJ, &LIA, &newLIA, 1, 0, 1, 1); + global_dpd_->buf4_close(&WMBEJ); - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); + global_dpd_->buf4_init(&Wmbej, PSIF_CC2_HET1, 0, 30, 31, 30, 31, 0, "CC2 Wmbej (me,bj)"); + global_dpd_->contract422(&Wmbej, &Lia, &newLia, 1, 0, 1, 1); + global_dpd_->buf4_close(&Wmbej); - } + global_dpd_->buf4_init(&WMbEj, PSIF_CC2_HET1, 0, 20, 31, 20, 31, 0, "CC2 WMbEj (ME,bj)"); + global_dpd_->contract422(&WMbEj, &Lia, &newLIA, 1, 0, -1, 1); + global_dpd_->buf4_close(&WMbEj); - if(params.ref == 0) { /** RHF **/ + global_dpd_->buf4_init(&WmBeJ, PSIF_CC2_HET1, 0, 30, 21, 30, 21, 0, "CC2 WmBeJ (me,BJ)"); + global_dpd_->contract422(&WmBeJ, &LIA, &newLia, 1, 0, -1, 1); + global_dpd_->buf4_close(&WmBeJ); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - global_dpd_->buf4_sort(&L2, PSIF_CC_TMP0, rspq, 5, 0, "Z (2 AbIj - AbjI)"); - global_dpd_->buf4_close(&L2); + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); + } - /* L1 RHS += 1/2 Limef*Wefam */ - /* Out-of-core contract442 */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + global_dpd_->buf4_sort(&L2, PSIF_CC_TMP0, rspq, 5, 0, "Z (2 AbIj - AbjI)"); + global_dpd_->buf4_close(&L2); + + /* L1 RHS += 1/2 Limef*Wefam */ + /* Out-of-core contract442 */ + + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 5, 11, 5, 11, 0, "CC2 WAbEi"); + global_dpd_->buf4_init(&L2, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "Z (2 AbIj - AbjI)"); + + /* dpd_contract442(&L2, &W, &newLIA, 0, 0, 1, 1); */ + + GW = W.file.my_irrep; + GL2 = L2.file.my_irrep; + GL1 = newLIA.my_irrep; + + global_dpd_->file2_mat_init(&newLIA); + global_dpd_->file2_mat_rd(&newLIA); + + for (Gab = 0; Gab < moinfo.nirreps; Gab++) { + global_dpd_->buf4_mat_irrep_row_init(&L2, Gab); + global_dpd_->buf4_mat_irrep_row_init(&W, Gab); + + for (ab = 0; ab < L2.params->rowtot[Gab]; ab++) { + global_dpd_->buf4_mat_irrep_row_zero(&L2, Gab, ab); + global_dpd_->buf4_mat_irrep_row_rd(&L2, Gab, ab); + + global_dpd_->buf4_mat_irrep_row_zero(&W, Gab, ab); + global_dpd_->buf4_mat_irrep_row_rd(&W, Gab, ab); + + for (Gi = 0; Gi < moinfo.nirreps; Gi++) { + Ga = Gi ^ GL1; + Gm = GL2 ^ Gab ^ Gi; + + nrows = L2.params->rpi[Gi]; + ncols = W.params->rpi[Ga]; + nlinks = L2.params->spi[Gm]; + + if (nrows && ncols && nlinks) { + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(L2.matrix[Gab][0][L2.col_offset[Gab][Gi]]), + nlinks, &(W.matrix[Gab][0][W.col_offset[Gab][Ga]]), nlinks, 1.0, + &(newLIA.matrix[Gi][0][0]), ncols); + } + } + } + global_dpd_->buf4_mat_irrep_row_close(&L2, Gab); + global_dpd_->buf4_mat_irrep_row_close(&W, Gab); + } + global_dpd_->file2_mat_wrt(&newLIA); + global_dpd_->file2_mat_close(&newLIA); + + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 21, 7, 21, 7, 0, "CC2 WABEI (EI,A>B)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 26, 28, 26, 28, 0, "CC2 WAbEi (Ei,Ab)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 31, 17, 31, 17, 0, "CC2 Wabei (ei,a>b)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 25, 29, 25, 29, 0, "CC2 WaBeI (eI,aB)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); + global_dpd_->buf4_close(&W); + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); + } - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 5, 11, 5, 11, 0, "CC2 WAbEi"); - global_dpd_->buf4_init(&L2, PSIF_CC_TMP0, L_irr, 5, 0, 5, 0, 0, "Z (2 AbIj - AbjI)"); + if (params.ref == 0) { /** RHF **/ + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + + /* L1 RHS += -1/2 Lmnae*Wiemn */ + global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 10, 0, 10, 0, 0, "CC2 WMbIj"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); + global_dpd_->contract442(&W, &LIjAb, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + + /* L1 RHS += -1/2 Lmnae*Wiemn */ + global_dpd_->buf4_init(&WMBIJ, PSIF_CC2_HET1, 0, 20, 2, 20, 2, 0, "CC2 WMBIJ (MB,I>J)"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&WMBIJ); + + global_dpd_->buf4_init(&WMbIj, PSIF_CC2_HET1, 0, 24, 22, 24, 22, 0, "CC2 WMbIj (Mb,Ij)"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&WMbIj); + + global_dpd_->buf4_init(&Wmbij, PSIF_CC2_HET1, 0, 30, 12, 30, 12, 0, "CC2 Wmbij (mb,i>j)"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1, 1); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&Wmbij); + + global_dpd_->buf4_init(&WmBiJ, PSIF_CC2_HET1, 0, 27, 23, 27, 23, 0, "CC2 WmBiJ (mB,iJ)"); + global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1, 1); + global_dpd_->buf4_close(&LiJaB); + global_dpd_->buf4_close(&WmBiJ); + + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); + } - /* dpd_contract442(&L2, &W, &newLIA, 0, 0, 1, 1); */ + if (params.ref == 0) { /** RHF **/ - GW = W.file.my_irrep; - GL2 = L2.file.my_irrep; - GL1 = newLIA.my_irrep; + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&newLIA); - global_dpd_->file2_mat_rd(&newLIA); + /* L1 RHS += Gbj* */ + global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 10, 10, 10, 10, 0, "D 2 - (ia,jb)"); + global_dpd_->contract422(&D, &G, &newLIA, 1, 0, 1, 1); + global_dpd_->buf4_close(&D); + global_dpd_->file2_close(&G); - for(Gab=0; Gab < moinfo.nirreps; Gab++) { + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->buf4_mat_irrep_row_init(&L2, Gab); - global_dpd_->buf4_mat_irrep_row_init(&W, Gab); + global_dpd_->file2_init(&GAI, PSIF_CC_LAMBDA, L_irr, 1, 0, "CC2 GAI"); + global_dpd_->file2_init(&Gai, PSIF_CC_LAMBDA, L_irr, 3, 2, "CC2 Gai"); - for(ab=0; ab < L2.params->rowtot[Gab]; ab++) { + /* L1 RHS += Gbj* */ + /** AA **/ + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 20, 20, 20, 20, 0, "D (IA,JB)"); + global_dpd_->contract422(&D, &GAI, &newLIA, 1, 0, 1, 1); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_mat_irrep_row_zero(&L2, Gab, ab); - global_dpd_->buf4_mat_irrep_row_rd(&L2, Gab, ab); + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 20, 30, 20, 30, 0, "D (IA,jb)"); + global_dpd_->contract422(&D, &Gai, &newLIA, 1, 0, 1, 1); + global_dpd_->buf4_close(&D); - global_dpd_->buf4_mat_irrep_row_zero(&W, Gab, ab); - global_dpd_->buf4_mat_irrep_row_rd(&W, Gab, ab); + /** BB**/ + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 30, 30, 30, 30, 0, "D (ia,jb)"); + global_dpd_->contract422(&D, &Gai, &newLia, 1, 0, 1, 1); + global_dpd_->buf4_close(&D); - for(Gi=0; Gi < moinfo.nirreps; Gi++) { - Ga = Gi^GL1; - Gm = GL2^Gab^Gi; + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 30, 20, 30, 20, 0, "D (ia,JB)"); + global_dpd_->contract422(&D, &GAI, &newLia, 1, 0, 1, 1); + global_dpd_->buf4_close(&D); - nrows = L2.params->rpi[Gi]; - ncols = W.params->rpi[Ga]; - nlinks = L2.params->spi[Gm]; + global_dpd_->file2_close(&Gai); + global_dpd_->file2_close(&GAI); - if(nrows && ncols && nlinks) { - C_DGEMM('n','t',nrows,ncols,nlinks,1.0, - &(L2.matrix[Gab][0][L2.col_offset[Gab][Gi]]),nlinks, - &(W.matrix[Gab][0][W.col_offset[Gab][Ga]]),nlinks,1.0, - &(newLIA.matrix[Gi][0][0]),ncols); - } - } - } - global_dpd_->buf4_mat_irrep_row_close(&L2, Gab); - global_dpd_->buf4_mat_irrep_row_close(&W, Gab); + global_dpd_->file2_close(&newLIA); + global_dpd_->file2_close(&newLia); } - global_dpd_->file2_mat_wrt(&newLIA); - global_dpd_->file2_mat_close(&newLIA); - - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 21, 7, 21, 7, 0, "CC2 WABEI (EI,A>B)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 26, 28, 26, 28, 0, "CC2 WAbEi (Ei,Ab)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&L2, &W, &newLIA, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 31, 17, 31, 17, 0, "CC2 Wabei (ei,a>b)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 25, 29, 25, 29, 0, "CC2 WaBeI (eI,aB)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&L2, &W, &newLia, 0, 0, 1, 1); - global_dpd_->buf4_close(&W); - global_dpd_->buf4_close(&L2); - - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); - } - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - - /* L1 RHS += -1/2 Lmnae*Wiemn */ - global_dpd_->buf4_init(&W, PSIF_CC2_HET1, 0, 10, 0, 10, 0, 0, "CC2 WMbIj"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "2 LIjAb - LIjBa"); - global_dpd_->contract442(&W, &LIjAb, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - - /* L1 RHS += -1/2 Lmnae*Wiemn */ - global_dpd_->buf4_init(&WMBIJ, PSIF_CC2_HET1, 0, 20, 2, 20, 2, 0, "CC2 WMBIJ (MB,I>J)"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract442(&WMBIJ, &LIJAB, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&WMBIJ); - - global_dpd_->buf4_init(&WMbIj, PSIF_CC2_HET1, 0, 24, 22, 24, 22, 0, "CC2 WMbIj (Mb,Ij)"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->contract442(&WMbIj, &LIjAb, &newLIA, 0, 2, -1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&WMbIj); - - global_dpd_->buf4_init(&Wmbij, PSIF_CC2_HET1, 0, 30, 12, 30, 12, 0, "CC2 Wmbij (mb,i>j)"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract442(&Wmbij, &Lijab, &newLia, 0, 2, -1, 1); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&Wmbij); - - global_dpd_->buf4_init(&WmBiJ, PSIF_CC2_HET1, 0, 27, 23, 27, 23, 0, "CC2 WmBiJ (mB,iJ)"); - global_dpd_->buf4_init(&LiJaB, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->contract442(&WmBiJ, &LiJaB, &newLia, 0, 2, -1, 1); - global_dpd_->buf4_close(&LiJaB); - global_dpd_->buf4_close(&WmBiJ); - - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); - } - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - - /* L1 RHS += Gbj* */ - global_dpd_->file2_init(&G, PSIF_CC_TMP0, L_irr, 1, 0, "CC2 GAI"); - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 10, 10, 10, 10, 0, "D 2 - (ia,jb)"); - global_dpd_->contract422(&D, &G, &newLIA, 1, 0, 1, 1); - global_dpd_->buf4_close(&D); - global_dpd_->file2_close(&G); - - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - - global_dpd_->file2_init(&GAI, PSIF_CC_LAMBDA, L_irr, 1, 0, "CC2 GAI"); - global_dpd_->file2_init(&Gai, PSIF_CC_LAMBDA, L_irr, 3, 2, "CC2 Gai"); - - /* L1 RHS += Gbj* */ - /** AA **/ - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 20, 20, 20, 20, 0, "D (IA,JB)"); - global_dpd_->contract422(&D, &GAI, &newLIA, 1, 0, 1, 1); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 20, 30, 20, 30, 0, "D (IA,jb)"); - global_dpd_->contract422(&D, &Gai, &newLIA, 1, 0, 1, 1); - global_dpd_->buf4_close(&D); - - /** BB**/ - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 30, 30, 30, 30, 0, "D (ia,jb)"); - global_dpd_->contract422(&D, &Gai, &newLia, 1, 0, 1, 1); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 30, 20, 30, 20, 0, "D (ia,JB)"); - global_dpd_->contract422(&D, &GAI, &newLia, 1, 0, 1, 1); - global_dpd_->buf4_close(&D); - - global_dpd_->file2_close(&Gai); - global_dpd_->file2_close(&GAI); - - global_dpd_->file2_close(&newLIA); - global_dpd_->file2_close(&newLia); - } - - if(params.ref == 0) { /** RHF **/ - /* newLia * Dia */ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - if(params.local && local.filter_singles) local_filter_T1(&newLIA); - else { - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); + + if (params.ref == 0) { /** RHF **/ + /* newLia * Dia */ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + if (params.local && local.filter_singles) + local_filter_T1(&newLIA); + else { + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + } + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); + /*dpd_file2_print(&newLIA,outfile);*/ + global_dpd_->file2_close(&LIA); + + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New Lia"); /* spin-adaptation for RHF */ + global_dpd_->file2_close(&newLIA); + } else if (params.ref == 1) { /** ROHF **/ + + /* newLia * Dia */ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); + global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_copy(&newLia, PSIF_CC_LAMBDA, "New Lia Increment"); + global_dpd_->file2_close(&newLia); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); + global_dpd_->file2_dirprd(&dia, &newLia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&newLia); + + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_copy(&Lia, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); + global_dpd_->file2_axpy(&Lia, &newLia, 1, 0); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&newLia); + } else if (params.ref == 2) { /** UHF **/ + + /* newLia * Dia */ + global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &newLIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&newLIA); + + global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); + global_dpd_->file2_dirprd(&dia, &newLia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&newLia); } - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); - /*dpd_file2_print(&newLIA,outfile);*/ - global_dpd_->file2_close(&LIA); - - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New Lia"); /* spin-adaptation for RHF */ - global_dpd_->file2_close(&newLIA); - } - else if(params.ref == 1) { /** ROHF **/ - - /* newLia * Dia */ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_copy(&newLIA, PSIF_CC_LAMBDA, "New LIA Increment"); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&LIA, PSIF_CC_LAMBDA, "New LIA"); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA Increment"); - global_dpd_->file2_axpy(&LIA, &newLIA, 1, 0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_copy(&newLia, PSIF_CC_LAMBDA, "New Lia Increment"); - global_dpd_->file2_close(&newLia); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); - global_dpd_->file2_dirprd(&dia, &newLia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&newLia); - - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_copy(&Lia, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia Increment"); - global_dpd_->file2_axpy(&Lia, &newLia, 1, 0); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&newLia); - } - else if(params.ref == 2) { /** UHF **/ - - /* newLia * Dia */ - global_dpd_->file2_init(&newLIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &newLIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&newLIA); - - global_dpd_->file2_init(&newLia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); - global_dpd_->file2_dirprd(&dia, &newLia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&newLia); - } #ifdef EOM_DEBUG - check_sum("after L1 build",L_irr); + check_sum("after L1 build", L_irr); #endif - return; + return; } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_L2.cc b/psi4/src/psi4/cclambda/cc2_L2.cc index bf78e5b2737..2df175dd5d1 100644 --- a/psi4/src/psi4/cclambda/cc2_L2.cc +++ b/psi4/src/psi4/cclambda/cc2_L2.cc @@ -38,7 +38,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void DL2(struct L_Params L_params); void cc2_faeL2(int L_irr); @@ -53,57 +54,57 @@ void dijabL2(int L_irr); void BL2_AO(int L_irr); void CCLambdaWavefunction::cc2_L2_build(struct L_Params L_params) { - int L_irr; - L_irr = L_params.irrep; + int L_irr; + L_irr = L_params.irrep; - DL2(L_params); - if(params.print & 2) status(" -> L2", "outfile"); + DL2(L_params); + if (params.print & 2) status(" -> L2", "outfile"); #ifdef EOM_DEBUG - check_sum("DL2", L_irr); + check_sum("DL2", L_irr); #endif - cc2_faeL2(L_irr); + cc2_faeL2(L_irr); #ifdef EOM_DEBUG - check_sum("FaeL2", L_irr); + check_sum("FaeL2", L_irr); #endif - cc2_fmiL2(L_irr); + cc2_fmiL2(L_irr); #ifdef EOM_DEBUG - check_sum("FmiL2", L_irr); + check_sum("FmiL2", L_irr); #endif - if(params.print & 2) status("F -> L2", "outfile"); + if (params.print & 2) status("F -> L2", "outfile"); - WijmbL2(L_irr); + WijmbL2(L_irr); #ifdef EOM_DEBUG - check_sum("WmnieL2", L_irr); + check_sum("WmnieL2", L_irr); #endif - if(params.print & 2) status("Wmnie -> L2", "outfile"); + if (params.print & 2) status("Wmnie -> L2", "outfile"); - WejabL2(L_irr); + WejabL2(L_irr); #ifdef EOM_DEBUG - check_sum("WejabL2", L_irr); + check_sum("WejabL2", L_irr); #endif - if(params.print & 2) status("Wamef -> L2", "outfile"); + if (params.print & 2) status("Wamef -> L2", "outfile"); - L1FL2(L_irr); + L1FL2(L_irr); #ifdef EOM_DEBUG - check_sum("L1FL2", L_irr); + check_sum("L1FL2", L_irr); #endif - if(params.print & 2) status("L1*F -> L2", "outfile"); + if (params.print & 2) status("L1*F -> L2", "outfile"); - dijabL2(L_irr); + dijabL2(L_irr); #ifdef EOM_DEBUG - check_sum("after D2s", L_irr); + check_sum("after D2s", L_irr); #endif - if(params.print & 2) status("L2 amplitudes", "outfile"); + if (params.print & 2) status("L2 amplitudes", "outfile"); } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_faeL2.cc b/psi4/src/psi4/cclambda/cc2_faeL2.cc index 0242b001fb3..608295cf740 100644 --- a/psi4/src/psi4/cclambda/cc2_faeL2.cc +++ b/psi4/src/psi4/cclambda/cc2_faeL2.cc @@ -37,174 +37,167 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /** The ROHF version of this contraction can be done with fewer contractions. **/ -void cc2_faeL2(int L_irr) -{ - int h, e; - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLIJAB, newLijab, newLIjAb; - dpdfile2 fab, fAB, F; - dpdbuf4 X, X1, X2; - dpdbuf4 L2, newL2; - - /* RHS += P(ab)*Lijae*Feb */ - - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->contract424(&L2, &F, &X, 3, 0, 0, 1, 0); - global_dpd_->file2_close(&F); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&X, &newL2, 1); - global_dpd_->buf4_close(&newL2); - - global_dpd_->buf4_close(&X); - - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&LIJAB, &fAB, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&fAB, &LIJAB, &X2, 0, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); - global_dpd_->contract424(&Lijab, &fab, &X1, 3, 0, 0, 1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); - global_dpd_->contract244(&fab, &Lijab, &X2, 0, 2, 1, 1.0, 0.0); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &fab, &newLIjAb, 3, 0, 0, 1.0, 1.0); - global_dpd_->contract244(&fAB, &LIjAb, &newLIjAb, 0, 2, 1, 1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&fab); - global_dpd_->file2_close(&fAB); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab"); - global_dpd_->file2_copy(&fAB, PSIF_CC_OEI, "fAB diag"); - global_dpd_->file2_copy(&fab, PSIF_CC_OEI, "fab diag"); - global_dpd_->file2_close(&fAB); - global_dpd_->file2_close(&fab); - - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB diag"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab diag"); - - global_dpd_->file2_mat_init(&fAB); - global_dpd_->file2_mat_rd(&fAB); - global_dpd_->file2_mat_init(&fab); - global_dpd_->file2_mat_rd(&fab); - - for(h=0; h < moinfo.nirreps; h++) { - - for(e=0; e < fAB.params->coltot[h]; e++) - fAB.matrix[h][e][e] = 0; - - for(e=0; e < fab.params->coltot[h]; e++) - fab.matrix[h][e][e] = 0; - +void cc2_faeL2(int L_irr) { + int h, e; + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLIJAB, newLijab, newLIjAb; + dpdfile2 fab, fAB, F; + dpdbuf4 X, X1, X2; + dpdbuf4 L2, newL2; + + /* RHS += P(ab)*Lijae*Feb */ + + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->contract424(&L2, &F, &X, 3, 0, 0, 1, 0); + global_dpd_->file2_close(&F); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&X, &newL2, 1); + global_dpd_->buf4_close(&newL2); + + global_dpd_->buf4_close(&X); + + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&LIJAB, &fAB, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&fAB, &LIJAB, &X2, 0, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 1"); + global_dpd_->contract424(&Lijab, &fab, &X1, 3, 0, 0, 1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(2,5) 2"); + global_dpd_->contract244(&fab, &Lijab, &X2, 0, 2, 1, 1.0, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &fab, &newLIjAb, 3, 0, 0, 1.0, 1.0); + global_dpd_->contract244(&fAB, &LIjAb, &newLIjAb, 0, 2, 1, 1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&fab); + global_dpd_->file2_close(&fAB); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab"); + global_dpd_->file2_copy(&fAB, PSIF_CC_OEI, "fAB diag"); + global_dpd_->file2_copy(&fab, PSIF_CC_OEI, "fab diag"); + global_dpd_->file2_close(&fAB); + global_dpd_->file2_close(&fab); + + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB diag"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab diag"); + + global_dpd_->file2_mat_init(&fAB); + global_dpd_->file2_mat_rd(&fAB); + global_dpd_->file2_mat_init(&fab); + global_dpd_->file2_mat_rd(&fab); + + for (h = 0; h < moinfo.nirreps; h++) { + for (e = 0; e < fAB.params->coltot[h]; e++) fAB.matrix[h][e][e] = 0; + + for (e = 0; e < fab.params->coltot[h]; e++) fab.matrix[h][e][e] = 0; + } + + global_dpd_->file2_mat_wrt(&fAB); + global_dpd_->file2_mat_close(&fAB); + global_dpd_->file2_mat_wrt(&fab); + global_dpd_->file2_mat_close(&fab); + + global_dpd_->file2_close(&fAB); + global_dpd_->file2_close(&fab); + + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB diag"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab diag"); + + /** X(IJ,AB) = L_IJ^AE F_EB **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); + global_dpd_->contract424(&LIJAB, &fAB, &X, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(IJ,AB) --> X'(IJ,BA) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 2, 5, "X'(IJ,BA)"); + global_dpd_->buf4_close(&X); + /** X(IJ,AB) = X(IJ,AB) - X'(IJ,BA) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X'(IJ,BA)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&X1); + /** L(IJ,AB) <-- X(IJ,AB) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X); + global_dpd_->buf4_close(&newLIJAB); + + /** X(ij,ab) = L_ij^ae F_eb **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); + global_dpd_->contract424(&LIJAB, &fab, &X, 3, 0, 0, 1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(ij,ab) --> X'(ij,ba) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 12, 15, "X'(ij,ba)"); + global_dpd_->buf4_close(&X); + /** X(ij,ab) = X(ij,ab) - X'(ij,ba) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X'(ij,ba)"); + global_dpd_->buf4_axpy(&X2, &X1, -1); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&X1); + /** L(ij,ab) <-- X(ij,ab) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X); + global_dpd_->buf4_close(&newLIJAB); + + /** L(Ij,Ab) <-- L(Ij,Ae) F(e,b) - F(E,A) L(Ij,Eb) **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &fab, &newLIjAb, 3, 0, 0, 1, 1); + global_dpd_->contract244(&fAB, &LIjAb, &newLIjAb, 0, 2, 1, 1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&fab); + global_dpd_->file2_close(&fAB); } - - global_dpd_->file2_mat_wrt(&fAB); - global_dpd_->file2_mat_close(&fAB); - global_dpd_->file2_mat_wrt(&fab); - global_dpd_->file2_mat_close(&fab); - - global_dpd_->file2_close(&fAB); - global_dpd_->file2_close(&fab); - - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB diag"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 3, 3, "fab diag"); - - /** X(IJ,AB) = L_IJ^AE F_EB **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "LIJAB"); - global_dpd_->contract424(&LIJAB, &fAB, &X, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(IJ,AB) --> X'(IJ,BA) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 2, 5, "X'(IJ,BA)"); - global_dpd_->buf4_close(&X); - /** X(IJ,AB) = X(IJ,AB) - X'(IJ,BA) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X'(IJ,BA)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&X1); - /** L(IJ,AB) <-- X(IJ,AB) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 2, 5, 2, 5, 0, "X(IJ,AB) A"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X); - global_dpd_->buf4_close(&newLIJAB); - - /** X(ij,ab) = L_ij^ae F_eb **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "Lijab"); - global_dpd_->contract424(&LIJAB, &fab, &X, 3, 0, 0, 1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(ij,ab) --> X'(ij,ba) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, pqsr, 12, 15, "X'(ij,ba)"); - global_dpd_->buf4_close(&X); - /** X(ij,ab) = X(ij,ab) - X'(ij,ba) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X'(ij,ba)"); - global_dpd_->buf4_axpy(&X2, &X1, -1); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&X1); - /** L(ij,ab) <-- X(ij,ab) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 12, 15, 12, 15, 0, "X(ij,ab) A"); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 12, 15, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X); - global_dpd_->buf4_close(&newLIJAB); - - /** L(Ij,Ab) <-- L(Ij,Ae) F(e,b) - F(E,A) L(Ij,Eb) **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &fab, &newLIjAb, 3, 0, 0, 1, 1); - global_dpd_->contract244(&fAB, &LIjAb, &newLIjAb, 0, 2, 1, 1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&fab); - global_dpd_->file2_close(&fAB); - - } - } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_fmiL2.cc b/psi4/src/psi4/cclambda/cc2_fmiL2.cc index 85ada11dbcb..9cf8b80976f 100644 --- a/psi4/src/psi4/cclambda/cc2_fmiL2.cc +++ b/psi4/src/psi4/cclambda/cc2_fmiL2.cc @@ -37,166 +37,162 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /** The RHF/ROHF contractions can be improved here **/ -void cc2_fmiL2(int L_irr) -{ - int h, m; - dpdbuf4 Lijab, LIJAB, LIjAb; - dpdbuf4 newLijab, newLIJAB, newLIjAb; - dpdfile2 fij, fIJ, F; - dpdbuf4 X, X1, X2; - dpdbuf4 L2, newL2; - - /* RHS -= P(ij)*Limab*Fjm */ - if(params.ref == 0) { /** RHF **/ - - global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->contract244(&F, &L2, &X, 1, 0, 0, -1.0, 0); - global_dpd_->file2_close(&F); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); - global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&X, &newL2, 1); - global_dpd_->buf4_close(&newL2); - - global_dpd_->buf4_close(&X); - } - else if(params.ref == 1) { /** RHF/ROHF **/ - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); - - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&LIJAB, &fIJ, &X1, 1, 1, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&fIJ, &LIJAB, &X2, 1, 0, 0, -1.0, 0.0); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); - global_dpd_->contract424(&Lijab, &fij, &X1, 1, 1, 1, -1.0, 0.0); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); - global_dpd_->contract244(&fij, &Lijab, &X2, 1, 0, 0, -1.0, 0.0); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_axpy(&X1, &X2, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); - global_dpd_->buf4_close(&X2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &fij, &newLIjAb, 1, 1, 1, -1.0, 1.0); - global_dpd_->contract244(&fIJ, &LIjAb, &newLIjAb, 1, 0, 0, -1.0, 1.0); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&fij); - global_dpd_->file2_close(&fIJ); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij"); - global_dpd_->file2_copy(&fIJ, PSIF_CC_OEI, "fIJ diag"); - global_dpd_->file2_copy(&fij, PSIF_CC_OEI, "fij diag"); - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fij); - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ diag"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij diag"); - - global_dpd_->file2_mat_init(&fIJ); - global_dpd_->file2_mat_rd(&fIJ); - global_dpd_->file2_mat_init(&fij); - global_dpd_->file2_mat_rd(&fij); - - for(h=0; h < moinfo.nirreps; h++) { - for(m=0; m < fIJ.params->rowtot[h]; m++) - fIJ.matrix[h][m][m] = 0; - - for(m=0; m < fij.params->rowtot[h]; m++) - fij.matrix[h][m][m] = 0; +void cc2_fmiL2(int L_irr) { + int h, m; + dpdbuf4 Lijab, LIJAB, LIjAb; + dpdbuf4 newLijab, newLIJAB, newLIjAb; + dpdfile2 fij, fIJ, F; + dpdbuf4 X, X1, X2; + dpdbuf4 L2, newL2; + + /* RHS -= P(ij)*Limab*Fjm */ + if (params.ref == 0) { /** RHF **/ + + global_dpd_->buf4_init(&X, PSIF_CC_TMP0, L_irr, 0, 5, 0, 5, 0, "X(Ij,Ab)"); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->file2_init(&F, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->contract244(&F, &L2, &X, 1, 0, 0, -1.0, 0); + global_dpd_->file2_close(&F); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_sort_axpy(&X, PSIF_CC_LAMBDA, qpsr, 0, 5, "New LIjAb", 1); + global_dpd_->buf4_init(&newL2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&X, &newL2, 1); + global_dpd_->buf4_close(&newL2); + + global_dpd_->buf4_close(&X); + } else if (params.ref == 1) { /** RHF/ROHF **/ + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); + + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&LIJAB, &fIJ, &X1, 1, 1, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&fIJ, &LIJAB, &X2, 1, 0, 0, -1.0, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X2, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 1"); + global_dpd_->contract424(&Lijab, &fij, &X1, 1, 1, 1, -1.0, 0.0); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(0,7) 2"); + global_dpd_->contract244(&fij, &Lijab, &X2, 1, 0, 0, -1.0, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_axpy(&X1, &X2, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X2, &newLijab, 1.0); + global_dpd_->buf4_close(&X2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &fij, &newLIjAb, 1, 1, 1, -1.0, 1.0); + global_dpd_->contract244(&fIJ, &LIjAb, &newLIjAb, 1, 0, 0, -1.0, 1.0); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&fij); + global_dpd_->file2_close(&fIJ); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij"); + global_dpd_->file2_copy(&fIJ, PSIF_CC_OEI, "fIJ diag"); + global_dpd_->file2_copy(&fij, PSIF_CC_OEI, "fij diag"); + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fij); + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ diag"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij diag"); + + global_dpd_->file2_mat_init(&fIJ); + global_dpd_->file2_mat_rd(&fIJ); + global_dpd_->file2_mat_init(&fij); + global_dpd_->file2_mat_rd(&fij); + + for (h = 0; h < moinfo.nirreps; h++) { + for (m = 0; m < fIJ.params->rowtot[h]; m++) fIJ.matrix[h][m][m] = 0; + + for (m = 0; m < fij.params->rowtot[h]; m++) fij.matrix[h][m][m] = 0; + } + + global_dpd_->file2_mat_wrt(&fIJ); + global_dpd_->file2_mat_close(&fIJ); + global_dpd_->file2_mat_wrt(&fij); + global_dpd_->file2_mat_close(&fij); + + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fij); + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ diag"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij diag"); + + /** X(IJ,AB) = F(I,M) L(MJ,AB) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); + global_dpd_->contract244(&fIJ, &LIJAB, &X, 1, 0, 0, -1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(IJ,AB) --> X'(JI,AB) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 0, 7, "X'(JI,AB)"); + global_dpd_->buf4_close(&X); + + /** X(IJ,AB) = X(IJ,AB) - X'(JI,AB) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X'(JI,AB)"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + /** L(IJ,AB) <--- X(IJ,AB) **/ + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&newLIJAB); + + /** X(ij,ab) = F(i,m) L(mj,ab) **/ + global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); + global_dpd_->contract244(&fij, &LIJAB, &X, 1, 0, 0, -1, 0); + global_dpd_->buf4_close(&LIJAB); + /** X(ij,ab) --> X'(ji,ab) **/ + global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 10, 17, "X'(ji,ab)"); + global_dpd_->buf4_close(&X); + + /** X(ij,ab) = X(ij,ab) - X'(ji,ab) **/ + global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); + global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X'(ji,ab)"); + global_dpd_->buf4_axpy(&X2, &X1, -1.0); + global_dpd_->buf4_close(&X2); + /** L(ij,ab) <--- X(ij,ab) **/ + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); + global_dpd_->buf4_close(&X1); + global_dpd_->buf4_close(&newLIJAB); + + /** L(Ij,Ab) <-- L(Im,Ab) F(j,m) - F(I,M) L(Mj,Ab) **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->contract424(&LIjAb, &fij, &newLIjAb, 1, 1, 1, -1, 1); + global_dpd_->contract244(&fIJ, &LIjAb, &newLIjAb, 1, 0, 0, -1, 1); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->file2_close(&fij); + global_dpd_->file2_close(&fIJ); } - - global_dpd_->file2_mat_wrt(&fIJ); - global_dpd_->file2_mat_close(&fIJ); - global_dpd_->file2_mat_wrt(&fij); - global_dpd_->file2_mat_close(&fij); - - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fij); - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ diag"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 2, 2, "fij diag"); - - /** X(IJ,AB) = F(I,M) L(MJ,AB) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "LIJAB"); - global_dpd_->contract244(&fIJ, &LIJAB, &X, 1, 0, 0, -1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(IJ,AB) --> X'(JI,AB) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 0, 7, "X'(JI,AB)"); - global_dpd_->buf4_close(&X); - - /** X(IJ,AB) = X(IJ,AB) - X'(JI,AB) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X(IJ,AB) B"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 0, 7, 0, 7, 0, "X'(JI,AB)"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - /** L(IJ,AB) <--- X(IJ,AB) **/ - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 0, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&newLIJAB); - - - /** X(ij,ab) = F(i,m) L(mj,ab) **/ - global_dpd_->buf4_init(&X, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "Lijab"); - global_dpd_->contract244(&fij, &LIJAB, &X, 1, 0, 0, -1, 0); - global_dpd_->buf4_close(&LIJAB); - /** X(ij,ab) --> X'(ji,ab) **/ - global_dpd_->buf4_sort(&X, PSIF_CC_TMP1, qprs, 10, 17, "X'(ji,ab)"); - global_dpd_->buf4_close(&X); - - /** X(ij,ab) = X(ij,ab) - X'(ji,ab) **/ - global_dpd_->buf4_init(&X1, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X(ij,ab) B"); - global_dpd_->buf4_init(&X2, PSIF_CC_TMP1, L_irr, 10, 17, 10, 17, 0, "X'(ji,ab)"); - global_dpd_->buf4_axpy(&X2, &X1, -1.0); - global_dpd_->buf4_close(&X2); - /** L(ij,ab) <--- X(ij,ab) **/ - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 10, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_axpy(&X1, &newLIJAB, 1.0); - global_dpd_->buf4_close(&X1); - global_dpd_->buf4_close(&newLIJAB); - - /** L(Ij,Ab) <-- L(Im,Ab) F(j,m) - F(I,M) L(Mj,Ab) **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->contract424(&LIjAb, &fij, &newLIjAb, 1, 1, 1, -1, 1); - global_dpd_->contract244(&fIJ, &LIjAb, &newLIjAb, 1, 0, 0, -1, 1); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->file2_close(&fij); - global_dpd_->file2_close(&fIJ); - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc2_hbar_extra.cc b/psi4/src/psi4/cclambda/cc2_hbar_extra.cc index 067175d1b8d..1488dcb4c93 100644 --- a/psi4/src/psi4/cclambda/cc2_hbar_extra.cc +++ b/psi4/src/psi4/cclambda/cc2_hbar_extra.cc @@ -38,26 +38,28 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void cc2_hbar_extra(void) { - dpdbuf4 W1, W2, W; + dpdbuf4 W1, W2, W; - /* CC2 W(ME,jb) + W(Me,Jb) is constructed in CCEOM for EOM_CC2 */ + /* CC2 W(ME,jb) + W(Me,Jb) is constructed in CCEOM for EOM_CC2 */ - if(params.wfn == "CC2") { - if(params.ref == 0) { /** RHF **/ - /* 2 W(ME,jb) + W(Me,Jb) */ - global_dpd_->buf4_init(&W1, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 WMbeJ (Me,Jb)"); - global_dpd_->buf4_copy(&W1, PSIF_CC2_HET1, "CC2 2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->buf4_close(&W1); - global_dpd_->buf4_init(&W1, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->buf4_init(&W2, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 WMbEj (ME,jb)"); - global_dpd_->buf4_axpy(&W2, &W1, 2); - global_dpd_->buf4_close(&W2); - global_dpd_->buf4_close(&W1); + if (params.wfn == "CC2") { + if (params.ref == 0) { /** RHF **/ + /* 2 W(ME,jb) + W(Me,Jb) */ + global_dpd_->buf4_init(&W1, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 WMbeJ (Me,Jb)"); + global_dpd_->buf4_copy(&W1, PSIF_CC2_HET1, "CC2 2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->buf4_close(&W1); + global_dpd_->buf4_init(&W1, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->buf4_init(&W2, PSIF_CC2_HET1, 0, 10, 10, 10, 10, 0, "CC2 WMbEj (ME,jb)"); + global_dpd_->buf4_axpy(&W2, &W1, 2); + global_dpd_->buf4_close(&W2); + global_dpd_->buf4_close(&W1); + } } - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc3_l3l1.cc b/psi4/src/psi4/cclambda/cc3_l3l1.cc index 8f6b9a38d07..678e5ca3036 100644 --- a/psi4/src/psi4/cclambda/cc3_l3l1.cc +++ b/psi4/src/psi4/cclambda/cc3_l3l1.cc @@ -37,167 +37,167 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void cc3_l3l1(void) -{ - dpdfile2 L1, D1, L1new; - dpdbuf4 Z, W; - int nirreps, Gde, Gg, Gi, Ga; - int de, ig, ag; - int nrows, ncols, nlinks; - - nirreps = moinfo.nirreps; - - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); - global_dpd_->buf4_sort(&Z, PSIF_CC3_MISC, rspq, 5, 10, "CC3 ZIGDE (DE,IG)"); - global_dpd_->buf4_close(&Z); - - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIgDe"); - global_dpd_->buf4_sort(&Z, PSIF_CC3_MISC, rspq, 5, 10, "CC3 ZIgDe (De,Ig)"); - global_dpd_->buf4_close(&Z); - - global_dpd_->file2_init(&L1, PSIF_CC3_MISC, 0, 0, 1, "CC3 LIA"); - global_dpd_->file2_mat_init(&L1); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 5, 5, 7, 7, 0, "CC3 WABEF"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 5, 10, 5, 10, 0, "CC3 ZIGDE (DE,IG)"); - for(Gde=0; Gde < nirreps; Gde++) { - if(Z.params->coltot[Gde] && W.params->coltot[Gde]) { - Z.matrix[Gde] = global_dpd_->dpd_block_matrix(1, Z.params->coltot[Gde]); - W.matrix[Gde] = global_dpd_->dpd_block_matrix(1, W.params->coltot[Gde]); - for(de=0; de < Z.params->rowtot[Gde]; de++) { - global_dpd_->buf4_mat_irrep_rd_block(&W, Gde, de, 1); - global_dpd_->buf4_mat_irrep_rd_block(&Z, Gde, de, 1); - - for(Gg=0; Gg < nirreps; Gg++) { - Ga = Gi = Gg ^ Gde; /* totally symmetric */ - nrows = L1.params->rowtot[Gi]; - ncols = L1.params->coltot[Gi]; - nlinks = Z.params->spi[Gg]; - - ig = Z.col_offset[Gde][Gi]; - ag = W.col_offset[Gde][Ga]; - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(Z.matrix[Gde][0][ig]), nlinks, - &(W.matrix[Gde][0][ag]), nlinks, 1.0, L1.matrix[Gi][0], ncols); - } - } - global_dpd_->free_dpd_block(Z.matrix[Gde], 1, Z.params->coltot[Gde]); - global_dpd_->free_dpd_block(W.matrix[Gde], 1, W.params->coltot[Gde]); +namespace psi { +namespace cclambda { + +void cc3_l3l1(void) { + dpdfile2 L1, D1, L1new; + dpdbuf4 Z, W; + int nirreps, Gde, Gg, Gi, Ga; + int de, ig, ag; + int nrows, ncols, nlinks; + + nirreps = moinfo.nirreps; + + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); + global_dpd_->buf4_sort(&Z, PSIF_CC3_MISC, rspq, 5, 10, "CC3 ZIGDE (DE,IG)"); + global_dpd_->buf4_close(&Z); + + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIgDe"); + global_dpd_->buf4_sort(&Z, PSIF_CC3_MISC, rspq, 5, 10, "CC3 ZIgDe (De,Ig)"); + global_dpd_->buf4_close(&Z); + + global_dpd_->file2_init(&L1, PSIF_CC3_MISC, 0, 0, 1, "CC3 LIA"); + global_dpd_->file2_mat_init(&L1); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 5, 5, 7, 7, 0, "CC3 WABEF"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 5, 10, 5, 10, 0, "CC3 ZIGDE (DE,IG)"); + for (Gde = 0; Gde < nirreps; Gde++) { + if (Z.params->coltot[Gde] && W.params->coltot[Gde]) { + Z.matrix[Gde] = global_dpd_->dpd_block_matrix(1, Z.params->coltot[Gde]); + W.matrix[Gde] = global_dpd_->dpd_block_matrix(1, W.params->coltot[Gde]); + for (de = 0; de < Z.params->rowtot[Gde]; de++) { + global_dpd_->buf4_mat_irrep_rd_block(&W, Gde, de, 1); + global_dpd_->buf4_mat_irrep_rd_block(&Z, Gde, de, 1); + + for (Gg = 0; Gg < nirreps; Gg++) { + Ga = Gi = Gg ^ Gde; /* totally symmetric */ + nrows = L1.params->rowtot[Gi]; + ncols = L1.params->coltot[Gi]; + nlinks = Z.params->spi[Gg]; + + ig = Z.col_offset[Gde][Gi]; + ag = W.col_offset[Gde][Ga]; + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(Z.matrix[Gde][0][ig]), nlinks, + &(W.matrix[Gde][0][ag]), nlinks, 1.0, L1.matrix[Gi][0], ncols); + } + } + global_dpd_->free_dpd_block(Z.matrix[Gde], 1, Z.params->coltot[Gde]); + global_dpd_->free_dpd_block(W.matrix[Gde], 1, W.params->coltot[Gde]); + } } - } - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 5, 5, 5, 5, 0, "CC3 WAbEf"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 5, 10, 5, 10, 0, "CC3 ZIgDe (De,Ig)"); - for(Gde=0; Gde < nirreps; Gde++) { - if(Z.params->coltot[Gde] && W.params->coltot[Gde]) { - Z.matrix[Gde] = global_dpd_->dpd_block_matrix(1, Z.params->coltot[Gde]); - W.matrix[Gde] = global_dpd_->dpd_block_matrix(1, W.params->coltot[Gde]); - for(de=0; de < Z.params->rowtot[Gde]; de++) { - global_dpd_->buf4_mat_irrep_rd_block(&W, Gde, de, 1); - global_dpd_->buf4_mat_irrep_rd_block(&Z, Gde, de, 1); - - for(Gg=0; Gg < nirreps; Gg++) { - Ga = Gi = Gg ^ Gde; /* totally symmetric */ - nrows = L1.params->rowtot[Gi]; - ncols = L1.params->coltot[Gi]; - nlinks = Z.params->spi[Gg]; - - ig = Z.col_offset[Gde][Gi]; - ag = W.col_offset[Gde][Ga]; - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(Z.matrix[Gde][0][ig]), nlinks, - &(W.matrix[Gde][0][ag]), nlinks, 1.0, L1.matrix[Gi][0], ncols); - } - } - global_dpd_->free_dpd_block(Z.matrix[Gde], 1, Z.params->coltot[Gde]); - global_dpd_->free_dpd_block(W.matrix[Gde], 1, W.params->coltot[Gde]); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 5, 5, 5, 5, 0, "CC3 WAbEf"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 5, 10, 5, 10, 0, "CC3 ZIgDe (De,Ig)"); + for (Gde = 0; Gde < nirreps; Gde++) { + if (Z.params->coltot[Gde] && W.params->coltot[Gde]) { + Z.matrix[Gde] = global_dpd_->dpd_block_matrix(1, Z.params->coltot[Gde]); + W.matrix[Gde] = global_dpd_->dpd_block_matrix(1, W.params->coltot[Gde]); + for (de = 0; de < Z.params->rowtot[Gde]; de++) { + global_dpd_->buf4_mat_irrep_rd_block(&W, Gde, de, 1); + global_dpd_->buf4_mat_irrep_rd_block(&Z, Gde, de, 1); + + for (Gg = 0; Gg < nirreps; Gg++) { + Ga = Gi = Gg ^ Gde; /* totally symmetric */ + nrows = L1.params->rowtot[Gi]; + ncols = L1.params->coltot[Gi]; + nlinks = Z.params->spi[Gg]; + + ig = Z.col_offset[Gde][Gi]; + ag = W.col_offset[Gde][Ga]; + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(Z.matrix[Gde][0][ig]), nlinks, + &(W.matrix[Gde][0][ag]), nlinks, 1.0, L1.matrix[Gi][0], ncols); + } + } + global_dpd_->free_dpd_block(Z.matrix[Gde], 1, Z.params->coltot[Gde]); + global_dpd_->free_dpd_block(W.matrix[Gde], 1, W.params->coltot[Gde]); + } } - } - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_mat_wrt(&L1); - global_dpd_->file2_mat_close(&L1); - - /* Wmbej --> L1 */ - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMBEJ (ME,JB)"); - global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMBEJ (MB,JE)"); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbEj (ME,jb)"); - global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMbEj (Mb,jE)"); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbeJ (Me,Jb)"); - global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMbeJ (Mb,Je)"); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMBEJ (MB,JE)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); - global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbEj (Mb,jE)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDmAe (mD,Ae)"); - global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbeJ (Mb,Je)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZdMAe (Md,Ae)"); - global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WMBEJ (MB,EJ)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); - global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WMbEj (Mb,Ej)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImLe"); - global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WmBEj (mB,Ej)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImlE"); - global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - /* Wmnij -> L1 */ - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 0, 0, 2, 2, 0, "CC3 WMNIJ (M>N,I>J)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); - global_dpd_->contract442(&W, &Z, &L1, 0, 2, -0.5, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 0, 0, 0, 0, 0, "CC3 WMnIj (Mn,Ij)"); - global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLmAo"); - global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); - global_dpd_->buf4_close(&Z); - global_dpd_->buf4_close(&W); - - global_dpd_->file2_init(&D1, PSIF_CC_DENOM, 0, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&D1, &L1); - global_dpd_->file2_close(&D1); - global_dpd_->file2_init(&L1new, PSIF_CC_LAMBDA, 0, 0, 1, "New LIA"); - global_dpd_->file2_axpy(&L1, &L1new, 1, 0); - global_dpd_->file2_copy(&L1new, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&L1new); - global_dpd_->file2_close(&L1); - + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_mat_wrt(&L1); + global_dpd_->file2_mat_close(&L1); + + /* Wmbej --> L1 */ + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMBEJ (ME,JB)"); + global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMBEJ (MB,JE)"); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbEj (ME,jb)"); + global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMbEj (Mb,jE)"); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbeJ (Me,Jb)"); + global_dpd_->buf4_sort(&W, PSIF_CC3_HET1, psrq, 10, 10, "CC3 WMbeJ (Mb,Je)"); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMBEJ (MB,JE)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); + global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbEj (Mb,jE)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDmAe (mD,Ae)"); + global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 10, 10, 10, 0, "CC3 WMbeJ (Mb,Je)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZdMAe (Md,Ae)"); + global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WMBEJ (MB,EJ)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); + global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WMbEj (Mb,Ej)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImLe"); + global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 10, 11, 10, 11, 0, "CC3 WmBEj (mB,Ej)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImlE"); + global_dpd_->contract442(&Z, &W, &L1, 0, 2, 1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + /* Wmnij -> L1 */ + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 0, 0, 2, 2, 0, "CC3 WMNIJ (M>N,I>J)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); + global_dpd_->contract442(&W, &Z, &L1, 0, 2, -0.5, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->buf4_init(&W, PSIF_CC3_HET1, 0, 0, 0, 0, 0, 0, "CC3 WMnIj (Mn,Ij)"); + global_dpd_->buf4_init(&Z, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLmAo"); + global_dpd_->contract442(&W, &Z, &L1, 0, 2, -1, 1); + global_dpd_->buf4_close(&Z); + global_dpd_->buf4_close(&W); + + global_dpd_->file2_init(&D1, PSIF_CC_DENOM, 0, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&D1, &L1); + global_dpd_->file2_close(&D1); + global_dpd_->file2_init(&L1new, PSIF_CC_LAMBDA, 0, 0, 1, "New LIA"); + global_dpd_->file2_axpy(&L1, &L1new, 1, 0); + global_dpd_->file2_copy(&L1new, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&L1new); + global_dpd_->file2_close(&L1); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc3_l3l2.cc b/psi4/src/psi4/cclambda/cc3_l3l2.cc index 8b5d5721f6c..c4b1b436b6f 100644 --- a/psi4/src/psi4/cclambda/cc3_l3l2.cc +++ b/psi4/src/psi4/cclambda/cc3_l3l2.cc @@ -40,1515 +40,1510 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void cc3_l3l2_RHF_AAA(void); void cc3_l3l2_RHF_AAB(void); -void L3_AAA(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, - dpdbuf4 *T2, dpdbuf4 *F, dpdbuf4 *E, dpdfile2 *fIJ, dpdfile2 *fAB, - dpdbuf4 *D, dpdbuf4 *LIJAB, dpdfile2 *LIA, dpdfile2 *FME, - int *occpi, int *occ_off, int *virtpi, int *vir_off); - -void L3_AAB(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, - dpdbuf4 *T2AA, dpdbuf4 *T2AB, dpdbuf4 *T2BA, dpdbuf4 *FAA, dpdbuf4 *FAB, dpdbuf4 *FBA, - dpdbuf4 *EAA, dpdbuf4 *EAB, dpdbuf4 *EBA, dpdfile2 *fIJ, dpdfile2 *fij, - dpdfile2 *fAB, dpdfile2 *fab, dpdbuf4 *DAA, dpdbuf4 *DAB, dpdbuf4 *LIJAB, dpdbuf4 *LIjAb, - dpdfile2 *LIA, dpdfile2 *Lia, dpdfile2 *FME, dpdfile2 *Fme, - int *aoccpi, int *aocc_off, int *boccpi, int *bocc_off, - int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off); - -void cc3_l3l2(void) -{ - if(params.ref == 0) { - cc3_l3l2_RHF_AAA(); - cc3_l3l2_RHF_AAB(); - } +void L3_AAA(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, dpdbuf4 *T2, dpdbuf4 *F, dpdbuf4 *E, + dpdfile2 *fIJ, dpdfile2 *fAB, dpdbuf4 *D, dpdbuf4 *LIJAB, dpdfile2 *LIA, dpdfile2 *FME, int *occpi, + int *occ_off, int *virtpi, int *vir_off); + +void L3_AAB(double ***W1, int nirreps, int I, int Gi, int J, int Gj, int K, int Gk, dpdbuf4 *T2AA, dpdbuf4 *T2AB, + dpdbuf4 *T2BA, dpdbuf4 *FAA, dpdbuf4 *FAB, dpdbuf4 *FBA, dpdbuf4 *EAA, dpdbuf4 *EAB, dpdbuf4 *EBA, + dpdfile2 *fIJ, dpdfile2 *fij, dpdfile2 *fAB, dpdfile2 *fab, dpdbuf4 *DAA, dpdbuf4 *DAB, dpdbuf4 *LIJAB, + dpdbuf4 *LIjAb, dpdfile2 *LIA, dpdfile2 *Lia, dpdfile2 *FME, dpdfile2 *Fme, int *aoccpi, int *aocc_off, + int *boccpi, int *bocc_off, int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off); + +void cc3_l3l2(void) { + if (params.ref == 0) { + cc3_l3l2_RHF_AAA(); + cc3_l3l2_RHF_AAB(); + } } -void cc3_l3l2_RHF_AAA(void) -{ - int h, nirreps; - int *occ_off, *occpi; - int *vir_off, *virtpi; - int Gijk; - int Gi, Gj, Gk; - int Ga, Gb, Gc; - int Gab, ab; - int i, j, k, I, J, K; - int a, b, c, A, B, C; - double ***W1, ***W2; - dpdbuf4 L, E, F; - dpdfile2 fIJ, fAB; - dpdfile2 FME, LIA; - dpdbuf4 Dints, LIJAB; - dpdbuf4 WMAFE, WMNIE; - dpdbuf4 ZIGDE, T2; - dpdbuf4 ZDMAE; - dpdbuf4 ZLMAO; - dpdbuf4 ZIMLE; - dpdbuf4 L2new, L2, D2; - int Gjk, jk, Gid, id, Gik, ik; - int Gd, d, DD; - int cd, dc; - int Gm, m, M; - int Gmi, mi, im, mc; - int Gjd, jd; - int Gij, ij, Gmk, mk, am, Gbc, bc; - int ac, mb; - int nrows, ncols, nlinks; - double **Z; - - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; - occ_off = moinfo.occ_off; - virtpi = moinfo.virtpi; - vir_off = moinfo.vir_off; - - global_dpd_->buf4_init(&WMAFE, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); - global_dpd_->buf4_init(&WMNIE, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&WMNIE, h); - global_dpd_->buf4_mat_irrep_rd(&WMNIE, h); - } - - global_dpd_->buf4_init(&L2new, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIJAB"); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2new, h); - - global_dpd_->buf4_init(&ZIGDE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); - global_dpd_->buf4_scm(&ZIGDE, 0.0); /* must be cleared in each iteration */ - - global_dpd_->buf4_init(&ZDMAE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); - global_dpd_->buf4_scm(&ZDMAE, 0.0); - - global_dpd_->buf4_init(&ZLMAO, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&ZLMAO, h); - - global_dpd_->buf4_init(&ZIMLE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&ZIMLE, h); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&T2, h); - global_dpd_->buf4_mat_irrep_rd(&T2, h); - } - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - - global_dpd_->buf4_init(&L, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WAMEF (MA,F>E)"); - global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMNIE (M>N,IE)"); - - global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); - global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); - - W1 = (double ***) malloc(nirreps * sizeof(double **)); - W2 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gi=0; Gi < nirreps; Gi++) { - for(Gj=0; Gj < nirreps; Gj++) { - Gij = Gi ^ Gj; - for(Gk=0; Gk < nirreps; Gk++) { - Gijk = Gi ^ Gj ^ Gk; - - Gjk = Gj ^ Gk; - Gik = Gi ^ Gk; - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gbc = Ga ^ Gijk; /* totally symmetric */ - W2[Ga] = global_dpd_->dpd_block_matrix(virtpi[Ga], F.params->coltot[Gbc]); - } - - for(i=0; i < occpi[Gi]; i++) { - I = occ_off[Gi] + i; - for(j=0; j < occpi[Gj]; j++) { - J = occ_off[Gj] + j; - for(k=0; k < occpi[Gk]; k++) { - K = occ_off[Gk] + k; - - L3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &L, &F, &E, &fIJ, &fAB, - &Dints, &LIJAB, &LIA, &FME, occpi, occ_off, virtpi, vir_off); - - /* L_JKDC <-- +1/2 t_IJKABC W_ABID (IDAB) */ - /* L_JKCD <-- -1/2 t_IJKABC W_ABID (IDAB) */ - jk = L2new.params->rowidx[J][K]; - for(Gd=0; Gd < nirreps; Gd++) { - Gab = Gid = Gi ^ Gd; /* assumes Wieab is totally symmetric */ - Gc = Gab ^ Gijk; /* assumes T3 is totally symmetric */ - - id = WMAFE.row_offset[Gid][I]; - - Z = block_matrix(virtpi[Gc],virtpi[Gd]); - WMAFE.matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], WMAFE.params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(&WMAFE, Gid, id, virtpi[Gd]); - - nrows = virtpi[Gc]; - ncols = virtpi[Gd]; - nlinks = WMAFE.params->coltot[Gid]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nrows, - WMAFE.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); - - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - for(d=0; d < virtpi[Gd]; d++) { - DD = vir_off[Gd] + d; - cd = L2new.params->colidx[C][DD]; - dc = L2new.params->colidx[DD][C]; - L2new.matrix[Gjk][jk][dc] += Z[c][d]; - L2new.matrix[Gjk][jk][cd] += -Z[c][d]; - } - } - global_dpd_->free_dpd_block(WMAFE.matrix[Gid], virtpi[Gd], WMAFE.params->coltot[Gid]); - free_block(Z); - } - - /* t_MIAB <-- +1/2 t_IJKABC W_JKMC */ - /* t_IMAB <-- -1/2 t_IJKABC W_JKMC */ - jk = WMNIE.params->rowidx[J][K]; - for(Gm=0; Gm < nirreps; Gm++) { - Gab = Gmi = Gm ^ Gi; /* assumes totally symmetric */ - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - - mc = WMNIE.col_offset[Gjk][Gm]; - - nrows = F.params->coltot[Gab]; - ncols = occpi[Gm]; - nlinks = virtpi[Gc]; - - Z = global_dpd_->dpd_block_matrix(nrows, ncols); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nlinks, - &(WMNIE.matrix[Gjk][jk][mc]), nlinks, 0.0, Z[0], ncols); - - for(m=0; m < ncols; m++) { - M = occ_off[Gm] + m; - mi = L2new.params->rowidx[M][I]; - im = L2new.params->rowidx[I][M]; - for(ab=0; ab < nrows; ab++) { - L2new.matrix[Gmi][mi][ab] += Z[ab][m]; - L2new.matrix[Gmi][im][ab] -= Z[ab][m]; - } - } - - global_dpd_->free_dpd_block(Z, nrows, ncols); - } - - /* Z_IDAB <-- 1/2 L_IJKABC t_JKDC */ - - jk = T2.params->rowidx[J][K]; - for(Gab=0; Gab < nirreps; Gab++) { - Gid = Gab; /* totally symmetric */ - Gc = Gab ^ Gijk; /* totally symmetric */ - Gd = Gi ^ Gid; - - nrows = virtpi[Gd]; - ncols = ZIGDE.params->coltot[Gid]; - nlinks = virtpi[Gc]; - - dc = T2.col_offset[Gjk][Gd]; - id = ZIGDE.row_offset[Gid][I]; - ZIGDE.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZIGDE, Gid, id, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(T2.matrix[Gjk][jk][dc]), nlinks, - W1[Gab][0], nlinks, 1.0, ZIGDE.matrix[Gid][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZIGDE, Gid, id, nrows); - global_dpd_->free_dpd_block(ZIGDE.matrix[Gid], nrows, ncols); - } - - /* Z_JDAB <-- 1/2 L_IJKABC t_IKDC */ - ik = T2.params->rowidx[I][K]; - for(Gab=0; Gab < nirreps; Gab++) { - Gjd = Gab; /* totally symmetric */ - Gc = Gab ^ Gijk; /* totally symmetric */ - Gd = Gj ^ Gjd; - - nrows = virtpi[Gd]; - ncols = ZDMAE.params->coltot[Gjd]; - nlinks = virtpi[Gc]; - - dc = T2.col_offset[Gik][Gd]; - jd = ZDMAE.row_offset[Gjd][J]; - ZDMAE.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDMAE, Gjd, jd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(T2.matrix[Gik][ik][dc]), nlinks, - W1[Gab][0], nlinks, 1.0, ZDMAE.matrix[Gjd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDMAE, Gjd, jd, nrows); - global_dpd_->free_dpd_block(ZDMAE.matrix[Gjd], nrows, ncols); - } - - /* Z_IJAM <-- -1/2 L_IJKABC t_MKBC */ - /* sort W(AB,C) to W(A,BC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < F.params->coltot[Gab]; ab++) { - A = F.params->colorb[Gab][ab][0]; - B = F.params->colorb[Gab][ab][1]; - Ga = F.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = F.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - ij = ZLMAO.params->rowidx[I][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ - Ga = Gij ^ Gm; /* totally symmetric */ - - nrows = virtpi[Ga]; - ncols = T2.params->coltot[Gmk]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = T2.params->rowidx[M][K]; - am = ZLMAO.col_offset[Gij][Ga] + m; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -0.5, W2[Ga][0], ncols, T2.matrix[Gmk][mk], 1, - 1.0, &(ZLMAO.matrix[Gij][ij][am]), occpi[Gm]); - } - } - - /* Z_IJMB <-- -1/2 L_IJKABC t_MKAC */ - /* sort W(AB,C) to W(B,AC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < F.params->coltot[Gab]; ab++) { - A = F.params->colorb[Gab][ab][0]; - B = F.params->colorb[Gab][ab][1]; - Gb = F.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = F.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - ij = ZIMLE.params->rowidx[I][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gb = Gm ^ Gij; /* totally symmetric */ - Gmk = Gm ^ Gk; - - nrows = virtpi[Gb]; - ncols = T2.params->coltot[Gmk]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = T2.params->rowidx[M][K]; - mb = ZIMLE.col_offset[Gij][Gm] + m * virtpi[Gb]; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -0.5, W2[Gb][0], ncols, T2.matrix[Gmk][mk], 1, - 1.0, &(ZIMLE.matrix[Gij][ij][mb]), 1); - } - - } - - - } /* k */ - } /* j */ - } /* i */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gbc = Ga ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], F.params->coltot[Gbc]); - } - - } /* Gk */ - } /* Gj */ - } /* Gi */ - - free(W1); - free(W2); - - global_dpd_->buf4_close(&E); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&L); - - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fAB); - - global_dpd_->file2_close(&FME); - global_dpd_->file2_close(&LIA); - global_dpd_->buf4_close(&Dints); - global_dpd_->buf4_close(&LIJAB); - - global_dpd_->buf4_close(&WMAFE); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMNIE, h); - global_dpd_->buf4_close(&WMNIE); - - global_dpd_->buf4_close(&ZIGDE); - global_dpd_->buf4_close(&ZDMAE); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZLMAO, h); - global_dpd_->buf4_mat_irrep_close(&ZLMAO, h); - } - global_dpd_->buf4_close(&ZLMAO); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZIMLE, h); - global_dpd_->buf4_mat_irrep_close(&ZIMLE, h); - } - global_dpd_->buf4_close(&ZIMLE); - - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2, h); - global_dpd_->buf4_close(&T2); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&L2new, h); - global_dpd_->buf4_mat_irrep_close(&L2new, h); - } - global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&D2, &L2new); - global_dpd_->buf4_close(&D2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&L2new, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&L2new); - +void cc3_l3l2_RHF_AAA(void) { + int h, nirreps; + int *occ_off, *occpi; + int *vir_off, *virtpi; + int Gijk; + int Gi, Gj, Gk; + int Ga, Gb, Gc; + int Gab, ab; + int i, j, k, I, J, K; + int a, b, c, A, B, C; + double ***W1, ***W2; + dpdbuf4 L, E, F; + dpdfile2 fIJ, fAB; + dpdfile2 FME, LIA; + dpdbuf4 Dints, LIJAB; + dpdbuf4 WMAFE, WMNIE; + dpdbuf4 ZIGDE, T2; + dpdbuf4 ZDMAE; + dpdbuf4 ZLMAO; + dpdbuf4 ZIMLE; + dpdbuf4 L2new, L2, D2; + int Gjk, jk, Gid, id, Gik, ik; + int Gd, d, DD; + int cd, dc; + int Gm, m, M; + int Gmi, mi, im, mc; + int Gjd, jd; + int Gij, ij, Gmk, mk, am, Gbc, bc; + int ac, mb; + int nrows, ncols, nlinks; + double **Z; + + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + occ_off = moinfo.occ_off; + virtpi = moinfo.virtpi; + vir_off = moinfo.vir_off; + + global_dpd_->buf4_init(&WMAFE, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); + global_dpd_->buf4_init(&WMNIE, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&WMNIE, h); + global_dpd_->buf4_mat_irrep_rd(&WMNIE, h); + } + + global_dpd_->buf4_init(&L2new, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIJAB"); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2new, h); + + global_dpd_->buf4_init(&ZIGDE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); + global_dpd_->buf4_scm(&ZIGDE, 0.0); /* must be cleared in each iteration */ + + global_dpd_->buf4_init(&ZDMAE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); + global_dpd_->buf4_scm(&ZDMAE, 0.0); + + global_dpd_->buf4_init(&ZLMAO, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&ZLMAO, h); + + global_dpd_->buf4_init(&ZIMLE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&ZIMLE, h); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&T2, h); + global_dpd_->buf4_mat_irrep_rd(&T2, h); + } + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + + global_dpd_->buf4_init(&L, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WAMEF (MA,F>E)"); + global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMNIE (M>N,IE)"); + + global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + + W1 = (double ***)malloc(nirreps * sizeof(double **)); + W2 = (double ***)malloc(nirreps * sizeof(double **)); + + for (Gi = 0; Gi < nirreps; Gi++) { + for (Gj = 0; Gj < nirreps; Gj++) { + Gij = Gi ^ Gj; + for (Gk = 0; Gk < nirreps; Gk++) { + Gijk = Gi ^ Gj ^ Gk; + + Gjk = Gj ^ Gk; + Gik = Gi ^ Gk; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gbc = Ga ^ Gijk; /* totally symmetric */ + W2[Ga] = global_dpd_->dpd_block_matrix(virtpi[Ga], F.params->coltot[Gbc]); + } + + for (i = 0; i < occpi[Gi]; i++) { + I = occ_off[Gi] + i; + for (j = 0; j < occpi[Gj]; j++) { + J = occ_off[Gj] + j; + for (k = 0; k < occpi[Gk]; k++) { + K = occ_off[Gk] + k; + + L3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &L, &F, &E, &fIJ, &fAB, &Dints, &LIJAB, &LIA, &FME, + occpi, occ_off, virtpi, vir_off); + + /* L_JKDC <-- +1/2 t_IJKABC W_ABID (IDAB) */ + /* L_JKCD <-- -1/2 t_IJKABC W_ABID (IDAB) */ + jk = L2new.params->rowidx[J][K]; + for (Gd = 0; Gd < nirreps; Gd++) { + Gab = Gid = Gi ^ Gd; /* assumes Wieab is totally symmetric */ + Gc = Gab ^ Gijk; /* assumes T3 is totally symmetric */ + + id = WMAFE.row_offset[Gid][I]; + + Z = block_matrix(virtpi[Gc], virtpi[Gd]); + WMAFE.matrix[Gid] = + global_dpd_->dpd_block_matrix(virtpi[Gd], WMAFE.params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(&WMAFE, Gid, id, virtpi[Gd]); + + nrows = virtpi[Gc]; + ncols = virtpi[Gd]; + nlinks = WMAFE.params->coltot[Gid]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nrows, + WMAFE.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); + + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + for (d = 0; d < virtpi[Gd]; d++) { + DD = vir_off[Gd] + d; + cd = L2new.params->colidx[C][DD]; + dc = L2new.params->colidx[DD][C]; + L2new.matrix[Gjk][jk][dc] += Z[c][d]; + L2new.matrix[Gjk][jk][cd] += -Z[c][d]; + } + } + global_dpd_->free_dpd_block(WMAFE.matrix[Gid], virtpi[Gd], WMAFE.params->coltot[Gid]); + free_block(Z); + } + + /* t_MIAB <-- +1/2 t_IJKABC W_JKMC */ + /* t_IMAB <-- -1/2 t_IJKABC W_JKMC */ + jk = WMNIE.params->rowidx[J][K]; + for (Gm = 0; Gm < nirreps; Gm++) { + Gab = Gmi = Gm ^ Gi; /* assumes totally symmetric */ + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + + mc = WMNIE.col_offset[Gjk][Gm]; + + nrows = F.params->coltot[Gab]; + ncols = occpi[Gm]; + nlinks = virtpi[Gc]; + + Z = global_dpd_->dpd_block_matrix(nrows, ncols); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nlinks, + &(WMNIE.matrix[Gjk][jk][mc]), nlinks, 0.0, Z[0], ncols); + + for (m = 0; m < ncols; m++) { + M = occ_off[Gm] + m; + mi = L2new.params->rowidx[M][I]; + im = L2new.params->rowidx[I][M]; + for (ab = 0; ab < nrows; ab++) { + L2new.matrix[Gmi][mi][ab] += Z[ab][m]; + L2new.matrix[Gmi][im][ab] -= Z[ab][m]; + } + } + + global_dpd_->free_dpd_block(Z, nrows, ncols); + } + + /* Z_IDAB <-- 1/2 L_IJKABC t_JKDC */ + + jk = T2.params->rowidx[J][K]; + for (Gab = 0; Gab < nirreps; Gab++) { + Gid = Gab; /* totally symmetric */ + Gc = Gab ^ Gijk; /* totally symmetric */ + Gd = Gi ^ Gid; + + nrows = virtpi[Gd]; + ncols = ZIGDE.params->coltot[Gid]; + nlinks = virtpi[Gc]; + + dc = T2.col_offset[Gjk][Gd]; + id = ZIGDE.row_offset[Gid][I]; + ZIGDE.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZIGDE, Gid, id, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(T2.matrix[Gjk][jk][dc]), nlinks, + W1[Gab][0], nlinks, 1.0, ZIGDE.matrix[Gid][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZIGDE, Gid, id, nrows); + global_dpd_->free_dpd_block(ZIGDE.matrix[Gid], nrows, ncols); + } + + /* Z_JDAB <-- 1/2 L_IJKABC t_IKDC */ + ik = T2.params->rowidx[I][K]; + for (Gab = 0; Gab < nirreps; Gab++) { + Gjd = Gab; /* totally symmetric */ + Gc = Gab ^ Gijk; /* totally symmetric */ + Gd = Gj ^ Gjd; + + nrows = virtpi[Gd]; + ncols = ZDMAE.params->coltot[Gjd]; + nlinks = virtpi[Gc]; + + dc = T2.col_offset[Gik][Gd]; + jd = ZDMAE.row_offset[Gjd][J]; + ZDMAE.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDMAE, Gjd, jd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 0.5, &(T2.matrix[Gik][ik][dc]), nlinks, + W1[Gab][0], nlinks, 1.0, ZDMAE.matrix[Gjd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDMAE, Gjd, jd, nrows); + global_dpd_->free_dpd_block(ZDMAE.matrix[Gjd], nrows, ncols); + } + + /* Z_IJAM <-- -1/2 L_IJKABC t_MKBC */ + /* sort W(AB,C) to W(A,BC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < F.params->coltot[Gab]; ab++) { + A = F.params->colorb[Gab][ab][0]; + B = F.params->colorb[Gab][ab][1]; + Ga = F.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = F.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + ij = ZLMAO.params->rowidx[I][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ + Ga = Gij ^ Gm; /* totally symmetric */ + + nrows = virtpi[Ga]; + ncols = T2.params->coltot[Gmk]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = T2.params->rowidx[M][K]; + am = ZLMAO.col_offset[Gij][Ga] + m; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -0.5, W2[Ga][0], ncols, T2.matrix[Gmk][mk], 1, 1.0, + &(ZLMAO.matrix[Gij][ij][am]), occpi[Gm]); + } + } + + /* Z_IJMB <-- -1/2 L_IJKABC t_MKAC */ + /* sort W(AB,C) to W(B,AC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < F.params->coltot[Gab]; ab++) { + A = F.params->colorb[Gab][ab][0]; + B = F.params->colorb[Gab][ab][1]; + Gb = F.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = F.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + ij = ZIMLE.params->rowidx[I][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gb = Gm ^ Gij; /* totally symmetric */ + Gmk = Gm ^ Gk; + + nrows = virtpi[Gb]; + ncols = T2.params->coltot[Gmk]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = T2.params->rowidx[M][K]; + mb = ZIMLE.col_offset[Gij][Gm] + m * virtpi[Gb]; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -0.5, W2[Gb][0], ncols, T2.matrix[Gmk][mk], 1, 1.0, + &(ZIMLE.matrix[Gij][ij][mb]), 1); + } + } + + } /* k */ + } /* j */ + } /* i */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gbc = Ga ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], F.params->coltot[Gbc]); + } + + } /* Gk */ + } /* Gj */ + } /* Gi */ + + free(W1); + free(W2); + + global_dpd_->buf4_close(&E); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&L); + + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fAB); + + global_dpd_->file2_close(&FME); + global_dpd_->file2_close(&LIA); + global_dpd_->buf4_close(&Dints); + global_dpd_->buf4_close(&LIJAB); + + global_dpd_->buf4_close(&WMAFE); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMNIE, h); + global_dpd_->buf4_close(&WMNIE); + + global_dpd_->buf4_close(&ZIGDE); + global_dpd_->buf4_close(&ZDMAE); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZLMAO, h); + global_dpd_->buf4_mat_irrep_close(&ZLMAO, h); + } + global_dpd_->buf4_close(&ZLMAO); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZIMLE, h); + global_dpd_->buf4_mat_irrep_close(&ZIMLE, h); + } + global_dpd_->buf4_close(&ZIMLE); + + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2, h); + global_dpd_->buf4_close(&T2); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&L2new, h); + global_dpd_->buf4_mat_irrep_close(&L2new, h); + } + global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&D2, &L2new); + global_dpd_->buf4_close(&D2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&L2new, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&L2new); } -void cc3_l3l2_RHF_AAB(void) -{ - int h, nirreps; - int *occ_off, *occpi; - int *vir_off, *virtpi; - int Gi, Gj, Gk, Gijk; - int Ga, Gb, Gc, Gab; - int i, j, k, I, J, K; - int a, b, c, A, B, C; - int ab; - double ***W1, ***W2; - dpdbuf4 L2AA, L2AB, L2BA, EAA, EAB, EBA, FAA, FAB, FBA; - dpdfile2 fIJ, fAB, fij, fab; - dpdbuf4 DAAints, DABints, LIJAB, LIjAb; - dpdfile2 LIA, Lia, FME, Fme; - dpdbuf4 L2AAnew, L2ABnew, L2, D2; - dpdbuf4 WmAfE, WMnIe, WMAFE, WMaFe, WMNIE, WmNiE; - dpdbuf4 ZIGDE, T2AB, T2AA, ZIgDe; - dpdbuf4 ZDMAE, ZDmAe, ZdMAe; - dpdbuf4 ZLMAO, ZLmAo; - dpdbuf4 ZIMLE, ZImLe, ZImlE; - int nrows, ncols, nlinks; - int Gcb, cb; - int Gij, ij, Gji, ji, Gjk, jk, kj, Gkj; - int Gd, d, DD, ad, da, Gkd, kd; - int Gm, m, M, Gmi, mi, im, mc; - int Gid, id, dc, cd; - int Gac, ac, Gca, ca, bd, db; - int Gbc, bc, Gmk, mk, km, Gim, ma, am; - int Gik, ik, Gki, ki, Gjd, jd; - int Gmj, mj, cm, Gjm, jm; - int mb; - double **Z; - - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; - occ_off = moinfo.occ_off; - virtpi = moinfo.virtpi; - vir_off = moinfo.vir_off; - - global_dpd_->buf4_init(&L2AAnew, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIJAB"); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2AAnew, h); - - global_dpd_->buf4_init(&L2ABnew, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIjAb"); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2ABnew, h); - - global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&T2AA, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&T2AB, h); - global_dpd_->buf4_mat_irrep_rd(&T2AB, h); - - global_dpd_->buf4_mat_irrep_init(&T2AA, h); - global_dpd_->buf4_mat_irrep_rd(&T2AA, h); - } - - global_dpd_->buf4_init(&ZIGDE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); - global_dpd_->buf4_scm(&ZIGDE, 0.0); /* this must be cleared in each iteration */ - global_dpd_->buf4_init(&ZIgDe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIgDe"); - global_dpd_->buf4_scm(&ZIgDe, 0.0); /* this must be cleared in each iteration */ - - global_dpd_->buf4_init(&ZDMAE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); - global_dpd_->buf4_scm(&ZDMAE, 0.0); /* must be cleared in each iteration */ - global_dpd_->buf4_init(&ZDmAe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDmAe (mD,Ae)"); - global_dpd_->buf4_scm(&ZDmAe, 0.0); /* must be cleared in each iteration */ - global_dpd_->buf4_init(&ZdMAe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZdMAe (Md,Ae)"); - global_dpd_->buf4_scm(&ZdMAe, 0.0); /* must be cleared in each iteration */ - - global_dpd_->buf4_init(&ZLMAO, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); - global_dpd_->buf4_init(&ZLmAo, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLmAo"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&ZLMAO, h); - global_dpd_->buf4_mat_irrep_rd(&ZLMAO, h); - - global_dpd_->buf4_mat_irrep_init(&ZLmAo, h); - } - - global_dpd_->buf4_init(&ZIMLE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); - global_dpd_->buf4_init(&ZImLe, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImLe"); - global_dpd_->buf4_init(&ZImlE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImlE"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&ZIMLE, h); - global_dpd_->buf4_mat_irrep_rd(&ZIMLE, h); - - global_dpd_->buf4_mat_irrep_init(&ZImLe, h); - global_dpd_->buf4_mat_irrep_init(&ZImlE, h); - } - - global_dpd_->buf4_init(&WmAfE, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); - global_dpd_->buf4_init(&WMAFE, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); - global_dpd_->buf4_init(&WMaFe, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); - - global_dpd_->buf4_init(&WMnIe, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); - global_dpd_->buf4_init(&WMNIE, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); - global_dpd_->buf4_init(&WmNiE, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&WMnIe, h); - global_dpd_->buf4_mat_irrep_rd(&WMnIe, h); - global_dpd_->buf4_mat_irrep_init(&WMNIE, h); - global_dpd_->buf4_mat_irrep_rd(&WMNIE, h); - global_dpd_->buf4_mat_irrep_init(&WmNiE, h); - global_dpd_->buf4_mat_irrep_rd(&WmNiE, h); - } - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); - - global_dpd_->buf4_init(&L2AA, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&L2AB, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&L2BA, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->buf4_init(&FAA, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WAMEF (MA,F>E)"); - global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaMeF (Ma,Fe)"); - global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAmEf (mA,fE)"); - global_dpd_->buf4_init(&EAA, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMNIE (M>N,IE)"); - global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMnIe (Mn,Ie)"); - global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmNiE (mN,iE)"); - - global_dpd_->buf4_init(&DAAints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_init(&DABints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, 0, 0, 1, "Lia"); - global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); - - W1 = (double ***) malloc(nirreps * sizeof(double **)); - W2 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gi=0; Gi < nirreps; Gi++) { - for(Gj=0; Gj < nirreps; Gj++) { - Gij = Gji = Gi ^ Gj; - for(Gk=0; Gk < nirreps; Gk++) { - Gijk = Gi ^ Gj ^ Gk; - - Gjk = Gkj = Gj ^ Gk; - Gik = Gki = Gi ^ Gk; - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - W1[Gab] = global_dpd_->dpd_block_matrix(FAA.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gcb = Ga ^ Gijk; /* assumes totally symmetric */ - W2[Ga] = global_dpd_->dpd_block_matrix(virtpi[Ga], WmAfE.params->coltot[Gcb]); /* alpha-beta-alpha */ - } - - for(i=0; i < occpi[Gi]; i++) { - I = occ_off[Gi] + i; - for(j=0; j < occpi[Gj]; j++) { - J = occ_off[Gj] + j; - for(k=0; k < occpi[Gk]; k++) { - K = occ_off[Gk] + k; - - L3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &L2AA, &L2AB, &L2BA, - &FAA, &FAB, &FBA, &EAA, &EAB, &EBA, &fIJ, &fij, &fAB, &fab, - &DAAints, &DABints, &LIJAB, &LIjAb, &LIA, &Lia, &FME, &Fme, - occpi, occ_off, occpi, occ_off, virtpi, vir_off, virtpi, vir_off); - - /* t_JIDA <-- t_IJkABc W_kDcB */ - /* sort W1(AB,c) to W2(A,cB) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - cb = WmAfE.params->colidx[C][B]; - W2[Ga][a][cb] = W1[Gab][ab][c]; - } - } - } - - ji = L2AAnew.params->rowidx[J][I]; - - for(Gd=0; Gd < nirreps; Gd++) { - Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric */ - Ga = Gd ^ Gij; /* assumes totally symmetric */ - - kd = WmAfE.row_offset[Gkd][K]; - WmAfE.matrix[Gkd] = global_dpd_->dpd_block_matrix(virtpi[Gd], WmAfE.params->coltot[Gkd]); - global_dpd_->buf4_mat_irrep_rd_block(&WmAfE, Gkd, kd, virtpi[Gd]); - Z = block_matrix(virtpi[Ga], virtpi[Gd]); - - nrows = virtpi[Ga]; - ncols = virtpi[Gd]; - nlinks = WmAfE.params->coltot[Gkd]; - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W2[Ga][0], nlinks, - WmAfE.matrix[Gkd][0], nlinks, 0.0, Z[0], ncols); - - for(a=0; a < virtpi[Ga]; a++) { - A = vir_off[Ga] + a; - for(d=0; d < virtpi[Gd]; d++) { - DD = vir_off[Gd] + d; - ad = L2AAnew.params->colidx[A][DD]; - da = L2AAnew.params->colidx[DD][A]; - L2AAnew.matrix[Gij][ji][ad] += -Z[a][d]; - L2AAnew.matrix[Gij][ji][da] += Z[a][d]; - } - } - - global_dpd_->free_dpd_block(WmAfE.matrix[Gkd], virtpi[Gd], WmAfE.params->coltot[Gkd]); - free_block(Z); - } - - /* t_MIAB <--- +t_IJkABc W_JkMc */ - /* t_IMAB <--- -t_IJkABc W_JkMc */ - - jk = WMnIe.params->rowidx[J][K]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gab = Gmi = Gm ^ Gi; /* assumes totally symmetric */ - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - - mc = WMnIe.col_offset[Gjk][Gm]; - - nrows = FAA.params->coltot[Gab]; - ncols = occpi[Gm]; - nlinks = virtpi[Gc]; - - Z = global_dpd_->dpd_block_matrix(nrows, ncols); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W1[Gab][0], nlinks, - &(WMnIe.matrix[Gjk][jk][mc]), nlinks, 0.0, Z[0], ncols); - - for(m=0; m < ncols; m++) { - M = occ_off[Gm] + m; - mi = L2AAnew.params->rowidx[M][I]; - im = L2AAnew.params->rowidx[I][M]; - for(ab=0; ab < nrows; ab++) { - L2AAnew.matrix[Gmi][mi][ab] += Z[ab][m]; - L2AAnew.matrix[Gmi][im][ab] -= Z[ab][m]; - } - } - - global_dpd_->free_dpd_block(Z, nrows, ncols); - } - - /* t_JkDc <-- 1/2 t_IJkABc W_IDAB */ - /* t_KjCd <-- 1/2 t_IJkABc W_IDAB */ - - jk = L2ABnew.params->rowidx[J][K]; - kj = L2ABnew.params->rowidx[K][J]; - - for(Gd=0; Gd < nirreps; Gd++) { - Gab = Gid = Gi ^ Gd; /* assumes totally symmetric */ - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - - id = WMAFE.row_offset[Gid][I]; - WMAFE.matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], WMAFE.params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(&WMAFE, Gid, id, virtpi[Gd]); - Z = block_matrix(virtpi[Gc], virtpi[Gd]); - - nrows = virtpi[Gc]; - ncols = virtpi[Gd]; - nlinks = WMAFE.params->coltot[Gid]; - - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nrows, - WMAFE.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); - - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - for(d=0; d < virtpi[Gd]; d++) { - DD = vir_off[Gd] + d; - dc = L2ABnew.params->colidx[DD][C]; - cd = L2ABnew.params->colidx[C][DD]; - L2ABnew.matrix[Gjk][jk][dc] += Z[c][d]; - L2ABnew.matrix[Gjk][kj][cd] += Z[c][d]; - } - } - - free_block(Z); - global_dpd_->free_dpd_block(WMAFE.matrix[Gid], virtpi[Gd], WMAFE.params->coltot[Gid]); - } - - /* t_JkBd <-- t_IJkABc W_IdAc */ - /* t_KjBd <-- t_IJkABc W_IdAc */ - /* sort W1(AB,c) to W2(B,Ac) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = WMaFe.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - jk = L2ABnew.params->rowidx[J][K]; - kj = L2ABnew.params->rowidx[K][J]; - - for(Gd=0; Gd < nirreps; Gd++) { - Gac = Gid = Gi ^ Gd; /* assumes totally symmetric */ - Gb = Gac ^ Gijk; /* assumes totally symmetric */ - - id = WMaFe.row_offset[Gid][I]; - WMaFe.matrix[Gid] = global_dpd_->dpd_block_matrix(virtpi[Gd], WMaFe.params->coltot[Gid]); - global_dpd_->buf4_mat_irrep_rd_block(&WMaFe, Gid, id, virtpi[Gd]); - Z = block_matrix(virtpi[Gb], virtpi[Gd]); - - nrows = virtpi[Gb]; - ncols = virtpi[Gd]; - nlinks = WMaFe.params->coltot[Gid]; - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W2[Gb][0], nlinks, - WMaFe.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); - - for(b=0; b < virtpi[Gb]; b++) { - B = vir_off[Gb] + b; - for(d=0; d < virtpi[Gd]; d++) { - DD = vir_off[Gd] + d; - bd = L2ABnew.params->colidx[B][DD]; - db = L2ABnew.params->colidx[DD][B]; - L2ABnew.matrix[Gjk][jk][bd] += Z[b][d]; - L2ABnew.matrix[Gjk][kj][db] += Z[b][d]; - } - } - - global_dpd_->free_dpd_block(WMaFe.matrix[Gid], virtpi[Gd], WMaFe.params->coltot[Gid]); - free_block(Z); - } - - /* t_MkBc <-- 1/2 t_IJkABc W_IJMA */ - /* sort W(AB,c) to W(A,Bc) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = L2ABnew.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - ij = WMNIE.params->rowidx[I][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gmk = Gm ^ Gk; /* assumes totally symmetric */ - Ga = Gbc ^ Gijk; /* assumes totally symmetric */ - - ma = WMNIE.col_offset[Gij][Gm]; - - nrows = L2ABnew.params->coltot[Gmk]; - ncols = occpi[Gm]; - nlinks = virtpi[Ga]; - - Z = global_dpd_->dpd_block_matrix(nrows, ncols); - - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W2[Ga][0], nrows, - &(WMNIE.matrix[Gij][ij][ma]), nlinks, 0.0, Z[0], ncols); - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = L2ABnew.params->rowidx[M][K]; - km = L2ABnew.params->rowidx[K][M]; - for(Gb=0; Gb < nirreps; Gb++) { - Gc = Gbc ^ Gb; - for(b=0; b < virtpi[Gb]; b++) { - B = vir_off[Gb] + b; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = L2ABnew.params->colidx[B][C]; - cb = L2ABnew.params->colidx[C][B]; - L2ABnew.matrix[Gmk][mk][bc] += Z[bc][m]; - L2ABnew.matrix[Gmk][km][cb] += Z[bc][m]; - } - } - } - } - - global_dpd_->free_dpd_block(Z, nrows, ncols); - } - - /* t_ImBc <-- t_IJkABc W_kJmA */ - /* sort W(AB,c) to W(A,Bc) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = L2ABnew.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - kj = WmNiE.params->rowidx[K][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gim = Gi ^ Gm; /* assumes totally symmetric */ - Ga = Gbc ^ Gijk; /* assumes totally symmetric */ - - ma = WmNiE.col_offset[Gjk][Gm]; - - nrows = L2ABnew.params->coltot[Gim]; - ncols = occpi[Gm]; - nlinks = virtpi[Ga]; - - Z = global_dpd_->dpd_block_matrix(nrows, ncols); - - if(nrows && ncols && nlinks) - C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, W2[Ga][0], nrows, - &(WmNiE.matrix[Gjk][kj][ma]), nlinks, 0.0, Z[0], ncols); - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - im = L2ABnew.params->rowidx[I][M]; - mi = L2ABnew.params->rowidx[M][I]; - for(Gb=0; Gb < nirreps; Gb++) { - Gc = Gbc ^ Gb; - for(b=0; b < virtpi[Gb]; b++) { - B = vir_off[Gb] + b; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = L2ABnew.params->colidx[B][C]; - cb = L2ABnew.params->colidx[C][B]; - L2ABnew.matrix[Gim][im][bc] += Z[bc][m]; - L2ABnew.matrix[Gim][mi][cb] += Z[bc][m]; - } - } - } - } - - global_dpd_->free_dpd_block(Z, nrows, ncols); - } - - /* Z_IDAB <-- L_IJkABc t_JkDc */ - - jk = T2AB.params->rowidx[J][K]; - for(Gab=0; Gab < nirreps; Gab++) { - Gid = Gab; /* totally symmetric */ - Gc = Gab ^ Gijk; /* totally symmetric */ - Gd = Gi ^ Gid; - - nrows = virtpi[Gd]; - ncols = ZIGDE.params->coltot[Gid]; - nlinks = virtpi[Gc]; - - dc = T2AB.col_offset[Gjk][Gd]; - id = ZIGDE.row_offset[Gid][I]; - ZIGDE.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); - - if(nrows && ncols && nlinks) { - global_dpd_->buf4_mat_irrep_rd_block(&ZIGDE, Gid, id, nrows); - - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gjk][jk][dc]), nlinks, - W1[Gab][0], nlinks, 1.0, ZIGDE.matrix[Gid][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZIGDE, Gid, id, nrows); - } - - global_dpd_->free_dpd_block(ZIGDE.matrix[Gid], nrows, ncols); - } - - /* ZkDCa <-- 1/2 L_ijKabC t_ijdb */ - - ij = T2AA.params->rowidx[I][J]; - - /* sort W(ab,C) to W(b,Ca) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = ZIgDe.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gij; /* totally symmetric */ - Gca = Gkd = Gk ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZIgDe.params->coltot[Gkd]; - nlinks = virtpi[Gb]; - - db = T2AA.col_offset[Gij][Gd]; - kd = ZIgDe.row_offset[Gkd][K]; - ZIgDe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZIgDe, Gkd, kd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, 0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, - W2[Gb][0], ncols, 1.0, ZIgDe.matrix[Gkd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZIgDe, Gkd, kd, nrows); - global_dpd_->free_dpd_block(ZIgDe.matrix[Gkd], nrows, ncols); - } - - /* Z_IdAc <-- L_IJkABc t_JkBd */ - - jk = T2AB.params->rowidx[J][K]; - - /* sort W(AB,c) to W(B,Ac) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = ZIgDe.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gjk; /* totally symmetric */ - Gac = Gid = Gi ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZIgDe.params->coltot[Gid]; - nlinks = virtpi[Gb]; - - bd = T2AB.col_offset[Gjk][Gb]; - id = ZIgDe.row_offset[Gid][I]; - ZIgDe.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZIgDe, Gid, id, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gjk][jk][bd]), nrows, - W2[Gb][0], ncols, 1.0, ZIgDe.matrix[Gid][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZIgDe, Gid, id, nrows); - global_dpd_->free_dpd_block(ZIgDe.matrix[Gid], nrows, ncols); - } - - /* Z_JDAB <-- 1/2 L_IJkABc t_IkDc */ - ik = T2AB.params->rowidx[I][K]; - for(Gab=0; Gab < nirreps; Gab++) { - Gjd = Gab; /* totally symmetric */ - Gc = Gab ^ Gijk; /* totally symmetric */ - Gd = Gj ^ Gjd; - - nrows = virtpi[Gd]; - ncols = ZDMAE.params->coltot[Gjd]; - nlinks = virtpi[Gc]; - - dc = T2AB.col_offset[Gik][Gd]; - jd = ZDMAE.row_offset[Gjd][J]; - ZDMAE.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDMAE, Gjd, jd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gik][ik][dc]), nlinks, - W1[Gab][0], nlinks, 1.0, ZDMAE.matrix[Gjd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDMAE, Gjd, jd, nrows); - global_dpd_->free_dpd_block(ZDMAE.matrix[Gjd], nrows, ncols); - } - - /* Z_kDAc <-- 1/2 L_IJkABc t_IJDB */ - ij = T2AA.params->rowidx[I][J]; - /* sort W(AB,c) to W(B,Ac) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = ZDmAe.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gij; /* totally symmetric */ - Gac = Gkd = Gk ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZDmAe.params->coltot[Gkd]; - nlinks = virtpi[Gb]; - - db = T2AA.col_offset[Gij][Gd]; - kd = ZDmAe.row_offset[Gkd][K]; - ZDmAe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDmAe, Gkd, kd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, 0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, - W2[Gb][0], ncols, 1.0, ZDmAe.matrix[Gkd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDmAe, Gkd, kd, nrows); - global_dpd_->free_dpd_block(ZDmAe.matrix[Gkd], nrows, ncols); - } - - /* Z_iDCa <-- L_ijKabC t_KjDb */ - kj = T2AB.params->rowidx[K][J]; - /* sort W(AB,c) to W(B,Ca) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = ZDmAe.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gkj; /* totally symmetric */ - Gca = Gid = Gi ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZDmAe.params->coltot[Gid]; - nlinks = virtpi[Gb]; - - db = T2AB.col_offset[Gkj][Gd]; - id = ZDmAe.row_offset[Gid][I]; - ZDmAe.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDmAe, Gid, id, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gkj][kj][db]), nlinks, - W2[Gb][0], ncols, 1.0, ZDmAe.matrix[Gid][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDmAe, Gid, id, nrows); - global_dpd_->free_dpd_block(ZDmAe.matrix[Gid], nrows, ncols); - } - - /* Z_KdCa <-- -1/2 L_ijKabC t_ijdb */ - ij = T2AA.params->rowidx[I][J]; - /* sort W(AB,c) to W(B,Ca) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = ZdMAe.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gij; /* totally symmetric */ - Gca = Gkd = Gk ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZdMAe.params->coltot[Gkd]; - nlinks = virtpi[Gb]; - - db = T2AA.col_offset[Gij][Gd]; - kd = ZdMAe.row_offset[Gkd][K]; - ZdMAe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZdMAe, Gkd, kd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, - W2[Gb][0], ncols, 1.0, ZdMAe.matrix[Gkd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZdMAe, Gkd, kd, nrows); - global_dpd_->free_dpd_block(ZdMAe.matrix[Gkd], nrows, ncols); - } - - /* Z_JdAc <-- L_IJkABc t_IkBd */ - ik = T2AB.params->rowidx[I][K]; - - /* sort W(AB,c) to W(B,Ca) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* assumes totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++ ){ - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = ZdMAe.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - for(Gb=0; Gb < nirreps; Gb++) { - Gd = Gb ^ Gik; /* totally symmetric */ - Gca = Gjd = Gj ^ Gd; /* totally symmetric */ - - nrows = virtpi[Gd]; - ncols = ZdMAe.params->coltot[Gjd]; - nlinks = virtpi[Gb]; - - bd = T2AB.col_offset[Gik][Gb]; - jd = ZdMAe.row_offset[Gjd][J]; - ZdMAe.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZdMAe, Gjd, jd, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gik][ik][bd]), nrows, - W2[Gb][0], ncols, 1.0, ZdMAe.matrix[Gjd][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZdMAe, Gjd, jd, nrows); - global_dpd_->free_dpd_block(ZdMAe.matrix[Gjd], nrows, ncols); - } - - /* Z_IJAM <-- -1/2 L_IJkABc t_MkBc */ - /* sort W(AB,C) to W(A,BC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = FAA.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - ij = ZLMAO.params->rowidx[I][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ - Ga = Gij ^ Gm; /* totally symmetric */ - - nrows = virtpi[Ga]; - ncols = T2AB.params->coltot[Gmk]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = T2AB.params->rowidx[M][K]; - am = ZLMAO.col_offset[Gij][Ga] + m; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmk][mk], 1, - 1.0, &(ZLMAO.matrix[Gij][ij][am]), occpi[Gm]); - } - } - - /* Z_KiCm <-- -1/2 L_ijKabC t_mjab */ - ki = ZLmAo.params->rowidx[K][I]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gab = Gmj = Gm ^ Gj; /* totally symmetric */ - Gc = Gm ^ Gki; /* totally symmetric */ - - nrows = T2AA.params->coltot[Gmj]; - ncols = virtpi[Gc]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = T2AA.params->rowidx[M][J]; - cm = ZLmAo.col_offset[Gki][Gc] + m; - - if(nrows && ncols) - C_DGEMV('t', nrows, ncols, -0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, - 1.0, &(ZLmAo.matrix[Gki][ki][cm]), occpi[Gm]); - } - } - - /* Z_IkAm <-- - L_IJkABc t_mJcB */ - /* sort W(AB,C) to W(A,CB) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - cb = FAA.params->colidx[C][B]; - W2[Ga][a][cb] = W1[Gab][ab][c]; - } - } - } - - ik = ZLmAo.params->rowidx[I][K]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gmj = Gm ^ Gj; /* totally symmetric */ - Ga = Gm ^ Gik; /* totally symmetric */ - - nrows = virtpi[Ga]; - ncols = T2AB.params->coltot[Gmj]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = T2AB.params->rowidx[M][J]; - am = ZLmAo.col_offset[Gik][Ga] + m; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmj][mj], 1, - 1.0, &(ZLmAo.matrix[Gik][ik][am]), occpi[Gm]); - } - } - - /* Z_IJMB <-- - L_IJkABc t_MkAc */ - /* sort W(AB,C) to W(B,AC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = FAA.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - ij = ZIMLE.params->rowidx[I][J]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gb = Gm ^ Gij; /* totally symmetric */ - Gmk = Gm ^ Gk; - - nrows = virtpi[Gb]; - ncols = T2AB.params->coltot[Gmk]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = T2AB.params->rowidx[M][K]; - mb = ZIMLE.col_offset[Gij][Gm] + m * virtpi[Gb]; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -1.0, W2[Gb][0], ncols, T2AB.matrix[Gmk][mk], 1, - 1.0, &(ZIMLE.matrix[Gij][ij][mb]), 1); - } - - } - - /* Z_IkMc <-- -1/2 L_IJkABc t_MJAB */ - ik = ZImLe.params->rowidx[I][K]; - for(Gm=0; Gm < nirreps; Gm++) { - Gc = Gm ^ Gik ; /* totally symmetric */ - Gab = Gmj = Gm ^ Gj; /* totally symmetric */ - - nrows = T2AA.params->coltot[Gmj]; - ncols = virtpi[Gc]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = T2AA.params->rowidx[M][J]; - mc = ZImLe.col_offset[Gik][Gm] + m * virtpi[Gc]; - - if(nrows && ncols) - C_DGEMV('t', nrows, ncols, -0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, - 1.0, &(ZImLe.matrix[Gik][ik][mc]), 1); - } - } - - /* Z_KiMa <-- - L_ijKabC t_MjCb */ - /* sort W(AB,C) to W(A,CB) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - cb = FAA.params->colidx[C][B]; - W2[Ga][a][cb] = W1[Gab][ab][c]; - } - } - } - - ki = ZImLe.params->rowidx[K][I]; - for(Gm=0; Gm < nirreps; Gm++) { - Ga = Gm ^ Gki; /* totally symmetric */ - Gmj = Gm ^ Gj; - - nrows = virtpi[Ga]; - ncols = T2AB.params->coltot[Gmj]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = T2AB.params->rowidx[M][J]; - ma = ZImLe.col_offset[Gki][Gm] + m * virtpi[Ga]; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmj][mj], 1, - 1.0, &(ZImLe.matrix[Gki][ki][ma]), 1); - } - } - - /* Z_KimC <-- 1/2 L_ijKabC t_mjab */ - ki = ZImlE.params->rowidx[K][I]; - for(Gm=0; Gm < nirreps; Gm++) { - Gc = Gm ^ Gki; /* totally symmetric */ - Gab = Gmj = Gm ^ Gj; - - nrows = T2AA.params->coltot[Gmj]; - ncols = virtpi[Gc]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = T2AA.params->rowidx[M][J]; - mc = ZImlE.col_offset[Gki][Gm] + m * virtpi[Gc]; - - if(nrows && ncols) - C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, - 1.0, &(ZImlE.matrix[Gki][ki][mc]), 1); - } - } - - /* Z_IkmB <-- - l_IJkABc t_JmAc */ - ik = ZImlE.params->rowidx[I][K]; - /* sort W(AB,C) to W(B,AC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ac = FAA.params->colidx[A][C]; - W2[Gb][b][ac] = W1[Gab][ab][c]; - } - } - } - - for(Gm=0; Gm < nirreps; Gm++) { - Gb = Gm ^ Gik; /* totally symmetric */ - Gjm = Gm ^ Gj; - - nrows = virtpi[Gb]; - ncols = T2AB.params->coltot[Gjm]; - - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - jm = T2AB.params->rowidx[J][M]; - mb = ZImlE.col_offset[Gki][Gm] + m * virtpi[Gb]; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, -1.0, W2[Gb][0], ncols, T2AB.matrix[Gjm][jm], 1, - 1.0, &(ZImlE.matrix[Gik][ik][mb]), 1); - } - } - - } /* k */ - } /* j */ - } /* i */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W1[Gab], FAA.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gcb = Ga ^ Gijk; /* assumes totally symmetric */ - global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], WmAfE.params->coltot[Gcb]); - } - - } /* Gk */ - } /* Gj */ - } /* Gi */ - - free(W1); - free(W2); - - global_dpd_->buf4_close(&EAA); - global_dpd_->buf4_close(&EAB); - global_dpd_->buf4_close(&EBA); - global_dpd_->buf4_close(&FAA); - global_dpd_->buf4_close(&FAB); - global_dpd_->buf4_close(&FBA); - global_dpd_->buf4_close(&L2AA); - global_dpd_->buf4_close(&L2AB); - global_dpd_->buf4_close(&L2BA); - - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fAB); - global_dpd_->file2_close(&fij); - global_dpd_->file2_close(&fab); - - global_dpd_->file2_close(&FME); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - - global_dpd_->buf4_close(&DAAints); - global_dpd_->buf4_close(&DABints); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&LIjAb); - - global_dpd_->buf4_close(&WmAfE); - global_dpd_->buf4_close(&WMAFE); - global_dpd_->buf4_close(&WMaFe); - - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMnIe, h); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMNIE, h); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WmNiE, h); - global_dpd_->buf4_close(&WMnIe); - global_dpd_->buf4_close(&WMNIE); - global_dpd_->buf4_close(&WmNiE); - - global_dpd_->buf4_close(&ZIgDe); - global_dpd_->buf4_close(&ZIGDE); - - global_dpd_->buf4_close(&ZDMAE); - global_dpd_->buf4_close(&ZDmAe); - global_dpd_->buf4_close(&ZdMAe); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZLMAO, h); - global_dpd_->buf4_mat_irrep_close(&ZLMAO, h); - } - global_dpd_->buf4_close(&ZLMAO); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZLmAo, h); - global_dpd_->buf4_mat_irrep_close(&ZLmAo, h); - } - global_dpd_->buf4_close(&ZLmAo); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZIMLE, h); - global_dpd_->buf4_mat_irrep_close(&ZIMLE, h); - } - global_dpd_->buf4_close(&ZIMLE); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZImLe, h); - global_dpd_->buf4_mat_irrep_close(&ZImLe, h); - } - global_dpd_->buf4_close(&ZImLe); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZImlE, h); - global_dpd_->buf4_mat_irrep_close(&ZImlE, h); - } - global_dpd_->buf4_close(&ZImlE); - - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2AB, h); - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2AA, h); - global_dpd_->buf4_close(&T2AB); - global_dpd_->buf4_close(&T2AA); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&L2AAnew, h); - global_dpd_->buf4_mat_irrep_close(&L2AAnew, h); - } - global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&D2, &L2AAnew); - global_dpd_->buf4_close(&D2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_axpy(&L2AAnew, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&L2AAnew); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&L2ABnew, h); - global_dpd_->buf4_mat_irrep_close(&L2ABnew, h); - } - global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&D2, &L2ABnew); - global_dpd_->buf4_close(&D2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&L2ABnew, &L2, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&L2ABnew); - - /* Spin adaptation will remove this. And yes, this means that all the above - calculations for LIJAB were pointless... -TDC */ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "New LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&L2); - +void cc3_l3l2_RHF_AAB(void) { + int h, nirreps; + int *occ_off, *occpi; + int *vir_off, *virtpi; + int Gi, Gj, Gk, Gijk; + int Ga, Gb, Gc, Gab; + int i, j, k, I, J, K; + int a, b, c, A, B, C; + int ab; + double ***W1, ***W2; + dpdbuf4 L2AA, L2AB, L2BA, EAA, EAB, EBA, FAA, FAB, FBA; + dpdfile2 fIJ, fAB, fij, fab; + dpdbuf4 DAAints, DABints, LIJAB, LIjAb; + dpdfile2 LIA, Lia, FME, Fme; + dpdbuf4 L2AAnew, L2ABnew, L2, D2; + dpdbuf4 WmAfE, WMnIe, WMAFE, WMaFe, WMNIE, WmNiE; + dpdbuf4 ZIGDE, T2AB, T2AA, ZIgDe; + dpdbuf4 ZDMAE, ZDmAe, ZdMAe; + dpdbuf4 ZLMAO, ZLmAo; + dpdbuf4 ZIMLE, ZImLe, ZImlE; + int nrows, ncols, nlinks; + int Gcb, cb; + int Gij, ij, Gji, ji, Gjk, jk, kj, Gkj; + int Gd, d, DD, ad, da, Gkd, kd; + int Gm, m, M, Gmi, mi, im, mc; + int Gid, id, dc, cd; + int Gac, ac, Gca, ca, bd, db; + int Gbc, bc, Gmk, mk, km, Gim, ma, am; + int Gik, ik, Gki, ki, Gjd, jd; + int Gmj, mj, cm, Gjm, jm; + int mb; + double **Z; + + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + occ_off = moinfo.occ_off; + virtpi = moinfo.virtpi; + vir_off = moinfo.vir_off; + + global_dpd_->buf4_init(&L2AAnew, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIJAB"); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2AAnew, h); + + global_dpd_->buf4_init(&L2ABnew, PSIF_CC3_MISC, 0, 0, 5, 0, 5, 0, "CC3 LIjAb"); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_init(&L2ABnew, h); + + global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&T2AA, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&T2AB, h); + global_dpd_->buf4_mat_irrep_rd(&T2AB, h); + + global_dpd_->buf4_mat_irrep_init(&T2AA, h); + global_dpd_->buf4_mat_irrep_rd(&T2AA, h); + } + + global_dpd_->buf4_init(&ZIGDE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIGDE"); + global_dpd_->buf4_scm(&ZIGDE, 0.0); /* this must be cleared in each iteration */ + global_dpd_->buf4_init(&ZIgDe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZIgDe"); + global_dpd_->buf4_scm(&ZIgDe, 0.0); /* this must be cleared in each iteration */ + + global_dpd_->buf4_init(&ZDMAE, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDMAE (MD,AE)"); + global_dpd_->buf4_scm(&ZDMAE, 0.0); /* must be cleared in each iteration */ + global_dpd_->buf4_init(&ZDmAe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDmAe (mD,Ae)"); + global_dpd_->buf4_scm(&ZDmAe, 0.0); /* must be cleared in each iteration */ + global_dpd_->buf4_init(&ZdMAe, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZdMAe (Md,Ae)"); + global_dpd_->buf4_scm(&ZdMAe, 0.0); /* must be cleared in each iteration */ + + global_dpd_->buf4_init(&ZLMAO, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLMAO"); + global_dpd_->buf4_init(&ZLmAo, PSIF_CC3_MISC, 0, 0, 11, 0, 11, 0, "CC3 ZLmAo"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&ZLMAO, h); + global_dpd_->buf4_mat_irrep_rd(&ZLMAO, h); + + global_dpd_->buf4_mat_irrep_init(&ZLmAo, h); + } + + global_dpd_->buf4_init(&ZIMLE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZIMLE"); + global_dpd_->buf4_init(&ZImLe, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImLe"); + global_dpd_->buf4_init(&ZImlE, PSIF_CC3_MISC, 0, 0, 10, 0, 10, 0, "CC3 ZImlE"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&ZIMLE, h); + global_dpd_->buf4_mat_irrep_rd(&ZIMLE, h); + + global_dpd_->buf4_mat_irrep_init(&ZImLe, h); + global_dpd_->buf4_mat_irrep_init(&ZImlE, h); + } + + global_dpd_->buf4_init(&WmAfE, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); + global_dpd_->buf4_init(&WMAFE, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); + global_dpd_->buf4_init(&WMaFe, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); + + global_dpd_->buf4_init(&WMnIe, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); + global_dpd_->buf4_init(&WMNIE, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); + global_dpd_->buf4_init(&WmNiE, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&WMnIe, h); + global_dpd_->buf4_mat_irrep_rd(&WMnIe, h); + global_dpd_->buf4_mat_irrep_init(&WMNIE, h); + global_dpd_->buf4_mat_irrep_rd(&WMNIE, h); + global_dpd_->buf4_mat_irrep_init(&WmNiE, h); + global_dpd_->buf4_mat_irrep_rd(&WmNiE, h); + } + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); + + global_dpd_->buf4_init(&L2AA, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&L2AB, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&L2BA, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->buf4_init(&FAA, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WAMEF (MA,F>E)"); + global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaMeF (Ma,Fe)"); + global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAmEf (mA,fE)"); + global_dpd_->buf4_init(&EAA, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMNIE (M>N,IE)"); + global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMnIe (Mn,Ie)"); + global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmNiE (mN,iE)"); + + global_dpd_->buf4_init(&DAAints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_init(&DABints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, 0, 0, 1, "Lia"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); + + W1 = (double ***)malloc(nirreps * sizeof(double **)); + W2 = (double ***)malloc(nirreps * sizeof(double **)); + + for (Gi = 0; Gi < nirreps; Gi++) { + for (Gj = 0; Gj < nirreps; Gj++) { + Gij = Gji = Gi ^ Gj; + for (Gk = 0; Gk < nirreps; Gk++) { + Gijk = Gi ^ Gj ^ Gk; + + Gjk = Gkj = Gj ^ Gk; + Gik = Gki = Gi ^ Gk; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + W1[Gab] = global_dpd_->dpd_block_matrix(FAA.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gcb = Ga ^ Gijk; /* assumes totally symmetric */ + W2[Ga] = + global_dpd_->dpd_block_matrix(virtpi[Ga], WmAfE.params->coltot[Gcb]); /* alpha-beta-alpha */ + } + + for (i = 0; i < occpi[Gi]; i++) { + I = occ_off[Gi] + i; + for (j = 0; j < occpi[Gj]; j++) { + J = occ_off[Gj] + j; + for (k = 0; k < occpi[Gk]; k++) { + K = occ_off[Gk] + k; + + L3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &L2AA, &L2AB, &L2BA, &FAA, &FAB, &FBA, &EAA, &EAB, + &EBA, &fIJ, &fij, &fAB, &fab, &DAAints, &DABints, &LIJAB, &LIjAb, &LIA, &Lia, &FME, + &Fme, occpi, occ_off, occpi, occ_off, virtpi, vir_off, virtpi, vir_off); + + /* t_JIDA <-- t_IJkABc W_kDcB */ + /* sort W1(AB,c) to W2(A,cB) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + cb = WmAfE.params->colidx[C][B]; + W2[Ga][a][cb] = W1[Gab][ab][c]; + } + } + } + + ji = L2AAnew.params->rowidx[J][I]; + + for (Gd = 0; Gd < nirreps; Gd++) { + Gcb = Gkd = Gk ^ Gd; /* assumes totally symmetric */ + Ga = Gd ^ Gij; /* assumes totally symmetric */ + + kd = WmAfE.row_offset[Gkd][K]; + WmAfE.matrix[Gkd] = + global_dpd_->dpd_block_matrix(virtpi[Gd], WmAfE.params->coltot[Gkd]); + global_dpd_->buf4_mat_irrep_rd_block(&WmAfE, Gkd, kd, virtpi[Gd]); + Z = block_matrix(virtpi[Ga], virtpi[Gd]); + + nrows = virtpi[Ga]; + ncols = virtpi[Gd]; + nlinks = WmAfE.params->coltot[Gkd]; + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W2[Ga][0], nlinks, + WmAfE.matrix[Gkd][0], nlinks, 0.0, Z[0], ncols); + + for (a = 0; a < virtpi[Ga]; a++) { + A = vir_off[Ga] + a; + for (d = 0; d < virtpi[Gd]; d++) { + DD = vir_off[Gd] + d; + ad = L2AAnew.params->colidx[A][DD]; + da = L2AAnew.params->colidx[DD][A]; + L2AAnew.matrix[Gij][ji][ad] += -Z[a][d]; + L2AAnew.matrix[Gij][ji][da] += Z[a][d]; + } + } + + global_dpd_->free_dpd_block(WmAfE.matrix[Gkd], virtpi[Gd], WmAfE.params->coltot[Gkd]); + free_block(Z); + } + + /* t_MIAB <--- +t_IJkABc W_JkMc */ + /* t_IMAB <--- -t_IJkABc W_JkMc */ + + jk = WMnIe.params->rowidx[J][K]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gab = Gmi = Gm ^ Gi; /* assumes totally symmetric */ + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + + mc = WMnIe.col_offset[Gjk][Gm]; + + nrows = FAA.params->coltot[Gab]; + ncols = occpi[Gm]; + nlinks = virtpi[Gc]; + + Z = global_dpd_->dpd_block_matrix(nrows, ncols); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W1[Gab][0], nlinks, + &(WMnIe.matrix[Gjk][jk][mc]), nlinks, 0.0, Z[0], ncols); + + for (m = 0; m < ncols; m++) { + M = occ_off[Gm] + m; + mi = L2AAnew.params->rowidx[M][I]; + im = L2AAnew.params->rowidx[I][M]; + for (ab = 0; ab < nrows; ab++) { + L2AAnew.matrix[Gmi][mi][ab] += Z[ab][m]; + L2AAnew.matrix[Gmi][im][ab] -= Z[ab][m]; + } + } + + global_dpd_->free_dpd_block(Z, nrows, ncols); + } + + /* t_JkDc <-- 1/2 t_IJkABc W_IDAB */ + /* t_KjCd <-- 1/2 t_IJkABc W_IDAB */ + + jk = L2ABnew.params->rowidx[J][K]; + kj = L2ABnew.params->rowidx[K][J]; + + for (Gd = 0; Gd < nirreps; Gd++) { + Gab = Gid = Gi ^ Gd; /* assumes totally symmetric */ + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + + id = WMAFE.row_offset[Gid][I]; + WMAFE.matrix[Gid] = + global_dpd_->dpd_block_matrix(virtpi[Gd], WMAFE.params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(&WMAFE, Gid, id, virtpi[Gd]); + Z = block_matrix(virtpi[Gc], virtpi[Gd]); + + nrows = virtpi[Gc]; + ncols = virtpi[Gd]; + nlinks = WMAFE.params->coltot[Gid]; + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W1[Gab][0], nrows, + WMAFE.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); + + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + for (d = 0; d < virtpi[Gd]; d++) { + DD = vir_off[Gd] + d; + dc = L2ABnew.params->colidx[DD][C]; + cd = L2ABnew.params->colidx[C][DD]; + L2ABnew.matrix[Gjk][jk][dc] += Z[c][d]; + L2ABnew.matrix[Gjk][kj][cd] += Z[c][d]; + } + } + + free_block(Z); + global_dpd_->free_dpd_block(WMAFE.matrix[Gid], virtpi[Gd], WMAFE.params->coltot[Gid]); + } + + /* t_JkBd <-- t_IJkABc W_IdAc */ + /* t_KjBd <-- t_IJkABc W_IdAc */ + /* sort W1(AB,c) to W2(B,Ac) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = WMaFe.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + jk = L2ABnew.params->rowidx[J][K]; + kj = L2ABnew.params->rowidx[K][J]; + + for (Gd = 0; Gd < nirreps; Gd++) { + Gac = Gid = Gi ^ Gd; /* assumes totally symmetric */ + Gb = Gac ^ Gijk; /* assumes totally symmetric */ + + id = WMaFe.row_offset[Gid][I]; + WMaFe.matrix[Gid] = + global_dpd_->dpd_block_matrix(virtpi[Gd], WMaFe.params->coltot[Gid]); + global_dpd_->buf4_mat_irrep_rd_block(&WMaFe, Gid, id, virtpi[Gd]); + Z = block_matrix(virtpi[Gb], virtpi[Gd]); + + nrows = virtpi[Gb]; + ncols = virtpi[Gd]; + nlinks = WMaFe.params->coltot[Gid]; + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W2[Gb][0], nlinks, + WMaFe.matrix[Gid][0], nlinks, 0.0, Z[0], ncols); + + for (b = 0; b < virtpi[Gb]; b++) { + B = vir_off[Gb] + b; + for (d = 0; d < virtpi[Gd]; d++) { + DD = vir_off[Gd] + d; + bd = L2ABnew.params->colidx[B][DD]; + db = L2ABnew.params->colidx[DD][B]; + L2ABnew.matrix[Gjk][jk][bd] += Z[b][d]; + L2ABnew.matrix[Gjk][kj][db] += Z[b][d]; + } + } + + global_dpd_->free_dpd_block(WMaFe.matrix[Gid], virtpi[Gd], WMaFe.params->coltot[Gid]); + free_block(Z); + } + + /* t_MkBc <-- 1/2 t_IJkABc W_IJMA */ + /* sort W(AB,c) to W(A,Bc) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = L2ABnew.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + ij = WMNIE.params->rowidx[I][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gmk = Gm ^ Gk; /* assumes totally symmetric */ + Ga = Gbc ^ Gijk; /* assumes totally symmetric */ + + ma = WMNIE.col_offset[Gij][Gm]; + + nrows = L2ABnew.params->coltot[Gmk]; + ncols = occpi[Gm]; + nlinks = virtpi[Ga]; + + Z = global_dpd_->dpd_block_matrix(nrows, ncols); + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W2[Ga][0], nrows, + &(WMNIE.matrix[Gij][ij][ma]), nlinks, 0.0, Z[0], ncols); + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = L2ABnew.params->rowidx[M][K]; + km = L2ABnew.params->rowidx[K][M]; + for (Gb = 0; Gb < nirreps; Gb++) { + Gc = Gbc ^ Gb; + for (b = 0; b < virtpi[Gb]; b++) { + B = vir_off[Gb] + b; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = L2ABnew.params->colidx[B][C]; + cb = L2ABnew.params->colidx[C][B]; + L2ABnew.matrix[Gmk][mk][bc] += Z[bc][m]; + L2ABnew.matrix[Gmk][km][cb] += Z[bc][m]; + } + } + } + } + + global_dpd_->free_dpd_block(Z, nrows, ncols); + } + + /* t_ImBc <-- t_IJkABc W_kJmA */ + /* sort W(AB,c) to W(A,Bc) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = L2ABnew.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + kj = WmNiE.params->rowidx[K][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gim = Gi ^ Gm; /* assumes totally symmetric */ + Ga = Gbc ^ Gijk; /* assumes totally symmetric */ + + ma = WmNiE.col_offset[Gjk][Gm]; + + nrows = L2ABnew.params->coltot[Gim]; + ncols = occpi[Gm]; + nlinks = virtpi[Ga]; + + Z = global_dpd_->dpd_block_matrix(nrows, ncols); + + if (nrows && ncols && nlinks) + C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, W2[Ga][0], nrows, + &(WmNiE.matrix[Gjk][kj][ma]), nlinks, 0.0, Z[0], ncols); + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + im = L2ABnew.params->rowidx[I][M]; + mi = L2ABnew.params->rowidx[M][I]; + for (Gb = 0; Gb < nirreps; Gb++) { + Gc = Gbc ^ Gb; + for (b = 0; b < virtpi[Gb]; b++) { + B = vir_off[Gb] + b; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = L2ABnew.params->colidx[B][C]; + cb = L2ABnew.params->colidx[C][B]; + L2ABnew.matrix[Gim][im][bc] += Z[bc][m]; + L2ABnew.matrix[Gim][mi][cb] += Z[bc][m]; + } + } + } + } + + global_dpd_->free_dpd_block(Z, nrows, ncols); + } + + /* Z_IDAB <-- L_IJkABc t_JkDc */ + + jk = T2AB.params->rowidx[J][K]; + for (Gab = 0; Gab < nirreps; Gab++) { + Gid = Gab; /* totally symmetric */ + Gc = Gab ^ Gijk; /* totally symmetric */ + Gd = Gi ^ Gid; + + nrows = virtpi[Gd]; + ncols = ZIGDE.params->coltot[Gid]; + nlinks = virtpi[Gc]; + + dc = T2AB.col_offset[Gjk][Gd]; + id = ZIGDE.row_offset[Gid][I]; + ZIGDE.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); + + if (nrows && ncols && nlinks) { + global_dpd_->buf4_mat_irrep_rd_block(&ZIGDE, Gid, id, nrows); + + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gjk][jk][dc]), nlinks, + W1[Gab][0], nlinks, 1.0, ZIGDE.matrix[Gid][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZIGDE, Gid, id, nrows); + } + + global_dpd_->free_dpd_block(ZIGDE.matrix[Gid], nrows, ncols); + } + + /* ZkDCa <-- 1/2 L_ijKabC t_ijdb */ + + ij = T2AA.params->rowidx[I][J]; + + /* sort W(ab,C) to W(b,Ca) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = ZIgDe.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gij; /* totally symmetric */ + Gca = Gkd = Gk ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZIgDe.params->coltot[Gkd]; + nlinks = virtpi[Gb]; + + db = T2AA.col_offset[Gij][Gd]; + kd = ZIgDe.row_offset[Gkd][K]; + ZIgDe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZIgDe, Gkd, kd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, 0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, + W2[Gb][0], ncols, 1.0, ZIgDe.matrix[Gkd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZIgDe, Gkd, kd, nrows); + global_dpd_->free_dpd_block(ZIgDe.matrix[Gkd], nrows, ncols); + } + + /* Z_IdAc <-- L_IJkABc t_JkBd */ + + jk = T2AB.params->rowidx[J][K]; + + /* sort W(AB,c) to W(B,Ac) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = ZIgDe.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gjk; /* totally symmetric */ + Gac = Gid = Gi ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZIgDe.params->coltot[Gid]; + nlinks = virtpi[Gb]; + + bd = T2AB.col_offset[Gjk][Gb]; + id = ZIgDe.row_offset[Gid][I]; + ZIgDe.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZIgDe, Gid, id, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gjk][jk][bd]), nrows, + W2[Gb][0], ncols, 1.0, ZIgDe.matrix[Gid][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZIgDe, Gid, id, nrows); + global_dpd_->free_dpd_block(ZIgDe.matrix[Gid], nrows, ncols); + } + + /* Z_JDAB <-- 1/2 L_IJkABc t_IkDc */ + ik = T2AB.params->rowidx[I][K]; + for (Gab = 0; Gab < nirreps; Gab++) { + Gjd = Gab; /* totally symmetric */ + Gc = Gab ^ Gijk; /* totally symmetric */ + Gd = Gj ^ Gjd; + + nrows = virtpi[Gd]; + ncols = ZDMAE.params->coltot[Gjd]; + nlinks = virtpi[Gc]; + + dc = T2AB.col_offset[Gik][Gd]; + jd = ZDMAE.row_offset[Gjd][J]; + ZDMAE.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDMAE, Gjd, jd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gik][ik][dc]), nlinks, + W1[Gab][0], nlinks, 1.0, ZDMAE.matrix[Gjd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDMAE, Gjd, jd, nrows); + global_dpd_->free_dpd_block(ZDMAE.matrix[Gjd], nrows, ncols); + } + + /* Z_kDAc <-- 1/2 L_IJkABc t_IJDB */ + ij = T2AA.params->rowidx[I][J]; + /* sort W(AB,c) to W(B,Ac) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = ZDmAe.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gij; /* totally symmetric */ + Gac = Gkd = Gk ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZDmAe.params->coltot[Gkd]; + nlinks = virtpi[Gb]; + + db = T2AA.col_offset[Gij][Gd]; + kd = ZDmAe.row_offset[Gkd][K]; + ZDmAe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDmAe, Gkd, kd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, 0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, + W2[Gb][0], ncols, 1.0, ZDmAe.matrix[Gkd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDmAe, Gkd, kd, nrows); + global_dpd_->free_dpd_block(ZDmAe.matrix[Gkd], nrows, ncols); + } + + /* Z_iDCa <-- L_ijKabC t_KjDb */ + kj = T2AB.params->rowidx[K][J]; + /* sort W(AB,c) to W(B,Ca) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = ZDmAe.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gkj; /* totally symmetric */ + Gca = Gid = Gi ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZDmAe.params->coltot[Gid]; + nlinks = virtpi[Gb]; + + db = T2AB.col_offset[Gkj][Gd]; + id = ZDmAe.row_offset[Gid][I]; + ZDmAe.matrix[Gid] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDmAe, Gid, id, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gkj][kj][db]), nlinks, + W2[Gb][0], ncols, 1.0, ZDmAe.matrix[Gid][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDmAe, Gid, id, nrows); + global_dpd_->free_dpd_block(ZDmAe.matrix[Gid], nrows, ncols); + } + + /* Z_KdCa <-- -1/2 L_ijKabC t_ijdb */ + ij = T2AA.params->rowidx[I][J]; + /* sort W(AB,c) to W(B,Ca) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = ZdMAe.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gij; /* totally symmetric */ + Gca = Gkd = Gk ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZdMAe.params->coltot[Gkd]; + nlinks = virtpi[Gb]; + + db = T2AA.col_offset[Gij][Gd]; + kd = ZdMAe.row_offset[Gkd][K]; + ZdMAe.matrix[Gkd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZdMAe, Gkd, kd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(T2AA.matrix[Gij][ij][db]), nlinks, + W2[Gb][0], ncols, 1.0, ZdMAe.matrix[Gkd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZdMAe, Gkd, kd, nrows); + global_dpd_->free_dpd_block(ZdMAe.matrix[Gkd], nrows, ncols); + } + + /* Z_JdAc <-- L_IJkABc t_IkBd */ + ik = T2AB.params->rowidx[I][K]; + + /* sort W(AB,c) to W(B,Ca) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* assumes totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = ZdMAe.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + for (Gb = 0; Gb < nirreps; Gb++) { + Gd = Gb ^ Gik; /* totally symmetric */ + Gca = Gjd = Gj ^ Gd; /* totally symmetric */ + + nrows = virtpi[Gd]; + ncols = ZdMAe.params->coltot[Gjd]; + nlinks = virtpi[Gb]; + + bd = T2AB.col_offset[Gik][Gb]; + jd = ZdMAe.row_offset[Gjd][J]; + ZdMAe.matrix[Gjd] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZdMAe, Gjd, jd, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('t', 'n', nrows, ncols, nlinks, 1.0, &(T2AB.matrix[Gik][ik][bd]), nrows, + W2[Gb][0], ncols, 1.0, ZdMAe.matrix[Gjd][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZdMAe, Gjd, jd, nrows); + global_dpd_->free_dpd_block(ZdMAe.matrix[Gjd], nrows, ncols); + } + + /* Z_IJAM <-- -1/2 L_IJkABc t_MkBc */ + /* sort W(AB,C) to W(A,BC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = FAA.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + ij = ZLMAO.params->rowidx[I][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ + Ga = Gij ^ Gm; /* totally symmetric */ + + nrows = virtpi[Ga]; + ncols = T2AB.params->coltot[Gmk]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = T2AB.params->rowidx[M][K]; + am = ZLMAO.col_offset[Gij][Ga] + m; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmk][mk], 1, 1.0, + &(ZLMAO.matrix[Gij][ij][am]), occpi[Gm]); + } + } + + /* Z_KiCm <-- -1/2 L_ijKabC t_mjab */ + ki = ZLmAo.params->rowidx[K][I]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gab = Gmj = Gm ^ Gj; /* totally symmetric */ + Gc = Gm ^ Gki; /* totally symmetric */ + + nrows = T2AA.params->coltot[Gmj]; + ncols = virtpi[Gc]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = T2AA.params->rowidx[M][J]; + cm = ZLmAo.col_offset[Gki][Gc] + m; + + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, -0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, + 1.0, &(ZLmAo.matrix[Gki][ki][cm]), occpi[Gm]); + } + } + + /* Z_IkAm <-- - L_IJkABc t_mJcB */ + /* sort W(AB,C) to W(A,CB) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + cb = FAA.params->colidx[C][B]; + W2[Ga][a][cb] = W1[Gab][ab][c]; + } + } + } + + ik = ZLmAo.params->rowidx[I][K]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gmj = Gm ^ Gj; /* totally symmetric */ + Ga = Gm ^ Gik; /* totally symmetric */ + + nrows = virtpi[Ga]; + ncols = T2AB.params->coltot[Gmj]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = T2AB.params->rowidx[M][J]; + am = ZLmAo.col_offset[Gik][Ga] + m; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmj][mj], 1, 1.0, + &(ZLmAo.matrix[Gik][ik][am]), occpi[Gm]); + } + } + + /* Z_IJMB <-- - L_IJkABc t_MkAc */ + /* sort W(AB,C) to W(B,AC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = FAA.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + ij = ZIMLE.params->rowidx[I][J]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gb = Gm ^ Gij; /* totally symmetric */ + Gmk = Gm ^ Gk; + + nrows = virtpi[Gb]; + ncols = T2AB.params->coltot[Gmk]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = T2AB.params->rowidx[M][K]; + mb = ZIMLE.col_offset[Gij][Gm] + m * virtpi[Gb]; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -1.0, W2[Gb][0], ncols, T2AB.matrix[Gmk][mk], 1, 1.0, + &(ZIMLE.matrix[Gij][ij][mb]), 1); + } + } + + /* Z_IkMc <-- -1/2 L_IJkABc t_MJAB */ + ik = ZImLe.params->rowidx[I][K]; + for (Gm = 0; Gm < nirreps; Gm++) { + Gc = Gm ^ Gik; /* totally symmetric */ + Gab = Gmj = Gm ^ Gj; /* totally symmetric */ + + nrows = T2AA.params->coltot[Gmj]; + ncols = virtpi[Gc]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = T2AA.params->rowidx[M][J]; + mc = ZImLe.col_offset[Gik][Gm] + m * virtpi[Gc]; + + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, -0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, + 1.0, &(ZImLe.matrix[Gik][ik][mc]), 1); + } + } + + /* Z_KiMa <-- - L_ijKabC t_MjCb */ + /* sort W(AB,C) to W(A,CB) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + cb = FAA.params->colidx[C][B]; + W2[Ga][a][cb] = W1[Gab][ab][c]; + } + } + } + + ki = ZImLe.params->rowidx[K][I]; + for (Gm = 0; Gm < nirreps; Gm++) { + Ga = Gm ^ Gki; /* totally symmetric */ + Gmj = Gm ^ Gj; + + nrows = virtpi[Ga]; + ncols = T2AB.params->coltot[Gmj]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = T2AB.params->rowidx[M][J]; + ma = ZImLe.col_offset[Gki][Gm] + m * virtpi[Ga]; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -1.0, W2[Ga][0], ncols, T2AB.matrix[Gmj][mj], 1, 1.0, + &(ZImLe.matrix[Gki][ki][ma]), 1); + } + } + + /* Z_KimC <-- 1/2 L_ijKabC t_mjab */ + ki = ZImlE.params->rowidx[K][I]; + for (Gm = 0; Gm < nirreps; Gm++) { + Gc = Gm ^ Gki; /* totally symmetric */ + Gab = Gmj = Gm ^ Gj; + + nrows = T2AA.params->coltot[Gmj]; + ncols = virtpi[Gc]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = T2AA.params->rowidx[M][J]; + mc = ZImlE.col_offset[Gki][Gm] + m * virtpi[Gc]; + + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, T2AA.matrix[Gmj][mj], 1, 1.0, + &(ZImlE.matrix[Gki][ki][mc]), 1); + } + } + + /* Z_IkmB <-- - l_IJkABc t_JmAc */ + ik = ZImlE.params->rowidx[I][K]; + /* sort W(AB,C) to W(B,AC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ac = FAA.params->colidx[A][C]; + W2[Gb][b][ac] = W1[Gab][ab][c]; + } + } + } + + for (Gm = 0; Gm < nirreps; Gm++) { + Gb = Gm ^ Gik; /* totally symmetric */ + Gjm = Gm ^ Gj; + + nrows = virtpi[Gb]; + ncols = T2AB.params->coltot[Gjm]; + + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + jm = T2AB.params->rowidx[J][M]; + mb = ZImlE.col_offset[Gki][Gm] + m * virtpi[Gb]; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, -1.0, W2[Gb][0], ncols, T2AB.matrix[Gjm][jm], 1, 1.0, + &(ZImlE.matrix[Gik][ik][mb]), 1); + } + } + + } /* k */ + } /* j */ + } /* i */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W1[Gab], FAA.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gcb = Ga ^ Gijk; /* assumes totally symmetric */ + global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], WmAfE.params->coltot[Gcb]); + } + + } /* Gk */ + } /* Gj */ + } /* Gi */ + + free(W1); + free(W2); + + global_dpd_->buf4_close(&EAA); + global_dpd_->buf4_close(&EAB); + global_dpd_->buf4_close(&EBA); + global_dpd_->buf4_close(&FAA); + global_dpd_->buf4_close(&FAB); + global_dpd_->buf4_close(&FBA); + global_dpd_->buf4_close(&L2AA); + global_dpd_->buf4_close(&L2AB); + global_dpd_->buf4_close(&L2BA); + + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fAB); + global_dpd_->file2_close(&fij); + global_dpd_->file2_close(&fab); + + global_dpd_->file2_close(&FME); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + + global_dpd_->buf4_close(&DAAints); + global_dpd_->buf4_close(&DABints); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&LIjAb); + + global_dpd_->buf4_close(&WmAfE); + global_dpd_->buf4_close(&WMAFE); + global_dpd_->buf4_close(&WMaFe); + + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMnIe, h); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WMNIE, h); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&WmNiE, h); + global_dpd_->buf4_close(&WMnIe); + global_dpd_->buf4_close(&WMNIE); + global_dpd_->buf4_close(&WmNiE); + + global_dpd_->buf4_close(&ZIgDe); + global_dpd_->buf4_close(&ZIGDE); + + global_dpd_->buf4_close(&ZDMAE); + global_dpd_->buf4_close(&ZDmAe); + global_dpd_->buf4_close(&ZdMAe); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZLMAO, h); + global_dpd_->buf4_mat_irrep_close(&ZLMAO, h); + } + global_dpd_->buf4_close(&ZLMAO); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZLmAo, h); + global_dpd_->buf4_mat_irrep_close(&ZLmAo, h); + } + global_dpd_->buf4_close(&ZLmAo); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZIMLE, h); + global_dpd_->buf4_mat_irrep_close(&ZIMLE, h); + } + global_dpd_->buf4_close(&ZIMLE); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZImLe, h); + global_dpd_->buf4_mat_irrep_close(&ZImLe, h); + } + global_dpd_->buf4_close(&ZImLe); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZImlE, h); + global_dpd_->buf4_mat_irrep_close(&ZImlE, h); + } + global_dpd_->buf4_close(&ZImlE); + + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2AB, h); + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&T2AA, h); + global_dpd_->buf4_close(&T2AB); + global_dpd_->buf4_close(&T2AA); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&L2AAnew, h); + global_dpd_->buf4_mat_irrep_close(&L2AAnew, h); + } + global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&D2, &L2AAnew); + global_dpd_->buf4_close(&D2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_axpy(&L2AAnew, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&L2AAnew); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&L2ABnew, h); + global_dpd_->buf4_mat_irrep_close(&L2ABnew, h); + } + global_dpd_->buf4_init(&D2, PSIF_CC_DENOM, 0, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&D2, &L2ABnew); + global_dpd_->buf4_close(&D2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&L2ABnew, &L2, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&L2ABnew); + + /* Spin adaptation will remove this. And yes, this means that all the above + calculations for LIJAB were pointless... -TDC */ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "New LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&L2); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc3_t3x.cc b/psi4/src/psi4/cclambda/cc3_t3x.cc index b5dc713c042..096e415be71 100644 --- a/psi4/src/psi4/cclambda/cc3_t3x.cc +++ b/psi4/src/psi4/cclambda/cc3_t3x.cc @@ -39,196 +39,195 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void cc3_t3x(void) -{ - if(params.ref == 0) { - int h, nirreps; - int *occ_off, *occpi; - int *vir_off, *virtpi; - int Gi, Gj, Gk, Gijk; - int Ga, Gb, Gc, Gab; - int i, j, k, I, J, K; - int a, b, c, A, B, C; - int ab; - double ***W1; - dpdbuf4 T2, E, F, T2AA, T2AB, T2BA, EAA, EAB, EBA, FAA, FAB, FBA; - dpdfile2 fIJ, fAB, fij, fab; - dpdfile2 XLD; - dpdbuf4 L2, L2AB; - int Gij, ij, Gbc, bc, Gjk, jk; - int nrows, ncols; - int **W_offset, offset; - - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; - occ_off = moinfo.occ_off; - virtpi = moinfo.virtpi; - vir_off = moinfo.vir_off; - - W_offset = init_int_matrix(nirreps, nirreps); - for(Gab=0; Gab < nirreps; Gab++) { - for(Ga=0,offset=0; Ga < nirreps; Ga++) { - Gb = Ga ^ Gab; - W_offset[Gab][Ga] = offset; - offset += virtpi[Ga] * virtpi[Gb]; - } - } - - global_dpd_->file2_init(&XLD, PSIF_CC3_MISC, 0, 0, 1, "CC3 XLD"); - global_dpd_->file2_mat_init(&XLD); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&L2AB, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - - global_dpd_->buf4_mat_irrep_init(&L2AB, h); - global_dpd_->buf4_mat_irrep_rd(&L2AB, h); - } - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); - global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); - - T2AA = T2; - global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&T2BA, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); - FAA = F; - global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); - global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); - EAA = E; - global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); - global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); - - /* target T3 amplitudes go in here */ - W1 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gi=0; Gi < nirreps; Gi++) { - for(Gj=0; Gj < nirreps; Gj++) { - Gij = Gi ^ Gj; - for(Gk=0; Gk < nirreps; Gk++) { - Gijk = Gi ^ Gj ^ Gk; - Gjk = Gj ^ Gk; - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); - } - - for(i=0; i < occpi[Gi]; i++) { - I = occ_off[Gi] + i; - for(j=0; j < occpi[Gj]; j++) { - J = occ_off[Gj] + j; - for(k=0; k < occpi[Gk]; k++) { - K = occ_off[Gk] + k; - - global_dpd_->T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2, &F, &E, &fIJ, &fAB, - occpi, occ_off, virtpi, vir_off, 0.0); - - /* X_KC <-- 1/4 t_IJKABC */ - - Gc = Gk; /* assumes T1 is totally symmetric */ - Gab = Gij; /* assumes is totally symmetric */ - - ij = L2.params->rowidx[I][J]; - - nrows = L2.params->coltot[Gij]; - ncols = virtpi[Gc]; - - if(nrows && ncols) - C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, L2.matrix[Gij][ij], 1, - 1.0, XLD.matrix[Gk][k], 1); +namespace psi { +namespace cclambda { + +void cc3_t3x(void) { + if (params.ref == 0) { + int h, nirreps; + int *occ_off, *occpi; + int *vir_off, *virtpi; + int Gi, Gj, Gk, Gijk; + int Ga, Gb, Gc, Gab; + int i, j, k, I, J, K; + int a, b, c, A, B, C; + int ab; + double ***W1; + dpdbuf4 T2, E, F, T2AA, T2AB, T2BA, EAA, EAB, EBA, FAA, FAB, FBA; + dpdfile2 fIJ, fAB, fij, fab; + dpdfile2 XLD; + dpdbuf4 L2, L2AB; + int Gij, ij, Gbc, bc, Gjk, jk; + int nrows, ncols; + int **W_offset, offset; + + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + occ_off = moinfo.occ_off; + virtpi = moinfo.virtpi; + vir_off = moinfo.vir_off; + + W_offset = init_int_matrix(nirreps, nirreps); + for (Gab = 0; Gab < nirreps; Gab++) { + for (Ga = 0, offset = 0; Ga < nirreps; Ga++) { + Gb = Ga ^ Gab; + W_offset[Gab][Ga] = offset; + offset += virtpi[Ga] * virtpi[Gb]; + } + } + + global_dpd_->file2_init(&XLD, PSIF_CC3_MISC, 0, 0, 1, "CC3 XLD"); + global_dpd_->file2_mat_init(&XLD); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, 0, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&L2AB, PSIF_CC_LAMBDA, 0, 0, 5, 0, 5, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + + global_dpd_->buf4_mat_irrep_init(&L2AB, h); + global_dpd_->buf4_mat_irrep_rd(&L2AB, h); + } + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); + global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); + + T2AA = T2; + global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&T2BA, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); + FAA = F; + global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); + global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); + EAA = E; + global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); + global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); + + /* target T3 amplitudes go in here */ + W1 = (double ***)malloc(nirreps * sizeof(double **)); + + for (Gi = 0; Gi < nirreps; Gi++) { + for (Gj = 0; Gj < nirreps; Gj++) { + Gij = Gi ^ Gj; + for (Gk = 0; Gk < nirreps; Gk++) { + Gijk = Gi ^ Gj ^ Gk; + Gjk = Gj ^ Gk; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); + } + + for (i = 0; i < occpi[Gi]; i++) { + I = occ_off[Gi] + i; + for (j = 0; j < occpi[Gj]; j++) { + J = occ_off[Gj] + j; + for (k = 0; k < occpi[Gk]; k++) { + K = occ_off[Gk] + k; + + global_dpd_->T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2, &F, &E, &fIJ, &fAB, occpi, + occ_off, virtpi, vir_off, 0.0); + + /* X_KC <-- 1/4 t_IJKABC */ + + Gc = Gk; /* assumes T1 is totally symmetric */ + Gab = Gij; /* assumes is totally symmetric */ + + ij = L2.params->rowidx[I][J]; + + nrows = L2.params->coltot[Gij]; + ncols = virtpi[Gc]; + + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, L2.matrix[Gij][ij], 1, 1.0, + XLD.matrix[Gk][k], 1); + + global_dpd_->T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2AA, &T2AB, &T2BA, &FAA, &FAB, + &FBA, &EAA, &EAB, &EBA, &fIJ, &fij, &fAB, &fab, occpi, occ_off, + occpi, occ_off, virtpi, vir_off, virtpi, vir_off, 0.0); + + /* t_IA <-- t_IJkABc */ + + Ga = Gi; /* assumes T1 is totally symmetric */ + Gbc = Gjk; /* assumes is totally symmetric */ + + jk = L2AB.params->rowidx[J][K]; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gb = Ga ^ Gab; + Gc = Gb ^ Gbc; + + ab = W_offset[Gab][Ga]; + bc = L2AB.col_offset[Gjk][Gb]; + + nrows = virtpi[Ga]; + ncols = virtpi[Gb] * virtpi[Gc]; + + if (nrows && ncols) + C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][ab], ncols, &(L2AB.matrix[Gjk][jk][bc]), + 1, 1.0, XLD.matrix[Gi][i], 1); + } + /* t_KC <-- 1/4 t_ijKabC */ + + Gc = Gk; /* assumes T1 is totally symmetric */ + Gab = Gij; /* assumes is totally symmetric */ + + ij = L2.params->rowidx[I][J]; + + nrows = L2.params->coltot[Gij]; + ncols = virtpi[Gc]; + + if (nrows && ncols) + C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, L2.matrix[Gij][ij], 1, 1.0, + XLD.matrix[Gk][k], 1); + + } /* k */ + } /* j */ + } /* i */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); + } + } /* Gk */ + } /* Gj */ + } /* Gi */ + + free(W1); + + global_dpd_->buf4_close(&E); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&T2); + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fAB); - global_dpd_->T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2AA, &T2AB, &T2BA, - &FAA, &FAB, &FBA, &EAA, &EAB, &EBA, &fIJ, &fij, &fAB, &fab, - occpi, occ_off, occpi, occ_off, virtpi, vir_off, virtpi, vir_off, 0.0); + global_dpd_->buf4_close(&EAB); + global_dpd_->buf4_close(&EBA); + global_dpd_->buf4_close(&FAB); + global_dpd_->buf4_close(&FBA); + global_dpd_->buf4_close(&T2AB); + global_dpd_->buf4_close(&T2BA); + global_dpd_->file2_close(&fij); + global_dpd_->file2_close(&fab); - /* t_IA <-- t_IJkABc */ + free_int_matrix(W_offset); - Ga = Gi; /* assumes T1 is totally symmetric */ - Gbc = Gjk; /* assumes is totally symmetric */ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_close(&L2, h); + global_dpd_->buf4_mat_irrep_close(&L2AB, h); + } + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&L2AB); - jk = L2AB.params->rowidx[J][K]; - - for(Gab=0; Gab < nirreps; Gab++) { - Gb = Ga ^ Gab; - Gc = Gb ^ Gbc; - - ab = W_offset[Gab][Ga]; - bc = L2AB.col_offset[Gjk][Gb]; - - nrows = virtpi[Ga]; - ncols = virtpi[Gb] * virtpi[Gc]; - - if(nrows && ncols) - C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][ab], ncols, &(L2AB.matrix[Gjk][jk][bc]), 1, - 1.0, XLD.matrix[Gi][i], 1); - - } - /* t_KC <-- 1/4 t_ijKabC */ - - Gc = Gk; /* assumes T1 is totally symmetric */ - Gab = Gij; /* assumes is totally symmetric */ - - ij = L2.params->rowidx[I][J]; - - nrows = L2.params->coltot[Gij]; - ncols = virtpi[Gc]; - - if(nrows && ncols) - C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, L2.matrix[Gij][ij], 1, - 1.0, XLD.matrix[Gk][k], 1); - - - } /* k */ - } /* j */ - } /* i */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); - } - } /* Gk */ - } /* Gj */ - } /* Gi */ - - free(W1); - - global_dpd_->buf4_close(&E); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&T2); - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fAB); - - global_dpd_->buf4_close(&EAB); - global_dpd_->buf4_close(&EBA); - global_dpd_->buf4_close(&FAB); - global_dpd_->buf4_close(&FBA); - global_dpd_->buf4_close(&T2AB); - global_dpd_->buf4_close(&T2BA); - global_dpd_->file2_close(&fij); - global_dpd_->file2_close(&fab); - - free_int_matrix(W_offset); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_close(&L2, h); - global_dpd_->buf4_mat_irrep_close(&L2AB, h); + global_dpd_->file2_mat_wrt(&XLD); + global_dpd_->file2_close(&XLD); } - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&L2AB); - - global_dpd_->file2_mat_wrt(&XLD); - global_dpd_->file2_close(&XLD); - } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cc3_t3z.cc b/psi4/src/psi4/cclambda/cc3_t3z.cc index a600bd22b62..8766cdbfe7f 100644 --- a/psi4/src/psi4/cclambda/cc3_t3z.cc +++ b/psi4/src/psi4/cclambda/cc3_t3z.cc @@ -59,597 +59,597 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void cc3_t3z_RHF_AAA(void); void cc3_t3z_RHF_AAB(void); -void cc3_t3z(void) -{ - if(params.ref == 0) { /** RHF **/ - cc3_t3z_RHF_AAA(); - cc3_t3z_RHF_AAB(); - } - else if(params.ref == 2) { /** UHF **/ - /* TBD */ - } +void cc3_t3z(void) { + if (params.ref == 0) { /** RHF **/ + cc3_t3z_RHF_AAA(); + cc3_t3z_RHF_AAB(); + } else if (params.ref == 2) { /** UHF **/ + /* TBD */ + } } -void cc3_t3z_RHF_AAA(void) -{ - int h, nirreps; - int *occ_off, *occpi; - int *vir_off, *virtpi; - int Gi, Gj, Gk, Gijk; - int Ga, Gb, Gc, Gab; - int i, j, k, I, J, K; - int a, b, c, A, B, C; - int ab; - double ***W1, ***W2; - dpdbuf4 T2, E, F; - dpdfile2 fIJ, fAB; - dpdbuf4 ZIFLN, ZDFAN; - dpdbuf4 Dints; - int Gm, Gmj, Gmc, mj, mc; - int m, M, ik; - int nrows, ncols, nlinks; - double *Z; - int Gij, ij, Gca, ca, Ge, Gke, ke; - int EE, e, eb; - - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; - occ_off = moinfo.occ_off; - virtpi = moinfo.virtpi; - vir_off = moinfo.vir_off; - - global_dpd_->buf4_init(&ZIFLN, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&ZIFLN, h); - } - - global_dpd_->buf4_init(&ZDFAN, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDFAN (NA,FD)"); - global_dpd_->buf4_scm(&ZDFAN, 0.0); - - global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&Dints, h); - global_dpd_->buf4_mat_irrep_rd(&Dints, h); - } - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); - global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); - - /* target T3 amplitudes go in here */ - W1 = (double ***) malloc(nirreps * sizeof(double **)); - W2 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gi=0; Gi < nirreps; Gi++) { - for(Gj=0; Gj < nirreps; Gj++) { - Gij = Gi ^ Gj; - for(Gk=0; Gk < nirreps; Gk++) { - Gijk = Gi ^ Gj ^ Gk; - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); - } - for(Gb=0; Gb < nirreps; Gb++) { - Gca = Gb ^ Gijk; /* totally symmtric */ - W2[Gb] = global_dpd_->dpd_block_matrix(virtpi[Gb], F.params->coltot[Gca]); - } - - for(i=0; i < occpi[Gi]; i++) { - I = occ_off[Gi] + i; - for(j=0; j < occpi[Gj]; j++) { - J = occ_off[Gj] + j; - for(k=0; k < occpi[Gk]; k++) { - K = occ_off[Gk] + k; - - global_dpd_->T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2, &F, &E, &fIJ, &fAB, - occpi, occ_off, virtpi, vir_off, 0.0); - - /* Z_MCIK <-- 1/2 t_IJKABC */ - - ik = ZIFLN.params->colidx[I][K]; - - for(Gm=0; Gm < nirreps; Gm++) { - Gab = Gmj = Gm ^ Gj; /* totally symmetric? */ - Gc = Gab ^ Gijk; /* totally symmetric? */ - Gmc = Gm ^ Gc; - - nrows = Dints.params->coltot[Gmj]; - ncols = virtpi[Gc]; - Z = init_array(ncols); - - if(nrows && ncols) { - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = Dints.params->rowidx[M][J]; - C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, Dints.matrix[Gmj][mj], 1, 0.0, Z, 1); - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - mc = ZIFLN.params->rowidx[M][C]; - ZIFLN.matrix[Gmc][mc][ik] += Z[c]; - } - } - } - free(Z); - } - - /* Z_ACEK (KE,CA) <-- -1/2 t_IJKABC */ - - ij = Dints.params->rowidx[I][J]; - /* sort W(AB,C) to W(B,CA) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < F.params->coltot[Gab]; ab++) { - A = F.params->colorb[Gab][ab][0]; - B = F.params->colorb[Gab][ab][1]; - Gb = F.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = F.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Ge=0; Ge < nirreps; Ge++) { - Gb = Ge ^ Gij; /* totally symmetric */ - Gca = Gke = Gk ^ Ge; /* totally symmetric */ - - nrows = virtpi[Ge]; - ncols = ZDFAN.params->coltot[Gke]; - nlinks = virtpi[Gb]; - - eb = Dints.col_offset[Gij][Ge]; - ke = ZDFAN.row_offset[Gke][K]; - ZDFAN.matrix[Gke] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDFAN, Gke, ke, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(Dints.matrix[Gij][ij][eb]), nlinks, - W2[Gb][0], ncols, 1.0, ZDFAN.matrix[Gke][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDFAN, Gke, ke, nrows); - global_dpd_->free_dpd_block(ZDFAN.matrix[Gke], nrows, ncols); - } - - } /* k */ - } /* j */ - } /* i */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); - } - for(Gb=0; Gb < nirreps; Gb++) { - Gca = Gb ^ Gijk; /* totally symmtric */ - global_dpd_->free_dpd_block(W2[Gb], virtpi[Gb], F.params->coltot[Gca]); - } - - } /* Gk */ - } /* Gj */ - } /* Gi */ - - free(W1); - free(W2); - - global_dpd_->buf4_close(&E); - global_dpd_->buf4_close(&F); - global_dpd_->buf4_close(&T2); - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fAB); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZIFLN, h); - global_dpd_->buf4_mat_irrep_close(&ZIFLN, h); - } - global_dpd_->buf4_close(&ZIFLN); - - global_dpd_->buf4_close(&ZDFAN); - - for(h=0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&Dints, h); - global_dpd_->buf4_close(&Dints); +void cc3_t3z_RHF_AAA(void) { + int h, nirreps; + int *occ_off, *occpi; + int *vir_off, *virtpi; + int Gi, Gj, Gk, Gijk; + int Ga, Gb, Gc, Gab; + int i, j, k, I, J, K; + int a, b, c, A, B, C; + int ab; + double ***W1, ***W2; + dpdbuf4 T2, E, F; + dpdfile2 fIJ, fAB; + dpdbuf4 ZIFLN, ZDFAN; + dpdbuf4 Dints; + int Gm, Gmj, Gmc, mj, mc; + int m, M, ik; + int nrows, ncols, nlinks; + double *Z; + int Gij, ij, Gca, ca, Ge, Gke, ke; + int EE, e, eb; + + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + occ_off = moinfo.occ_off; + virtpi = moinfo.virtpi; + vir_off = moinfo.vir_off; + + global_dpd_->buf4_init(&ZIFLN, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&ZIFLN, h); + } + + global_dpd_->buf4_init(&ZDFAN, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDFAN (NA,FD)"); + global_dpd_->buf4_scm(&ZDFAN, 0.0); + + global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&Dints, h); + global_dpd_->buf4_mat_irrep_rd(&Dints, h); + } + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&F, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); + global_dpd_->buf4_init(&E, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); + + /* target T3 amplitudes go in here */ + W1 = (double ***)malloc(nirreps * sizeof(double **)); + W2 = (double ***)malloc(nirreps * sizeof(double **)); + + for (Gi = 0; Gi < nirreps; Gi++) { + for (Gj = 0; Gj < nirreps; Gj++) { + Gij = Gi ^ Gj; + for (Gk = 0; Gk < nirreps; Gk++) { + Gijk = Gi ^ Gj ^ Gk; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + W1[Gab] = global_dpd_->dpd_block_matrix(F.params->coltot[Gab], virtpi[Gc]); + } + for (Gb = 0; Gb < nirreps; Gb++) { + Gca = Gb ^ Gijk; /* totally symmtric */ + W2[Gb] = global_dpd_->dpd_block_matrix(virtpi[Gb], F.params->coltot[Gca]); + } + + for (i = 0; i < occpi[Gi]; i++) { + I = occ_off[Gi] + i; + for (j = 0; j < occpi[Gj]; j++) { + J = occ_off[Gj] + j; + for (k = 0; k < occpi[Gk]; k++) { + K = occ_off[Gk] + k; + + global_dpd_->T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2, &F, &E, &fIJ, &fAB, occpi, + occ_off, virtpi, vir_off, 0.0); + + /* Z_MCIK <-- 1/2 t_IJKABC */ + + ik = ZIFLN.params->colidx[I][K]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gab = Gmj = Gm ^ Gj; /* totally symmetric? */ + Gc = Gab ^ Gijk; /* totally symmetric? */ + Gmc = Gm ^ Gc; + + nrows = Dints.params->coltot[Gmj]; + ncols = virtpi[Gc]; + Z = init_array(ncols); + + if (nrows && ncols) { + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = Dints.params->rowidx[M][J]; + C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, Dints.matrix[Gmj][mj], 1, + 0.0, Z, 1); + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + mc = ZIFLN.params->rowidx[M][C]; + ZIFLN.matrix[Gmc][mc][ik] += Z[c]; + } + } + } + free(Z); + } + + /* Z_ACEK (KE,CA) <-- -1/2 t_IJKABC */ + + ij = Dints.params->rowidx[I][J]; + /* sort W(AB,C) to W(B,CA) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < F.params->coltot[Gab]; ab++) { + A = F.params->colorb[Gab][ab][0]; + B = F.params->colorb[Gab][ab][1]; + Gb = F.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = F.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Ge = 0; Ge < nirreps; Ge++) { + Gb = Ge ^ Gij; /* totally symmetric */ + Gca = Gke = Gk ^ Ge; /* totally symmetric */ + + nrows = virtpi[Ge]; + ncols = ZDFAN.params->coltot[Gke]; + nlinks = virtpi[Gb]; + + eb = Dints.col_offset[Gij][Ge]; + ke = ZDFAN.row_offset[Gke][K]; + ZDFAN.matrix[Gke] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDFAN, Gke, ke, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(Dints.matrix[Gij][ij][eb]), nlinks, + W2[Gb][0], ncols, 1.0, ZDFAN.matrix[Gke][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDFAN, Gke, ke, nrows); + global_dpd_->free_dpd_block(ZDFAN.matrix[Gke], nrows, ncols); + } + + } /* k */ + } /* j */ + } /* i */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W1[Gab], F.params->coltot[Gab], virtpi[Gc]); + } + for (Gb = 0; Gb < nirreps; Gb++) { + Gca = Gb ^ Gijk; /* totally symmtric */ + global_dpd_->free_dpd_block(W2[Gb], virtpi[Gb], F.params->coltot[Gca]); + } + + } /* Gk */ + } /* Gj */ + } /* Gi */ + + free(W1); + free(W2); + + global_dpd_->buf4_close(&E); + global_dpd_->buf4_close(&F); + global_dpd_->buf4_close(&T2); + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fAB); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZIFLN, h); + global_dpd_->buf4_mat_irrep_close(&ZIFLN, h); + } + global_dpd_->buf4_close(&ZIFLN); + + global_dpd_->buf4_close(&ZDFAN); + + for (h = 0; h < nirreps; h++) global_dpd_->buf4_mat_irrep_close(&Dints, h); + global_dpd_->buf4_close(&Dints); } -void cc3_t3z_RHF_AAB(void) -{ - int h, nirreps; - int *occ_off, *occpi; - int *vir_off, *virtpi; - int Gi, Gj, Gk, Gijk; - int Ga, Gb, Gc, Gab; - int i, j, k, I, J, K; - int a, b, c, A, B, C; - int ab; - double ***W1, ***W2; - dpdbuf4 T2AA, T2AB, T2BA, EAA, EAB, EBA, FAA, FAB, FBA; - dpdfile2 fIJ, fAB, fij, fab; - dpdbuf4 Dints, DAAints; - dpdbuf4 ZIFLN , ZIfLn, ZDFAN, ZDfAn; - int ji, kj; - int Gbc, Gca, bc, ca; - int Gmk, Gmi, mk, mi, Gma, ma, Gmb, mb; - int Gm, m, M; - double *Z; - int nrows, ncols, nlinks; - int Gik, ik, Gki, ki; - int ba, Ge, Gje, ec, je, ea; - int Gmj, mj, Gmc, mc; - int Gij, ij, Gke, ke, eb; - - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; - occ_off = moinfo.occ_off; - virtpi = moinfo.virtpi; - vir_off = moinfo.vir_off; - - global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_init(&DAAints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&Dints, h); - global_dpd_->buf4_mat_irrep_rd(&Dints, h); - - global_dpd_->buf4_mat_irrep_init(&DAAints, h); - global_dpd_->buf4_mat_irrep_rd(&DAAints, h); - } - - global_dpd_->buf4_init(&ZIFLN, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); - global_dpd_->buf4_init(&ZIfLn, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIfLn"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&ZIFLN, h); - global_dpd_->buf4_mat_irrep_rd(&ZIFLN, h); - - global_dpd_->buf4_mat_irrep_init(&ZIfLn, h); - } - - global_dpd_->buf4_init(&ZDFAN, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDFAN (NA,FD)"); - global_dpd_->buf4_init(&ZDfAn, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDfAn (nA,fD)"); - global_dpd_->buf4_scm(&ZDfAn, 0.0); - - global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); - global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); - - global_dpd_->buf4_init(&T2AA, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_init(&T2BA, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); - global_dpd_->buf4_init(&FAA, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); - global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); - global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); - global_dpd_->buf4_init(&EAA, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); - global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); - global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); - - /* target T3 amplitudes go in here */ - W1 = (double ***) malloc(nirreps * sizeof(double **)); - W2 = (double ***) malloc(nirreps * sizeof(double **)); - - for(Gi=0; Gi < nirreps; Gi++) { - for(Gj=0; Gj < nirreps; Gj++) { - Gij = Gi ^ Gj; - for(Gk=0; Gk < nirreps; Gk++) { - Gijk = Gi ^ Gj ^ Gk; - Gik = Gki = Gi ^ Gk; - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmtric */ - W1[Gab] = global_dpd_->dpd_block_matrix(FAA.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gbc = Ga ^ Gijk; /* totally symmtric */ - W2[Ga] = global_dpd_->dpd_block_matrix(virtpi[Ga], FAA.params->coltot[Gbc]); - } - - for(i=0; i < occpi[Gi]; i++) { - I = occ_off[Gi] + i; - for(j=0; j < occpi[Gj]; j++) { - J = occ_off[Gj] + j; - for(k=0; k < occpi[Gk]; k++) { - K = occ_off[Gk] + k; - - global_dpd_->T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2AA, &T2AB, &T2BA, - &FAA, &FAB, &FBA, &EAA, &EAB, &EBA, &fIJ, &fij, &fAB, &fab, - occpi, occ_off, occpi, occ_off, virtpi, vir_off, virtpi, vir_off, 0.0); - - /* Z_MAJI <-- t_ABcIJk */ - ji = ZIFLN.params->colidx[J][I]; - /* sort W(AB,c) --> W(A,Bc) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - Gb = FAA.params->ssym[B]; - a = A - vir_off[Ga]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = FAA.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - for(Gm=0; Gm < nirreps; Gm++) { - Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ - Ga = Gbc ^ Gijk; /* totally symmetric */ - Gma = Gm ^ Ga; - - nrows = virtpi[Ga]; - ncols = Dints.params->coltot[Gmk]; - - Z = init_array(nrows); - - if(nrows && ncols) { - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mk = Dints.params->rowidx[M][K]; - C_DGEMV('n', nrows, ncols, 1.0, W2[Ga][0], ncols, Dints.matrix[Gmk][mk], 1, 0.0, Z, 1); - for(a=0; a < virtpi[Ga]; a++) { - A = vir_off[Ga] + a; - ma = ZIFLN.params->rowidx[M][A]; - ZIFLN.matrix[Gma][ma][ji] += Z[a]; - } - } - } - - free(Z); - } - - /* ZMbKj <-- t_ijKabC */ - kj = ZIfLn.params->colidx[K][J]; - /* sort W(ab,C) to W(b,Ca) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - Gb = FAA.params->ssym[B]; - a = A - vir_off[Ga]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = FAA.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Gm=0; Gm < nirreps; Gm++) { - Gca = Gmi = Gm ^ Gi; /* totally symmetric */ - Gb = Gca ^ Gijk; /* totally symmetric */ - Gmb = Gm ^ Gb; - - nrows = virtpi[Gb]; - ncols = Dints.params->coltot[Gmi]; - - Z = init_array(nrows); - - if(nrows && ncols) { - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mi = Dints.params->rowidx[M][I]; - C_DGEMV('n', nrows, ncols, 1.0, W2[Gb][0], ncols, Dints.matrix[Gmi][mi], 1, 0.0, Z, 1); - for(b=0; b < virtpi[Gb]; b++) { - B = vir_off[Gb] + b; - mb = ZIfLn.params->rowidx[M][B]; - ZIfLn.matrix[Gmb][mb][kj] += Z[b]; - } - } - } - - free(Z); - } - - /* Z_McIk <-- 1/2 t_IJkABc */ - ik = ZIfLn.params->colidx[I][K]; - - for(Gm=0; Gm < nirreps; Gm++) { - - Gab = Gmj = Gm ^ Gj; /* totally symmetric */ - Gc = Gab ^ Gijk; /* totally symmetric */ - Gmc = Gm ^ Gc; - - nrows = DAAints.params->coltot[Gmj]; - ncols = virtpi[Gc]; - Z = init_array(ncols); - - if(nrows && ncols) { - for(m=0; m < occpi[Gm]; m++) { - M = occ_off[Gm] + m; - mj = DAAints.params->rowidx[M][J]; - C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, DAAints.matrix[Gmj][mj], 1, 0.0, Z, 1); - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - mc = ZIfLn.params->rowidx[M][C]; - ZIfLn.matrix[Gmc][mc][ik] += Z[c]; - } - } - } - free(Z); - } - - /* Z_ABEJ (JE,BA) <-- - t_IJkABc */ - ik = Dints.params->rowidx[I][K]; - /* sort W(AB,c) to W(c,BA) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - ba = FAA.params->colidx[B][A]; - for(c=0; c < virtpi[Gc]; c++) { - W2[Gc][c][ba] = W1[Gab][ab][c]; - } - } - } - - for(Ge=0; Ge < nirreps; Ge++) { - Gc = Gik ^ Ge; /* totally symmetric */ - Gje = Gj ^ Ge; - - nrows = virtpi[Ge]; - ncols = ZDFAN.params->coltot[Gje]; - nlinks = virtpi[Gc]; - - ec = Dints.col_offset[Gik][Ge]; - je = ZDFAN.row_offset[Gje][J]; - ZDFAN.matrix[Gje] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDFAN, Gje, je, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, -1.0, &(Dints.matrix[Gik][ik][ec]), nlinks, - W2[Gc][0], ncols, 1.0, ZDFAN.matrix[Gje][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDFAN, Gje, je, nrows); - global_dpd_->free_dpd_block(ZDFAN.matrix[Gje], nrows, ncols); - } - - /* Z_CbEj <-- - t_ijKabC */ - ki = Dints.params->rowidx[K][I]; - /* sort W(ab,C) to W(a,bC) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Ga = FAA.params->rsym[A]; - a = A - vir_off[Ga]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - bc = FAA.params->colidx[B][C]; - W2[Ga][a][bc] = W1[Gab][ab][c]; - } - } - } - - for(Ge=0; Ge < nirreps; Ge++) { - Ga = Ge ^ Gki; /* totally symmetric */ - Gje = Gj ^ Ge; - - nrows = virtpi[Ge]; - ncols = ZDfAn.params->coltot[Gje]; - nlinks = virtpi[Ga]; - - ea = Dints.col_offset[Gki][Ge]; - je = ZDfAn.row_offset[Gje][J]; - ZDfAn.matrix[Gje] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDfAn, Gje, je, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, -1.0, &(Dints.matrix[Gki][ki][ea]), nlinks, - W2[Ga][0], ncols, 1.0, ZDfAn.matrix[Gje][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDfAn, Gje, je, nrows); - global_dpd_->free_dpd_block(ZDfAn.matrix[Gje], nrows, ncols); - } - - /* Z_AcEk <-- -1/2 t_IJkABc */ - ij = DAAints.params->rowidx[I][J]; - /* sort W(AB,C) to W(B,CA) */ - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - for(ab=0; ab < FAA.params->coltot[Gab]; ab++) { - A = FAA.params->colorb[Gab][ab][0]; - B = FAA.params->colorb[Gab][ab][1]; - Gb = FAA.params->ssym[B]; - b = B - vir_off[Gb]; - for(c=0; c < virtpi[Gc]; c++) { - C = vir_off[Gc] + c; - ca = FAA.params->colidx[C][A]; - W2[Gb][b][ca] = W1[Gab][ab][c]; - } - } - } - - for(Ge=0; Ge < nirreps; Ge++) { - Gb = Ge ^ Gij; /* totally symmetric */ - Gca = Gke = Gk ^ Ge; /* totally symmetric */ - - nrows = virtpi[Ge]; - ncols = ZDfAn.params->coltot[Gke]; - nlinks = virtpi[Gb]; - - eb = DAAints.col_offset[Gij][Ge]; - ke = ZDfAn.row_offset[Gke][K]; - ZDfAn.matrix[Gke] = global_dpd_->dpd_block_matrix(nrows, ncols); - global_dpd_->buf4_mat_irrep_rd_block(&ZDfAn, Gke, ke, nrows); - - if(nrows && ncols && nlinks) - C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(DAAints.matrix[Gij][ij][eb]), nlinks, - W2[Gb][0], ncols, 1.0, ZDfAn.matrix[Gke][0], ncols); - - global_dpd_->buf4_mat_irrep_wrt_block(&ZDfAn, Gke, ke, nrows); - global_dpd_->free_dpd_block(ZDfAn.matrix[Gke], nrows, ncols); - } - - } /* k */ - } /* j */ - } /* i */ - - for(Gab=0; Gab < nirreps; Gab++) { - Gc = Gab ^ Gijk; /* totally symmetric */ - global_dpd_->free_dpd_block(W1[Gab], FAA.params->coltot[Gab], virtpi[Gc]); - } - for(Ga=0; Ga < nirreps; Ga++) { - Gbc = Ga ^ Gijk; /* totally symmtric */ - global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], FAA.params->coltot[Gbc]); - } - - } /* Gk */ - } /* Gj */ - } /* Gi */ - - free(W1); - free(W2); - - global_dpd_->buf4_close(&EAA); - global_dpd_->buf4_close(&EAB); - global_dpd_->buf4_close(&EBA); - global_dpd_->buf4_close(&FAA); - global_dpd_->buf4_close(&FAB); - global_dpd_->buf4_close(&FBA); - global_dpd_->buf4_close(&T2AA); - global_dpd_->buf4_close(&T2AB); - global_dpd_->buf4_close(&T2BA); - global_dpd_->file2_close(&fIJ); - global_dpd_->file2_close(&fAB); - global_dpd_->file2_close(&fij); - global_dpd_->file2_close(&fab); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_wrt(&ZIFLN, h); - global_dpd_->buf4_mat_irrep_close(&ZIFLN, h); - - global_dpd_->buf4_mat_irrep_wrt(&ZIfLn, h); - global_dpd_->buf4_mat_irrep_close(&ZIfLn, h); - } - global_dpd_->buf4_close(&ZIFLN); - global_dpd_->buf4_close(&ZIfLn); - - global_dpd_->buf4_sort(&ZDFAN, PSIF_CC3_MISC, qpsr, 11, 5, "CC3 ZDFAN (AN,DF)"); - global_dpd_->buf4_close(&ZDFAN); - global_dpd_->buf4_sort(&ZDfAn, PSIF_CC3_MISC, qpsr, 11, 5, "CC3 ZDfAn (An,Df)"); - global_dpd_->buf4_close(&ZDfAn); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_close(&Dints, h); - global_dpd_->buf4_mat_irrep_close(&DAAints, h); - } - global_dpd_->buf4_close(&Dints); - global_dpd_->buf4_close(&DAAints); +void cc3_t3z_RHF_AAB(void) { + int h, nirreps; + int *occ_off, *occpi; + int *vir_off, *virtpi; + int Gi, Gj, Gk, Gijk; + int Ga, Gb, Gc, Gab; + int i, j, k, I, J, K; + int a, b, c, A, B, C; + int ab; + double ***W1, ***W2; + dpdbuf4 T2AA, T2AB, T2BA, EAA, EAB, EBA, FAA, FAB, FBA; + dpdfile2 fIJ, fAB, fij, fab; + dpdbuf4 Dints, DAAints; + dpdbuf4 ZIFLN, ZIfLn, ZDFAN, ZDfAn; + int ji, kj; + int Gbc, Gca, bc, ca; + int Gmk, Gmi, mk, mi, Gma, ma, Gmb, mb; + int Gm, m, M; + double *Z; + int nrows, ncols, nlinks; + int Gik, ik, Gki, ki; + int ba, Ge, Gje, ec, je, ea; + int Gmj, mj, Gmc, mc; + int Gij, ij, Gke, ke, eb; + + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + occ_off = moinfo.occ_off; + virtpi = moinfo.virtpi; + vir_off = moinfo.vir_off; + + global_dpd_->buf4_init(&Dints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_init(&DAAints, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&Dints, h); + global_dpd_->buf4_mat_irrep_rd(&Dints, h); + + global_dpd_->buf4_mat_irrep_init(&DAAints, h); + global_dpd_->buf4_mat_irrep_rd(&DAAints, h); + } + + global_dpd_->buf4_init(&ZIFLN, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIFLN"); + global_dpd_->buf4_init(&ZIfLn, PSIF_CC3_MISC, 0, 10, 0, 10, 0, 0, "CC3 ZIfLn"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&ZIFLN, h); + global_dpd_->buf4_mat_irrep_rd(&ZIFLN, h); + + global_dpd_->buf4_mat_irrep_init(&ZIfLn, h); + } + + global_dpd_->buf4_init(&ZDFAN, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDFAN (NA,FD)"); + global_dpd_->buf4_init(&ZDfAn, PSIF_CC3_MISC, 0, 10, 5, 10, 5, 0, "CC3 ZDfAn (nA,fD)"); + global_dpd_->buf4_scm(&ZDfAn, 0.0); + + global_dpd_->file2_init(&fIJ, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_init(&fAB, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_init(&fij, PSIF_CC_OEI, 0, 0, 0, "fij"); + global_dpd_->file2_init(&fab, PSIF_CC_OEI, 0, 1, 1, "fab"); + + global_dpd_->buf4_init(&T2AA, PSIF_CC_TAMPS, 0, 0, 5, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_init(&T2AB, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_init(&T2BA, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tiJaB"); + global_dpd_->buf4_init(&FAA, PSIF_CC3_HET1, 0, 10, 5, 10, 7, 0, "CC3 WABEI (IE,B>A)"); + global_dpd_->buf4_init(&FAB, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WaBeI (Ie,Ba)"); + global_dpd_->buf4_init(&FBA, PSIF_CC3_HET1, 0, 10, 5, 10, 5, 0, "CC3 WAbEi (iE,bA)"); + global_dpd_->buf4_init(&EAA, PSIF_CC3_HET1, 0, 0, 10, 2, 10, 0, "CC3 WMBIJ (I>J,MB)"); + global_dpd_->buf4_init(&EAB, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WMbIj (Ij,Mb)"); + global_dpd_->buf4_init(&EBA, PSIF_CC3_HET1, 0, 0, 10, 0, 10, 0, "CC3 WmBiJ (iJ,mB)"); + + /* target T3 amplitudes go in here */ + W1 = (double ***)malloc(nirreps * sizeof(double **)); + W2 = (double ***)malloc(nirreps * sizeof(double **)); + + for (Gi = 0; Gi < nirreps; Gi++) { + for (Gj = 0; Gj < nirreps; Gj++) { + Gij = Gi ^ Gj; + for (Gk = 0; Gk < nirreps; Gk++) { + Gijk = Gi ^ Gj ^ Gk; + Gik = Gki = Gi ^ Gk; + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmtric */ + W1[Gab] = global_dpd_->dpd_block_matrix(FAA.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gbc = Ga ^ Gijk; /* totally symmtric */ + W2[Ga] = global_dpd_->dpd_block_matrix(virtpi[Ga], FAA.params->coltot[Gbc]); + } + + for (i = 0; i < occpi[Gi]; i++) { + I = occ_off[Gi] + i; + for (j = 0; j < occpi[Gj]; j++) { + J = occ_off[Gj] + j; + for (k = 0; k < occpi[Gk]; k++) { + K = occ_off[Gk] + k; + + global_dpd_->T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, &T2AA, &T2AB, &T2BA, &FAA, &FAB, &FBA, + &EAA, &EAB, &EBA, &fIJ, &fij, &fAB, &fab, occpi, occ_off, occpi, + occ_off, virtpi, vir_off, virtpi, vir_off, 0.0); + + /* Z_MAJI <-- t_ABcIJk */ + ji = ZIFLN.params->colidx[J][I]; + /* sort W(AB,c) --> W(A,Bc) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + Gb = FAA.params->ssym[B]; + a = A - vir_off[Ga]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = FAA.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + for (Gm = 0; Gm < nirreps; Gm++) { + Gbc = Gmk = Gm ^ Gk; /* totally symmetric */ + Ga = Gbc ^ Gijk; /* totally symmetric */ + Gma = Gm ^ Ga; + + nrows = virtpi[Ga]; + ncols = Dints.params->coltot[Gmk]; + + Z = init_array(nrows); + + if (nrows && ncols) { + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mk = Dints.params->rowidx[M][K]; + C_DGEMV('n', nrows, ncols, 1.0, W2[Ga][0], ncols, Dints.matrix[Gmk][mk], 1, 0.0, + Z, 1); + for (a = 0; a < virtpi[Ga]; a++) { + A = vir_off[Ga] + a; + ma = ZIFLN.params->rowidx[M][A]; + ZIFLN.matrix[Gma][ma][ji] += Z[a]; + } + } + } + + free(Z); + } + + /* ZMbKj <-- t_ijKabC */ + kj = ZIfLn.params->colidx[K][J]; + /* sort W(ab,C) to W(b,Ca) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + Gb = FAA.params->ssym[B]; + a = A - vir_off[Ga]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = FAA.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Gm = 0; Gm < nirreps; Gm++) { + Gca = Gmi = Gm ^ Gi; /* totally symmetric */ + Gb = Gca ^ Gijk; /* totally symmetric */ + Gmb = Gm ^ Gb; + + nrows = virtpi[Gb]; + ncols = Dints.params->coltot[Gmi]; + + Z = init_array(nrows); + + if (nrows && ncols) { + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mi = Dints.params->rowidx[M][I]; + C_DGEMV('n', nrows, ncols, 1.0, W2[Gb][0], ncols, Dints.matrix[Gmi][mi], 1, 0.0, + Z, 1); + for (b = 0; b < virtpi[Gb]; b++) { + B = vir_off[Gb] + b; + mb = ZIfLn.params->rowidx[M][B]; + ZIfLn.matrix[Gmb][mb][kj] += Z[b]; + } + } + } + + free(Z); + } + + /* Z_McIk <-- 1/2 t_IJkABc */ + ik = ZIfLn.params->colidx[I][K]; + + for (Gm = 0; Gm < nirreps; Gm++) { + Gab = Gmj = Gm ^ Gj; /* totally symmetric */ + Gc = Gab ^ Gijk; /* totally symmetric */ + Gmc = Gm ^ Gc; + + nrows = DAAints.params->coltot[Gmj]; + ncols = virtpi[Gc]; + Z = init_array(ncols); + + if (nrows && ncols) { + for (m = 0; m < occpi[Gm]; m++) { + M = occ_off[Gm] + m; + mj = DAAints.params->rowidx[M][J]; + C_DGEMV('t', nrows, ncols, 0.5, W1[Gab][0], ncols, DAAints.matrix[Gmj][mj], 1, + 0.0, Z, 1); + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + mc = ZIfLn.params->rowidx[M][C]; + ZIfLn.matrix[Gmc][mc][ik] += Z[c]; + } + } + } + free(Z); + } + + /* Z_ABEJ (JE,BA) <-- - t_IJkABc */ + ik = Dints.params->rowidx[I][K]; + /* sort W(AB,c) to W(c,BA) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + ba = FAA.params->colidx[B][A]; + for (c = 0; c < virtpi[Gc]; c++) { + W2[Gc][c][ba] = W1[Gab][ab][c]; + } + } + } + + for (Ge = 0; Ge < nirreps; Ge++) { + Gc = Gik ^ Ge; /* totally symmetric */ + Gje = Gj ^ Ge; + + nrows = virtpi[Ge]; + ncols = ZDFAN.params->coltot[Gje]; + nlinks = virtpi[Gc]; + + ec = Dints.col_offset[Gik][Ge]; + je = ZDFAN.row_offset[Gje][J]; + ZDFAN.matrix[Gje] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDFAN, Gje, je, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, -1.0, &(Dints.matrix[Gik][ik][ec]), nlinks, + W2[Gc][0], ncols, 1.0, ZDFAN.matrix[Gje][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDFAN, Gje, je, nrows); + global_dpd_->free_dpd_block(ZDFAN.matrix[Gje], nrows, ncols); + } + + /* Z_CbEj <-- - t_ijKabC */ + ki = Dints.params->rowidx[K][I]; + /* sort W(ab,C) to W(a,bC) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Ga = FAA.params->rsym[A]; + a = A - vir_off[Ga]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + bc = FAA.params->colidx[B][C]; + W2[Ga][a][bc] = W1[Gab][ab][c]; + } + } + } + + for (Ge = 0; Ge < nirreps; Ge++) { + Ga = Ge ^ Gki; /* totally symmetric */ + Gje = Gj ^ Ge; + + nrows = virtpi[Ge]; + ncols = ZDfAn.params->coltot[Gje]; + nlinks = virtpi[Ga]; + + ea = Dints.col_offset[Gki][Ge]; + je = ZDfAn.row_offset[Gje][J]; + ZDfAn.matrix[Gje] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDfAn, Gje, je, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, -1.0, &(Dints.matrix[Gki][ki][ea]), nlinks, + W2[Ga][0], ncols, 1.0, ZDfAn.matrix[Gje][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDfAn, Gje, je, nrows); + global_dpd_->free_dpd_block(ZDfAn.matrix[Gje], nrows, ncols); + } + + /* Z_AcEk <-- -1/2 t_IJkABc */ + ij = DAAints.params->rowidx[I][J]; + /* sort W(AB,C) to W(B,CA) */ + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + for (ab = 0; ab < FAA.params->coltot[Gab]; ab++) { + A = FAA.params->colorb[Gab][ab][0]; + B = FAA.params->colorb[Gab][ab][1]; + Gb = FAA.params->ssym[B]; + b = B - vir_off[Gb]; + for (c = 0; c < virtpi[Gc]; c++) { + C = vir_off[Gc] + c; + ca = FAA.params->colidx[C][A]; + W2[Gb][b][ca] = W1[Gab][ab][c]; + } + } + } + + for (Ge = 0; Ge < nirreps; Ge++) { + Gb = Ge ^ Gij; /* totally symmetric */ + Gca = Gke = Gk ^ Ge; /* totally symmetric */ + + nrows = virtpi[Ge]; + ncols = ZDfAn.params->coltot[Gke]; + nlinks = virtpi[Gb]; + + eb = DAAints.col_offset[Gij][Ge]; + ke = ZDfAn.row_offset[Gke][K]; + ZDfAn.matrix[Gke] = global_dpd_->dpd_block_matrix(nrows, ncols); + global_dpd_->buf4_mat_irrep_rd_block(&ZDfAn, Gke, ke, nrows); + + if (nrows && ncols && nlinks) + C_DGEMM('n', 'n', nrows, ncols, nlinks, -0.5, &(DAAints.matrix[Gij][ij][eb]), + nlinks, W2[Gb][0], ncols, 1.0, ZDfAn.matrix[Gke][0], ncols); + + global_dpd_->buf4_mat_irrep_wrt_block(&ZDfAn, Gke, ke, nrows); + global_dpd_->free_dpd_block(ZDfAn.matrix[Gke], nrows, ncols); + } + + } /* k */ + } /* j */ + } /* i */ + + for (Gab = 0; Gab < nirreps; Gab++) { + Gc = Gab ^ Gijk; /* totally symmetric */ + global_dpd_->free_dpd_block(W1[Gab], FAA.params->coltot[Gab], virtpi[Gc]); + } + for (Ga = 0; Ga < nirreps; Ga++) { + Gbc = Ga ^ Gijk; /* totally symmtric */ + global_dpd_->free_dpd_block(W2[Ga], virtpi[Ga], FAA.params->coltot[Gbc]); + } + + } /* Gk */ + } /* Gj */ + } /* Gi */ + + free(W1); + free(W2); + + global_dpd_->buf4_close(&EAA); + global_dpd_->buf4_close(&EAB); + global_dpd_->buf4_close(&EBA); + global_dpd_->buf4_close(&FAA); + global_dpd_->buf4_close(&FAB); + global_dpd_->buf4_close(&FBA); + global_dpd_->buf4_close(&T2AA); + global_dpd_->buf4_close(&T2AB); + global_dpd_->buf4_close(&T2BA); + global_dpd_->file2_close(&fIJ); + global_dpd_->file2_close(&fAB); + global_dpd_->file2_close(&fij); + global_dpd_->file2_close(&fab); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_wrt(&ZIFLN, h); + global_dpd_->buf4_mat_irrep_close(&ZIFLN, h); + + global_dpd_->buf4_mat_irrep_wrt(&ZIfLn, h); + global_dpd_->buf4_mat_irrep_close(&ZIfLn, h); + } + global_dpd_->buf4_close(&ZIFLN); + global_dpd_->buf4_close(&ZIfLn); + + global_dpd_->buf4_sort(&ZDFAN, PSIF_CC3_MISC, qpsr, 11, 5, "CC3 ZDFAN (AN,DF)"); + global_dpd_->buf4_close(&ZDFAN); + global_dpd_->buf4_sort(&ZDfAn, PSIF_CC3_MISC, qpsr, 11, 5, "CC3 ZDfAn (An,Df)"); + global_dpd_->buf4_close(&ZDfAn); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_close(&Dints, h); + global_dpd_->buf4_mat_irrep_close(&DAAints, h); + } + global_dpd_->buf4_close(&Dints); + global_dpd_->buf4_close(&DAAints); } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cclambda.cc b/psi4/src/psi4/cclambda/cclambda.cc index de556c06b39..72a831ff19c 100644 --- a/psi4/src/psi4/cclambda/cclambda.cc +++ b/psi4/src/psi4/cclambda/cclambda.cc @@ -56,7 +56,8 @@ #include #include -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { double pseudoenergy(struct L_Params L_params); void G_build(int L_irr); @@ -90,42 +91,37 @@ void cc3_t3x(void); void cc3_l3l2(void); void cc3_l3l1(void); -}} //namespace psi::cclambda +} // namespace cclambda +} // namespace psi // Forward declaration to call cctriples -namespace psi { namespace cctriples { +namespace psi { +namespace cctriples { PsiReturnType cctriples(std::shared_ptr ref_wfn, Options &options); -}} +} +} // namespace psi -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -CCLambdaWavefunction::CCLambdaWavefunction(std::shared_ptr -reference_wavefunction, Options &options) - : CCEnergyWavefunction(reference_wavefunction, options) -{ +CCLambdaWavefunction::CCLambdaWavefunction(std::shared_ptr reference_wavefunction, Options &options) + : CCEnergyWavefunction(reference_wavefunction, options) { psio_ = _default_psio_lib_; init(); } -CCLambdaWavefunction::~CCLambdaWavefunction() -{ +CCLambdaWavefunction::~CCLambdaWavefunction() {} -} +void CCLambdaWavefunction::init() { shallow_copy(reference_wavefunction_); } -void CCLambdaWavefunction::init() -{ - shallow_copy(reference_wavefunction_); -} - -double CCLambdaWavefunction::compute_energy() -{ +double CCLambdaWavefunction::compute_energy() { energy_ = 0.0; - int done=0, i, root_L_irr; + int done = 0, i, root_L_irr; int **cachelist, *cachefiles; init_io(); title(); - moinfo.iter=0; + moinfo.iter = 0; get_moinfo(reference_wavefunction_); get_params(options_); @@ -133,452 +129,440 @@ double CCLambdaWavefunction::compute_energy() /* Do this only if we're not running an analytic gradient on the ground state. Keeping the files around should allow us to restart from old Lambda amplitudes. -TDC, 11/2007 */ - if(!(params.dertype==1 && !cc_excited(params.wfn))) { - outfile->Printf( "\tDeleting old CC_LAMBDA data.\n"); - psio_close(PSIF_CC_LAMBDA,0); - psio_open(PSIF_CC_LAMBDA,PSIO_OPEN_NEW); - psio_close(PSIF_CC_DENOM,0); - psio_open(PSIF_CC_DENOM,PSIO_OPEN_NEW); + if (!(params.dertype == 1 && !cc_excited(params.wfn))) { + outfile->Printf("\tDeleting old CC_LAMBDA data.\n"); + psio_close(PSIF_CC_LAMBDA, 0); + psio_open(PSIF_CC_LAMBDA, PSIO_OPEN_NEW); + psio_close(PSIF_CC_DENOM, 0); + psio_open(PSIF_CC_DENOM, PSIO_OPEN_NEW); } cachefiles = init_int_array(PSIO_MAXUNIT); - if(params.ref == 0 || params.ref == 1) { /** RHF or ROHF **/ - - cachelist = cacheprep_rhf(params.cachelev, cachefiles); - - std::vector spaces; - spaces.push_back(moinfo.occpi); - spaces.push_back(moinfo.occ_sym); - spaces.push_back(moinfo.virtpi); - spaces.push_back(moinfo.vir_sym); - dpd_init(0, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 2, spaces); - - if(params.aobasis) { /* Set up new DPD for AO-basis algorithm */ - std::vector aospaces; - aospaces.push_back(moinfo.occpi); - aospaces.push_back(moinfo.occ_sym); - aospaces.push_back(moinfo.sopi); - aospaces.push_back(moinfo.sosym); - dpd_init(1, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 2, aospaces); - dpd_set_default(0); - } + if (params.ref == 0 || params.ref == 1) { /** RHF or ROHF **/ + + cachelist = cacheprep_rhf(params.cachelev, cachefiles); + + std::vector spaces; + spaces.push_back(moinfo.occpi); + spaces.push_back(moinfo.occ_sym); + spaces.push_back(moinfo.virtpi); + spaces.push_back(moinfo.vir_sym); + dpd_init(0, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 2, spaces); + + if (params.aobasis) { /* Set up new DPD for AO-basis algorithm */ + std::vector aospaces; + aospaces.push_back(moinfo.occpi); + aospaces.push_back(moinfo.occ_sym); + aospaces.push_back(moinfo.sopi); + aospaces.push_back(moinfo.sosym); + dpd_init(1, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 2, aospaces); + dpd_set_default(0); + } - } - else if(params.ref == 2) { /** UHF **/ - - cachelist = cacheprep_uhf(params.cachelev, cachefiles); - std::vector spaces; - spaces.push_back(moinfo.aoccpi); - spaces.push_back(moinfo.aocc_sym); - spaces.push_back(moinfo.avirtpi); - spaces.push_back(moinfo.avir_sym); - spaces.push_back(moinfo.boccpi); - spaces.push_back(moinfo.bocc_sym); - spaces.push_back(moinfo.bvirtpi); - spaces.push_back(moinfo.bvir_sym); - - dpd_init(0, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 4, spaces); - - if(params.aobasis) { /* Set up new DPD's for AO-basis algorithm */ - std::vector aospaces; - aospaces.push_back(moinfo.aoccpi); - aospaces.push_back(moinfo.aocc_sym); - aospaces.push_back(moinfo.sopi); - aospaces.push_back(moinfo.sosym); - aospaces.push_back(moinfo.boccpi); - aospaces.push_back(moinfo.bocc_sym); - aospaces.push_back(moinfo.sopi); - aospaces.push_back(moinfo.sosym); - dpd_init(1, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 4, aospaces); - dpd_set_default(0); - } + } else if (params.ref == 2) { /** UHF **/ + + cachelist = cacheprep_uhf(params.cachelev, cachefiles); + std::vector spaces; + spaces.push_back(moinfo.aoccpi); + spaces.push_back(moinfo.aocc_sym); + spaces.push_back(moinfo.avirtpi); + spaces.push_back(moinfo.avir_sym); + spaces.push_back(moinfo.boccpi); + spaces.push_back(moinfo.bocc_sym); + spaces.push_back(moinfo.bvirtpi); + spaces.push_back(moinfo.bvir_sym); + + dpd_init(0, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 4, spaces); + + if (params.aobasis) { /* Set up new DPD's for AO-basis algorithm */ + std::vector aospaces; + aospaces.push_back(moinfo.aoccpi); + aospaces.push_back(moinfo.aocc_sym); + aospaces.push_back(moinfo.sopi); + aospaces.push_back(moinfo.sosym); + aospaces.push_back(moinfo.boccpi); + aospaces.push_back(moinfo.bocc_sym); + aospaces.push_back(moinfo.sopi); + aospaces.push_back(moinfo.sosym); + dpd_init(1, moinfo.nirreps, params.memory, 0, cachefiles, cachelist, nullptr, 4, aospaces); + dpd_set_default(0); + } } - if(params.local) local_init(); + if (params.local) local_init(); - if(params.ref == 0) { - if (params.wfn == "CC2" || params.wfn == "EOM_CC2") - cc2_hbar_extra(); - else - hbar_extra(); + if (params.ref == 0) { + if (params.wfn == "CC2" || params.wfn == "EOM_CC2") + cc2_hbar_extra(); + else + hbar_extra(); } /* CC3: Z-build */ - if(params.wfn == "CC3") cc3_t3z(); - - for (i=0; iPrintf("\tSymmetry of left-hand state: %s\n", - moinfo.labels[ moinfo.sym^(pL_params[i].irrep) ].c_str()); - outfile->Printf("\tSymmetry of left-hand eigenvector: %s\n", - moinfo.labels[(pL_params[i].irrep)].c_str()); - - denom(pL_params[i]); /* uses L_params.cceom_energy for excited states */ - init_amps(pL_params[i]); /* uses denominators for initial zeta guess */ - - outfile->Printf( "\n\t Solving Lambda Equations\n"); - outfile->Printf( "\t ------------------------\n"); - outfile->Printf( "\tIter PseudoEnergy or Norm RMS \n"); - outfile->Printf( "\t---- --------------------- --------\n"); - - moinfo.lcc = pseudoenergy(pL_params[i]); - update(); - - for(moinfo.iter=1 ; moinfo.iter <= params.maxiter; moinfo.iter++) { - sort_amps(pL_params[i].irrep); + if (params.wfn == "CC3") cc3_t3z(); + + for (i = 0; i < params.nstates; ++i) { + /* delete and reopen intermediate files */ + psio_close(PSIF_CC_TMP, 0); + psio_close(PSIF_CC_TMP0, 0); + psio_close(PSIF_CC_TMP1, 0); + psio_close(PSIF_CC_TMP2, 0); + psio_open(PSIF_CC_TMP, 0); + psio_open(PSIF_CC_TMP0, 0); + psio_open(PSIF_CC_TMP1, 0); + psio_open(PSIF_CC_TMP2, 0); + /* Keep the old lambda amps if this is a ground-state geomopt */ + if (!(params.dertype == 1 && !cc_excited(params.wfn))) { + psio_close(PSIF_CC_LAMBDA, 0); + psio_open(PSIF_CC_LAMBDA, PSIO_OPEN_NEW); + psio_close(PSIF_CC_DENOM, 0); /* aren't these recomputed anyway - perhaps should always delete? */ + psio_open(PSIF_CC_DENOM, PSIO_OPEN_NEW); + } - /* must zero New L before adding RHS */ - L_zero(pL_params[i].irrep); + outfile->Printf("\tSymmetry of left-hand state: %s\n", + moinfo.labels[moinfo.sym ^ (pL_params[i].irrep)].c_str()); + outfile->Printf("\tSymmetry of left-hand eigenvector: %s\n", moinfo.labels[(pL_params[i].irrep)].c_str()); - if(params.wfn == "CC3") cc3_t3x(); + denom(pL_params[i]); /* uses L_params.cceom_energy for excited states */ + init_amps(pL_params[i]); /* uses denominators for initial zeta guess */ - if(params.wfn == "CC2" || params.wfn == "EOM_CC2") { + outfile->Printf("\n\t Solving Lambda Equations\n"); + outfile->Printf("\t ------------------------\n"); + outfile->Printf("\tIter PseudoEnergy or Norm RMS \n"); + outfile->Printf("\t---- --------------------- --------\n"); - cc2_Gai_build(pL_params[i].irrep); - cc2_L1_build(pL_params[i]); - if(params.print & 2) status("L1 amplitudes", "outfile"); - cc2_L2_build(pL_params[i]); + moinfo.lcc = pseudoenergy(pL_params[i]); + update(); + for (moinfo.iter = 1; moinfo.iter <= params.maxiter; moinfo.iter++) { + sort_amps(pL_params[i].irrep); + + /* must zero New L before adding RHS */ + L_zero(pL_params[i].irrep); + + if (params.wfn == "CC3") cc3_t3x(); + + if (params.wfn == "CC2" || params.wfn == "EOM_CC2") { + cc2_Gai_build(pL_params[i].irrep); + cc2_L1_build(pL_params[i]); + if (params.print & 2) status("L1 amplitudes", "outfile"); + cc2_L2_build(pL_params[i]); + + } else { + G_build(pL_params[i].irrep); + L1_build(pL_params[i]); + if (params.print & 2) status("L1 amplitudes", "outfile"); + L2_build(pL_params[i]); + + if (params.wfn == "CC3") { + cc3_l3l2(); + cc3_l3l1(); + } + } + + if (params.ref == 1) L_clean(pL_params[i]); + if (params.nstates > 2) ortho_Rs(pL_params, i); + + if (converged(pL_params[i].irrep)) { + done = 1; /* Boolean for convergence */ + Lsave(pL_params[i].irrep); /* copy "New L" to "L" */ + moinfo.lcc = pseudoenergy(pL_params[i]); + update(); + if (!pL_params[i].ground && !params.zeta) { + Lnorm(pL_params[i]); /* normalize against R */ + } + Lsave_index(pL_params[i]); /* save Ls with indices in LAMPS */ + Lamp_write(pL_params[i]); /* write out largest Ls */ + + /* sort_amps(); to be done by later functions */ + outfile->Printf("\n\tIterations converged.\n"); + + moinfo.iter = 0; + break; + } + + if (params.diis) diis(moinfo.iter, pL_params[i].irrep); + Lsave(pL_params[i].irrep); + moinfo.lcc = pseudoenergy(pL_params[i]); + update(); } - else { - G_build(pL_params[i].irrep); - L1_build(pL_params[i]); - if(params.print & 2) status("L1 amplitudes", "outfile"); - L2_build(pL_params[i]); - - if(params.wfn == "CC3") { - cc3_l3l2(); - cc3_l3l1(); - } + outfile->Printf("\n"); + if (!done) { + outfile->Printf("\t ** Lambda not converged to %2.1e ** \n", params.convergence); + + dpd_close(0); + cleanup(); + exit_io(); + throw PsiException("cclambda: error", __FILE__, __LINE__); } - - if (params.ref == 1) L_clean(pL_params[i]); - if (params.nstates > 2) ortho_Rs(pL_params, i); - - if(converged(pL_params[i].irrep)) { - done = 1; /* Boolean for convergence */ - Lsave(pL_params[i].irrep); /* copy "New L" to "L" */ - moinfo.lcc = pseudoenergy(pL_params[i]); - update(); - if (!pL_params[i].ground && !params.zeta) { - Lnorm(pL_params[i]); /* normalize against R */ - } - Lsave_index(pL_params[i]); /* save Ls with indices in LAMPS */ - Lamp_write(pL_params[i]); /* write out largest Ls */ - - /* sort_amps(); to be done by later functions */ - outfile->Printf( "\n\tIterations converged.\n"); - - moinfo.iter = 0; - break; - } - - if(params.diis) diis(moinfo.iter, pL_params[i].irrep); - Lsave(pL_params[i].irrep); - moinfo.lcc = pseudoenergy(pL_params[i]); - update(); - } - outfile->Printf( "\n"); - if(!done) { - outfile->Printf( "\t ** Lambda not converged to %2.1e ** \n", - params.convergence); - - dpd_close(0); - cleanup(); - exit_io(); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } - if (pL_params[i].ground) - overlap(pL_params[i].irrep); + if (pL_params[i].ground) overlap(pL_params[i].irrep); } if (params.zeta) { - zeta_norm(pL_params[0]); - } - else if (params.nstates > 1) { /* some excited states are present */ - check_ortho(pL_params); - projections(pL_params); + zeta_norm(pL_params[0]); + } else if (params.nstates > 1) { /* some excited states are present */ + check_ortho(pL_params); + projections(pL_params); } - if(params.local) local_done(); + if (params.local) local_done(); dpd_close(0); - if(params.ref == 2) cachedone_uhf(cachelist); - else cachedone_rhf(cachelist); + if (params.ref == 2) + cachedone_uhf(cachelist); + else + cachedone_rhf(cachelist); free(cachefiles); cleanup(); exit_io(); if ((options_.get_str("WFN") == "CCSD_AT")) { - - // Run cctriples - if (psi::cctriples::cctriples(reference_wavefunction_, options_) == Success) - energy_ = Process::environment.globals["CURRENT ENERGY"]; - else - energy_ = 0.0; + // Run cctriples + if (psi::cctriples::cctriples(reference_wavefunction_, options_) == Success) + energy_ = Process::environment.globals["CURRENT ENERGY"]; + else + energy_ = 0.0; } return energy_; } // must be fixed with options later for excited states -void CCLambdaWavefunction::init_io(void) -{ - int i, num_unparsed; - char *lbl, *argv_unparsed[100]; - - params.all=0; /* do all Ls including ground state */ - params.zeta=0; /* only do ground-state L */ -/* - for (i=1, num_unparsed=0; iPrintf( "\n"); - outfile->Printf( "\t\t\t**************************\n"); - outfile->Printf( "\t\t\t* CCLAMBDA *\n"); - outfile->Printf( "\t\t\t**************************\n"); - outfile->Printf( "\n"); +void CCLambdaWavefunction::title(void) { + outfile->Printf("\n"); + outfile->Printf("\t\t\t**************************\n"); + outfile->Printf("\t\t\t* CCLAMBDA *\n"); + outfile->Printf("\t\t\t**************************\n"); + outfile->Printf("\n"); } -void CCLambdaWavefunction::exit_io(void) -{ - int i; +void CCLambdaWavefunction::exit_io(void) { + int i; - for(i=PSIF_CC_TMP; i <= PSIF_CC_TMP11; i++) { - psio_close(i,0); - psio_open(i,PSIO_OPEN_NEW); - } - psio_close(PSIF_CC_DENOM,0); - psio_open(PSIF_CC_DENOM,PSIO_OPEN_NEW); + for (i = PSIF_CC_TMP; i <= PSIF_CC_TMP11; i++) { + psio_close(i, 0); + psio_open(i, PSIO_OPEN_NEW); + } + psio_close(PSIF_CC_DENOM, 0); + psio_open(PSIF_CC_DENOM, PSIO_OPEN_NEW); - /* Close all dpd data files here */ - for(i=PSIF_CC_MIN; i < PSIF_CC_TMP; i++) psio_close(i,1); - for(i=PSIF_CC_TMP; i <= PSIF_CC_TMP11; i++) psio_close(i,0); /* delete CC_TMP files */ - for(i=PSIF_CC_TMP11+1; i <= PSIF_CC_MAX; i++) psio_close(i,1); + /* Close all dpd data files here */ + for (i = PSIF_CC_MIN; i < PSIF_CC_TMP; i++) psio_close(i, 1); + for (i = PSIF_CC_TMP; i <= PSIF_CC_TMP11; i++) psio_close(i, 0); /* delete CC_TMP files */ + for (i = PSIF_CC_TMP11 + 1; i <= PSIF_CC_MAX; i++) psio_close(i, 1); - tstop(); + tstop(); } /* put copies of L for excited states in LAMPS with irrep and index label */ void Lsave_index(struct L_Params L_params) { - int L_irr; - dpdfile2 L1; - dpdbuf4 L2, LIjAb, LIjbA; - char *L1A_lbl, *L1B_lbl, *L2AA_lbl, *L2BB_lbl, *L2AB_lbl, *L2RHF_lbl, lbl[32]; - L1A_lbl = L_params.L1A_lbl; - L1B_lbl = L_params.L1B_lbl; - L2AA_lbl = L_params.L2AA_lbl; - L2BB_lbl = L_params.L2BB_lbl; - L2AB_lbl = L_params.L2AB_lbl; - L2RHF_lbl = L_params.L2RHF_lbl; - L_irr = L_params.irrep; - - if(params.ref == 0 || params.ref == 1) { /** ROHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1A_lbl); - global_dpd_->file2_close(&L1); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1B_lbl); - global_dpd_->file2_close(&L1); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AA_lbl); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2BB_lbl); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AB_lbl); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1A_lbl); - global_dpd_->file2_close(&L1); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1B_lbl); - global_dpd_->file2_close(&L1); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AA_lbl); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2BB_lbl); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AB_lbl); - global_dpd_->buf4_close(&L2); - } - - if (params.ref == 0) { /** RHF for those codes that can use them **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->buf4_sort(&LIjAb, PSIF_CC_TMP, pqsr, 0, 5, "LIjbA"); - global_dpd_->buf4_copy(&LIjAb, PSIF_CC_LAMPS, L2RHF_lbl); - global_dpd_->buf4_close(&LIjAb); + int L_irr; + dpdfile2 L1; + dpdbuf4 L2, LIjAb, LIjbA; + char *L1A_lbl, *L1B_lbl, *L2AA_lbl, *L2BB_lbl, *L2AB_lbl, *L2RHF_lbl, lbl[32]; + L1A_lbl = L_params.L1A_lbl; + L1B_lbl = L_params.L1B_lbl; + L2AA_lbl = L_params.L2AA_lbl; + L2BB_lbl = L_params.L2BB_lbl; + L2AB_lbl = L_params.L2AB_lbl; + L2RHF_lbl = L_params.L2RHF_lbl; + L_irr = L_params.irrep; + + if (params.ref == 0 || params.ref == 1) { /** ROHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1A_lbl); + global_dpd_->file2_close(&L1); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1B_lbl); + global_dpd_->file2_close(&L1); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AA_lbl); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2BB_lbl); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AB_lbl); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1A_lbl); + global_dpd_->file2_close(&L1); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMPS, L1B_lbl); + global_dpd_->file2_close(&L1); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AA_lbl); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2BB_lbl); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMPS, L2AB_lbl); + global_dpd_->buf4_close(&L2); + } - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2RHF_lbl); - global_dpd_->buf4_scm(&LIjAb, 2.0); - global_dpd_->buf4_init(&LIjbA, PSIF_CC_TMP, L_irr, 0, 5, 0, 5, 0, "LIjbA"); - global_dpd_->buf4_axpy(&LIjbA, &LIjAb, -1.0); - global_dpd_->buf4_close(&LIjbA); - global_dpd_->buf4_close(&LIjAb); - } - return; + if (params.ref == 0) { /** RHF for those codes that can use them **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->buf4_sort(&LIjAb, PSIF_CC_TMP, pqsr, 0, 5, "LIjbA"); + global_dpd_->buf4_copy(&LIjAb, PSIF_CC_LAMPS, L2RHF_lbl); + global_dpd_->buf4_close(&LIjAb); + + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2RHF_lbl); + global_dpd_->buf4_scm(&LIjAb, 2.0); + global_dpd_->buf4_init(&LIjbA, PSIF_CC_TMP, L_irr, 0, 5, 0, 5, 0, "LIjbA"); + global_dpd_->buf4_axpy(&LIjbA, &LIjAb, -1.0); + global_dpd_->buf4_close(&LIjbA); + global_dpd_->buf4_close(&LIjAb); + } + return; } void L_zero(int L_irr) { - dpdfile2 LIA, Lia; - dpdbuf4 LIJAB, Lijab, LIjAb; + dpdfile2 LIA, Lia; + dpdbuf4 LIJAB, Lijab, LIjAb; + + if (params.ref == 0) { /** RHF **/ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_scm(&LIA, 0.0); + global_dpd_->file2_close(&LIA); + } else if (params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_scm(&LIA, 0.0); + global_dpd_->file2_scm(&Lia, 0.0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_scm(&LIA, 0.0); + global_dpd_->file2_scm(&Lia, 0.0); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + } + + if (params.ref == 0) { /** RHF **/ + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_scm(&LIjAb, 0.0); + global_dpd_->buf4_close(&LIjAb); + } else if (params.ref == 1) { /** ROHF **/ + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_scm(&LIJAB, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_scm(&Lijab, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_scm(&LIjAb, 0.0); + global_dpd_->buf4_close(&LIjAb); + } else { /** UHF **/ + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_scm(&LIJAB, 0.0); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_scm(&Lijab, 0.0); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_scm(&LIjAb, 0.0); + global_dpd_->buf4_close(&LIjAb); + } +} + +/* Cleaning out L vectors for open-shell cases */ +void L_clean(struct L_Params L_params) { + int L_irr, i; + dpdfile2 LIA, Lia; + dpdbuf4 LIJAB, Lijab, LIjAb; + char lbl[80]; + + L_irr = L_params.irrep; - if(params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_scm(&LIA, 0.0); - global_dpd_->file2_close(&LIA); - } - else if(params.ref == 1) { /** RHF/ROHF **/ global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_scm(&LIA, 0.0); - global_dpd_->file2_scm(&Lia, 0.0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_scm(&LIA, 0.0); - global_dpd_->file2_scm(&Lia, 0.0); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - } - - if(params.ref == 0) { /** RHF **/ - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_scm(&LIjAb, 0.0); - global_dpd_->buf4_close(&LIjAb); - } - else if (params.ref == 1 ) { /** ROHF **/ global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_scm(&LIJAB, 0.0); - global_dpd_->buf4_close(&LIJAB); global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_scm(&Lijab, 0.0); - global_dpd_->buf4_close(&Lijab); global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_scm(&LIjAb, 0.0); - global_dpd_->buf4_close(&LIjAb); - } - else { /** UHF **/ - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_scm(&LIJAB, 0.0); + + c_clean(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_scm(&Lijab, 0.0); global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_scm(&LIjAb, 0.0); global_dpd_->buf4_close(&LIjAb); - } -} - - -/* Cleaning out L vectors for open-shell cases */ -void L_clean(struct L_Params L_params) { - int L_irr, i; - dpdfile2 LIA, Lia; - dpdbuf4 LIJAB, Lijab, LIjAb; - char lbl[80]; - - L_irr = L_params.irrep; - - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - - c_clean(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); } void zeta_norm(struct L_Params L_params) { - int Z_irr, i; - dpdfile2 ZIA, Zia; - dpdbuf4 ZIJAB, Zijab, ZIjAb; - double tval; - Z_irr = L_params.irrep; - - if (params.ref == 0 || params.ref == 1) { - global_dpd_->file2_init(&ZIA, PSIF_CC_LAMPS, Z_irr, 0, 1, "ZIA"); - tval = global_dpd_->file2_dot_self(&ZIA); - global_dpd_->file2_close(&ZIA); - global_dpd_->file2_init(&Zia, PSIF_CC_LAMPS, Z_irr, 0, 1, "Zia"); - tval += global_dpd_->file2_dot_self(&Zia); - global_dpd_->file2_close(&Zia); - global_dpd_->buf4_init(&ZIJAB, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "ZIJAB"); - tval += global_dpd_->buf4_dot_self(&ZIJAB); - global_dpd_->buf4_close(&ZIJAB); - global_dpd_->buf4_init(&Zijab, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "Zijab"); - tval += global_dpd_->buf4_dot_self(&Zijab); - global_dpd_->buf4_close(&Zijab); - global_dpd_->buf4_init(&ZIjAb, PSIF_CC_LAMPS, Z_irr, 0, 5, 0, 5, 0, "ZIjAb"); - tval += global_dpd_->buf4_dot_self(&ZIjAb); - global_dpd_->buf4_close(&ZIjAb); - } - else { /* UHF */ - global_dpd_->file2_init(&ZIA, PSIF_CC_LAMPS, Z_irr, 0, 1, "ZIA"); - tval = global_dpd_->file2_dot_self(&ZIA); - global_dpd_->file2_close(&ZIA); - global_dpd_->file2_init(&Zia, PSIF_CC_LAMPS, Z_irr, 2, 3, "Zia"); - tval += global_dpd_->file2_dot_self(&Zia); - global_dpd_->file2_close(&Zia); - global_dpd_->buf4_init(&ZIJAB, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "ZIJAB"); - tval += global_dpd_->buf4_dot_self(&ZIJAB); - global_dpd_->buf4_close(&ZIJAB); - global_dpd_->buf4_init(&Zijab, PSIF_CC_LAMPS, Z_irr, 12, 17, 12, 17, 0, "Zijab"); - tval += global_dpd_->buf4_dot_self(&Zijab); - global_dpd_->buf4_close(&Zijab); - global_dpd_->buf4_init(&ZIjAb, PSIF_CC_LAMPS, Z_irr, 22, 28, 22, 28, 0, "ZIjAb"); - tval += global_dpd_->buf4_dot_self(&ZIjAb); - global_dpd_->buf4_close(&ZIjAb); - } - outfile->Printf("Norm of Zeta: %20.15lf\n", sqrt(tval) ); - return; + int Z_irr, i; + dpdfile2 ZIA, Zia; + dpdbuf4 ZIJAB, Zijab, ZIjAb; + double tval; + Z_irr = L_params.irrep; + + if (params.ref == 0 || params.ref == 1) { + global_dpd_->file2_init(&ZIA, PSIF_CC_LAMPS, Z_irr, 0, 1, "ZIA"); + tval = global_dpd_->file2_dot_self(&ZIA); + global_dpd_->file2_close(&ZIA); + global_dpd_->file2_init(&Zia, PSIF_CC_LAMPS, Z_irr, 0, 1, "Zia"); + tval += global_dpd_->file2_dot_self(&Zia); + global_dpd_->file2_close(&Zia); + global_dpd_->buf4_init(&ZIJAB, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "ZIJAB"); + tval += global_dpd_->buf4_dot_self(&ZIJAB); + global_dpd_->buf4_close(&ZIJAB); + global_dpd_->buf4_init(&Zijab, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "Zijab"); + tval += global_dpd_->buf4_dot_self(&Zijab); + global_dpd_->buf4_close(&Zijab); + global_dpd_->buf4_init(&ZIjAb, PSIF_CC_LAMPS, Z_irr, 0, 5, 0, 5, 0, "ZIjAb"); + tval += global_dpd_->buf4_dot_self(&ZIjAb); + global_dpd_->buf4_close(&ZIjAb); + } else { /* UHF */ + global_dpd_->file2_init(&ZIA, PSIF_CC_LAMPS, Z_irr, 0, 1, "ZIA"); + tval = global_dpd_->file2_dot_self(&ZIA); + global_dpd_->file2_close(&ZIA); + global_dpd_->file2_init(&Zia, PSIF_CC_LAMPS, Z_irr, 2, 3, "Zia"); + tval += global_dpd_->file2_dot_self(&Zia); + global_dpd_->file2_close(&Zia); + global_dpd_->buf4_init(&ZIJAB, PSIF_CC_LAMPS, Z_irr, 2, 7, 2, 7, 0, "ZIJAB"); + tval += global_dpd_->buf4_dot_self(&ZIJAB); + global_dpd_->buf4_close(&ZIJAB); + global_dpd_->buf4_init(&Zijab, PSIF_CC_LAMPS, Z_irr, 12, 17, 12, 17, 0, "Zijab"); + tval += global_dpd_->buf4_dot_self(&Zijab); + global_dpd_->buf4_close(&Zijab); + global_dpd_->buf4_init(&ZIjAb, PSIF_CC_LAMPS, Z_irr, 22, 28, 22, 28, 0, "ZIjAb"); + tval += global_dpd_->buf4_dot_self(&ZIjAb); + global_dpd_->buf4_close(&ZIjAb); + } + outfile->Printf("Norm of Zeta: %20.15lf\n", sqrt(tval)); + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/cclambda.h b/psi4/src/psi4/cclambda/cclambda.h index 81fb1b4252e..38da6bb8159 100644 --- a/psi4/src/psi4/cclambda/cclambda.h +++ b/psi4/src/psi4/cclambda/cclambda.h @@ -35,19 +35,19 @@ namespace psi { class Wavefunction; class Options; -} +} // namespace psi -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -class CCLambdaWavefunction final : public psi::ccenergy::CCEnergyWavefunction -{ -public: +class CCLambdaWavefunction final : public psi::ccenergy::CCEnergyWavefunction { + public: CCLambdaWavefunction(std::shared_ptr reference_wavefunction, Options &options); virtual ~CCLambdaWavefunction(); double compute_energy(); -private: + private: void init(); void init_io(); void init_amps(struct L_Params); @@ -57,7 +57,7 @@ class CCLambdaWavefunction final : public psi::ccenergy::CCEnergyWavefunction void cachedone_uhf(int **cachelist); void cleanup(); void denom(struct L_Params); - void get_params(psi::Options&); + void get_params(psi::Options &); void local_init(); void local_done(); void exit_io(); @@ -67,13 +67,14 @@ class CCLambdaWavefunction final : public psi::ccenergy::CCEnergyWavefunction int converged(int); void diis(int, int); void sort_amps(int); - void status(const char*, std::string); + void status(const char *, std::string); void update(); void cc2_L2_build(struct L_Params); void L2_build(struct L_Params); }; -}} +} // namespace cclambda +} // namespace psi -#endif // CCLAMBDA_H +#endif // CCLAMBDA_H diff --git a/psi4/src/psi4/cclambda/check_ortho.cc b/psi4/src/psi4/cclambda/check_ortho.cc index 91bbd987718..2624a90bb32 100644 --- a/psi4/src/psi4/cclambda/check_ortho.cc +++ b/psi4/src/psi4/cclambda/check_ortho.cc @@ -39,164 +39,161 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { double LR_overlap_ROHF(int IRR, int L_index, int R_index); double LR_overlap_RHF(int IRR, int L_index, int R_index); void check_ortho(struct L_Params *pL_params) { - int L_state_index, root_L_irr, L_irr; - int R_state_index, root_R_irr, R_irr; - double **O, tval; - int L,R; - - - if (params.ref <= 1) { - O = block_matrix(params.nstates,params.nstates); - for (L=0;LPrintf("\t overlap matrix with ROHF quantities (-99 => 0 by symmetry)\n"); + print_mat(O, params.nstates, params.nstates, "outfile"); + free_block(O); } - outfile->Printf("\t overlap matrix with ROHF quantities (-99 => 0 by symmetry)\n"); - print_mat(O, params.nstates, params.nstates, "outfile"); - free_block(O); - } - - if (params.ref == 0) { /* test RHF quantities */ - O = block_matrix(params.nstates, params.nstates); - for (L=0; LPrintf("\t overlap matrix with RHF quantities (-99 => 0 by symmetry)\n"); + print_mat(O, params.nstates, params.nstates, "outfile"); + free_block(O); } - outfile->Printf("\t overlap matrix with RHF quantities (-99 => 0 by symmetry)\n"); - print_mat(O, params.nstates, params.nstates, "outfile"); - free_block(O); - } - return; + return; } double LR_overlap_ROHF(int IRR, int L_index, int R_index) { - double overlap; - dpdfile2 R1, L1; - dpdbuf4 R2, L2; - char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; - char L1A_lbl[32], L1B_lbl[32], L2AA_lbl[32], L2BB_lbl[32], L2AB_lbl[32]; - - sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); - sprintf(R1B_lbl, "Ria %d %d", IRR, R_index); - sprintf(R2AA_lbl, "RIJAB %d %d", IRR, R_index); - sprintf(R2BB_lbl, "Rijab %d %d", IRR, R_index); - sprintf(R2AB_lbl, "RIjAb %d %d", IRR, R_index); - - sprintf(L1A_lbl, "LIA %d %d", IRR, L_index); - sprintf(L1B_lbl, "Lia %d %d", IRR, L_index); - sprintf(L2AA_lbl, "LIJAB %d %d", IRR, L_index); - sprintf(L2BB_lbl, "Lijab %d %d", IRR, L_index); - sprintf(L2AB_lbl, "LIjAb %d %d", IRR, L_index); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); - overlap = global_dpd_->file2_dot(&L1, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_close(&L1); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1B_lbl); - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1B_lbl); - overlap += global_dpd_->file2_dot(&L1, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_close(&L1); - - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); - overlap += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2BB_lbl); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); - overlap += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - overlap += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - - return overlap; + double overlap; + dpdfile2 R1, L1; + dpdbuf4 R2, L2; + char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; + char L1A_lbl[32], L1B_lbl[32], L2AA_lbl[32], L2BB_lbl[32], L2AB_lbl[32]; + + sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); + sprintf(R1B_lbl, "Ria %d %d", IRR, R_index); + sprintf(R2AA_lbl, "RIJAB %d %d", IRR, R_index); + sprintf(R2BB_lbl, "Rijab %d %d", IRR, R_index); + sprintf(R2AB_lbl, "RIjAb %d %d", IRR, R_index); + + sprintf(L1A_lbl, "LIA %d %d", IRR, L_index); + sprintf(L1B_lbl, "Lia %d %d", IRR, L_index); + sprintf(L2AA_lbl, "LIJAB %d %d", IRR, L_index); + sprintf(L2BB_lbl, "Lijab %d %d", IRR, L_index); + sprintf(L2AB_lbl, "LIjAb %d %d", IRR, L_index); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); + overlap = global_dpd_->file2_dot(&L1, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_close(&L1); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1B_lbl); + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1B_lbl); + overlap += global_dpd_->file2_dot(&L1, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_close(&L1); + + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); + overlap += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2BB_lbl); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); + overlap += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + overlap += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + + return overlap; } double LR_overlap_RHF(int IRR, int L_index, int R_index) { - dpdfile2 R1, L1; - dpdbuf4 R2, L2; - double overlap, overlap2, overlap3; - char L1A_lbl[32], R1A_lbl[32], lbl[32]; - - sprintf(L1A_lbl, "LIA %d %d", IRR, L_index); - sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); - overlap = 2.0 * global_dpd_->file2_dot(&L1, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_close(&L1); - - sprintf(lbl, "2RIjAb - RIjbA %d %d", IRR, R_index); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); - - sprintf(lbl, "LIjAb %d %d", IRR, L_index); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, lbl); - overlap2 = global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&R2); - - sprintf(lbl, "2LIjAb - LIjbA %d %d", IRR, L_index); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, lbl); - - sprintf(lbl, "RIjAb %d %d", IRR, R_index); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); - overlap3 = global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - - if (std::fabs(overlap2 - overlap3) > 1E-14) { - outfile->Printf("Bad anti-symmetry detected in RHF quantities\n"); - outfile->Printf("error: %15.10lf\n",overlap2-overlap3); - } - - overlap += overlap2; - return overlap; + dpdfile2 R1, L1; + dpdbuf4 R2, L2; + double overlap, overlap2, overlap3; + char L1A_lbl[32], R1A_lbl[32], lbl[32]; + + sprintf(L1A_lbl, "LIA %d %d", IRR, L_index); + sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); + overlap = 2.0 * global_dpd_->file2_dot(&L1, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_close(&L1); + + sprintf(lbl, "2RIjAb - RIjbA %d %d", IRR, R_index); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); + + sprintf(lbl, "LIjAb %d %d", IRR, L_index); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, lbl); + overlap2 = global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&R2); + + sprintf(lbl, "2LIjAb - LIjbA %d %d", IRR, L_index); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, lbl); + + sprintf(lbl, "RIjAb %d %d", IRR, R_index); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); + overlap3 = global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + + if (std::fabs(overlap2 - overlap3) > 1E-14) { + outfile->Printf("Bad anti-symmetry detected in RHF quantities\n"); + outfile->Printf("error: %15.10lf\n", overlap2 - overlap3); + } + + overlap += overlap2; + return overlap; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/check_sum.cc b/psi4/src/psi4/cclambda/check_sum.cc index 293056db614..32a6151d214 100644 --- a/psi4/src/psi4/cclambda/check_sum.cc +++ b/psi4/src/psi4/cclambda/check_sum.cc @@ -39,84 +39,81 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -double norm_C(dpdfile2 *CME, dpdfile2 *Cme, - dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf); +double norm_C(dpdfile2 *CME, dpdfile2 *Cme, dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf); double norm_C_rhf(dpdfile2 *CME, dpdbuf4 *CMnEf, dpdbuf4 *CMnfE); void check_sum(char *term_lbl, int irrep) { - dpdfile2 Lia, LIA; - dpdbuf4 LIJAB, Lijab, LIjAb, LIjbA; - static double old_norm=0; - double norm,dotval; - char lbl[80]; - - if (!strcmp(term_lbl,"reset")) { - outfile->Printf("resetting norm\n"); - old_norm = 0; - return; - } - - if (params.ref <= 1) { - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, irrep, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, irrep, 0, 1, "New Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, irrep, 0, 5, 0, 5, 0, "New LIjAb"); - - norm = norm_C(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, irrep, 0, 1, "New LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, irrep, 2, 3, "New Lia"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, irrep, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, irrep, 22, 28, 22, 28, 0, "New LIjAb"); - - norm = norm_C(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); - } - - outfile->Printf("%7s, D(norm L)=%15.10lf\n", term_lbl, norm - old_norm); - - old_norm = norm; - return; + dpdfile2 Lia, LIA; + dpdbuf4 LIJAB, Lijab, LIjAb, LIjbA; + static double old_norm = 0; + double norm, dotval; + char lbl[80]; + + if (!strcmp(term_lbl, "reset")) { + outfile->Printf("resetting norm\n"); + old_norm = 0; + return; + } + + if (params.ref <= 1) { + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, irrep, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, irrep, 0, 1, "New Lia"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, irrep, 0, 5, 0, 5, 0, "New LIjAb"); + + norm = norm_C(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&LIjAb); + } else if (params.ref == 2) { + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, irrep, 0, 1, "New LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, irrep, 2, 3, "New Lia"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, irrep, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, irrep, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, irrep, 22, 28, 22, 28, 0, "New LIjAb"); + + norm = norm_C(&LIA, &Lia, &LIJAB, &Lijab, &LIjAb); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&LIjAb); + } + + outfile->Printf("%7s, D(norm L)=%15.10lf\n", term_lbl, norm - old_norm); + + old_norm = norm; + return; } -double norm_C(dpdfile2 *CME, dpdfile2 *Cme, - dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf) -{ - double norm = 0.0; - norm += global_dpd_->file2_dot_self(CME); - norm += global_dpd_->file2_dot_self(Cme); - norm += global_dpd_->buf4_dot_self(CMNEF); - norm += global_dpd_->buf4_dot_self(Cmnef); - norm += global_dpd_->buf4_dot_self(CMnEf); - norm = sqrt(norm); - return norm; +double norm_C(dpdfile2 *CME, dpdfile2 *Cme, dpdbuf4 *CMNEF, dpdbuf4 *Cmnef, dpdbuf4 *CMnEf) { + double norm = 0.0; + norm += global_dpd_->file2_dot_self(CME); + norm += global_dpd_->file2_dot_self(Cme); + norm += global_dpd_->buf4_dot_self(CMNEF); + norm += global_dpd_->buf4_dot_self(Cmnef); + norm += global_dpd_->buf4_dot_self(CMnEf); + norm = sqrt(norm); + return norm; } double norm_C_rhf(dpdfile2 *CME, dpdbuf4 *CMnEf, dpdbuf4 *CMnfE) { - double norm = 0.0; - norm = 2.0 * global_dpd_->file2_dot_self(CME); - norm += 2.0 * global_dpd_->buf4_dot_self(CMnEf); - norm -= global_dpd_->buf4_dot(CMnEf, CMnfE); - norm = sqrt(norm); - return norm; + double norm = 0.0; + norm = 2.0 * global_dpd_->file2_dot_self(CME); + norm += 2.0 * global_dpd_->buf4_dot_self(CMnEf); + norm -= global_dpd_->buf4_dot(CMnEf, CMnfE); + norm = sqrt(norm); + return norm; } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/converged.cc b/psi4/src/psi4/cclambda/converged.cc index 8391cae4c12..dd12cad52da 100644 --- a/psi4/src/psi4/cclambda/converged.cc +++ b/psi4/src/psi4/cclambda/converged.cc @@ -40,145 +40,144 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -int CCLambdaWavefunction::converged(int L_irr) -{ - int row,col,h,nirreps; - double rms=0.0; - dpdfile2 L1, L1old; - dpdbuf4 L2, L2old; +int CCLambdaWavefunction::converged(int L_irr) { + int row, col, h, nirreps; + double rms = 0.0; + dpdfile2 L1, L1old; + dpdbuf4 L2, L2old; - nirreps = moinfo.nirreps; + nirreps = moinfo.nirreps; - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1); - global_dpd_->file2_mat_rd(&L1); - global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&L1old); - global_dpd_->file2_mat_rd(&L1old); - - for(h=0; h < nirreps; h++) - for(row=0; row < L1.params->rowtot[h]; row++) - for(col=0; col < L1.params->coltot[h^L_irr]; col++) - rms += (L1.matrix[h][row][col] - L1old.matrix[h][row][col]) * - (L1.matrix[h][row][col] - L1old.matrix[h][row][col]); - - global_dpd_->file2_mat_close(&L1); - global_dpd_->file2_close(&L1); - global_dpd_->file2_mat_close(&L1old); - global_dpd_->file2_close(&L1old); - - if(params.ref == 0) rms *= 2.0; - - if(params.ref == 1) { /** ROHF **/ - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_mat_init(&L1); - global_dpd_->file2_mat_rd(&L1); - global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_mat_init(&L1old); - global_dpd_->file2_mat_rd(&L1old); - - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); global_dpd_->file2_mat_init(&L1); global_dpd_->file2_mat_rd(&L1); - global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); global_dpd_->file2_mat_init(&L1old); global_dpd_->file2_mat_rd(&L1old); - } - - if(params.ref == 1 || params.ref == 2) { - for(h=0; h < nirreps; h++) - for(row=0; row < L1.params->rowtot[h]; row++) - for(col=0; col < L1.params->coltot[h^L_irr]; col++) - rms += (L1.matrix[h][row][col] - L1old.matrix[h][row][col]) * - (L1.matrix[h][row][col] - L1old.matrix[h][row][col]); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1.params->rowtot[h]; row++) + for (col = 0; col < L1.params->coltot[h ^ L_irr]; col++) + rms += (L1.matrix[h][row][col] - L1old.matrix[h][row][col]) * + (L1.matrix[h][row][col] - L1old.matrix[h][row][col]); global_dpd_->file2_mat_close(&L1); global_dpd_->file2_close(&L1); global_dpd_->file2_mat_close(&L1old); global_dpd_->file2_close(&L1old); - } - - if(params.ref == 1 || params.ref == 2) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - global_dpd_->buf4_mat_irrep_init(&L2old, h); - global_dpd_->buf4_mat_irrep_rd(&L2old, h); - for(row=0; row < L2.params->rowtot[h]; row++) - for(col=0; col < L2.params->coltot[h^L_irr]; col++) - rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * - (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); - global_dpd_->buf4_mat_irrep_close(&L2, h); - global_dpd_->buf4_mat_irrep_close(&L2old, h); + + if (params.ref == 0) rms *= 2.0; + + if (params.ref == 1) { /** ROHF **/ + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_mat_init(&L1); + global_dpd_->file2_mat_rd(&L1); + global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_mat_init(&L1old); + global_dpd_->file2_mat_rd(&L1old); + + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_mat_init(&L1); + global_dpd_->file2_mat_rd(&L1); + global_dpd_->file2_init(&L1old, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_mat_init(&L1old); + global_dpd_->file2_mat_rd(&L1old); } - global_dpd_->buf4_close(&L2old); - global_dpd_->buf4_close(&L2); - } - - if(params.ref == 1) { /** ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - } - - if(params.ref == 1 || params.ref == 2) { - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - global_dpd_->buf4_mat_irrep_init(&L2old, h); - global_dpd_->buf4_mat_irrep_rd(&L2old, h); - for(row=0; row < L2.params->rowtot[h]; row++) - for(col=0; col < L2.params->coltot[h^L_irr]; col++) - rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * - (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); - global_dpd_->buf4_mat_irrep_close(&L2, h); - global_dpd_->buf4_mat_irrep_close(&L2old, h); + + if (params.ref == 1 || params.ref == 2) { + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1.params->rowtot[h]; row++) + for (col = 0; col < L1.params->coltot[h ^ L_irr]; col++) + rms += (L1.matrix[h][row][col] - L1old.matrix[h][row][col]) * + (L1.matrix[h][row][col] - L1old.matrix[h][row][col]); + + global_dpd_->file2_mat_close(&L1); + global_dpd_->file2_close(&L1); + global_dpd_->file2_mat_close(&L1old); + global_dpd_->file2_close(&L1old); + } + + if (params.ref == 1 || params.ref == 2) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + global_dpd_->buf4_mat_irrep_init(&L2old, h); + global_dpd_->buf4_mat_irrep_rd(&L2old, h); + for (row = 0; row < L2.params->rowtot[h]; row++) + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) + rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * + (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); + global_dpd_->buf4_mat_irrep_close(&L2, h); + global_dpd_->buf4_mat_irrep_close(&L2old, h); + } + global_dpd_->buf4_close(&L2old); + global_dpd_->buf4_close(&L2); + } + + if (params.ref == 1) { /** ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + } + + if (params.ref == 1 || params.ref == 2) { + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + global_dpd_->buf4_mat_irrep_init(&L2old, h); + global_dpd_->buf4_mat_irrep_rd(&L2old, h); + for (row = 0; row < L2.params->rowtot[h]; row++) + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) + rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * + (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); + global_dpd_->buf4_mat_irrep_close(&L2, h); + global_dpd_->buf4_mat_irrep_close(&L2old, h); + } + global_dpd_->buf4_close(&L2old); + global_dpd_->buf4_close(&L2); + } + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + } + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + global_dpd_->buf4_mat_irrep_init(&L2old, h); + global_dpd_->buf4_mat_irrep_rd(&L2old, h); + for (row = 0; row < L2.params->rowtot[h]; row++) + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) + rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * + (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); + global_dpd_->buf4_mat_irrep_close(&L2, h); + global_dpd_->buf4_mat_irrep_close(&L2old, h); } global_dpd_->buf4_close(&L2old); global_dpd_->buf4_close(&L2); - } - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2old, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - } - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - global_dpd_->buf4_mat_irrep_init(&L2old, h); - global_dpd_->buf4_mat_irrep_rd(&L2old, h); - for(row=0; row < L2.params->rowtot[h]; row++) - for(col=0; col < L2.params->coltot[h^L_irr]; col++) - rms += (L2.matrix[h][row][col] - L2old.matrix[h][row][col]) * - (L2.matrix[h][row][col] - L2old.matrix[h][row][col]); - global_dpd_->buf4_mat_irrep_close(&L2, h); - global_dpd_->buf4_mat_irrep_close(&L2old, h); - } - global_dpd_->buf4_close(&L2old); - global_dpd_->buf4_close(&L2); - - rms = sqrt(rms); - moinfo.conv = rms; - - if(rms < params.convergence) return 1; - else return 0; + + rms = sqrt(rms); + moinfo.conv = rms; + + if (rms < params.convergence) + return 1; + else + return 0; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/denom.cc b/psi4/src/psi4/cclambda/denom.cc index 1a962c05a1a..d39275928db 100644 --- a/psi4/src/psi4/cclambda/denom.cc +++ b/psi4/src/psi4/cclambda/denom.cc @@ -39,576 +39,567 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void denom_rhf(struct L_Params); void denom_rohf(struct L_Params); void denom_uhf(struct L_Params); void CCLambdaWavefunction::denom(struct L_Params L_params) { - if(params.ref == 0) denom_rhf(L_params); - else if(params.ref == 1) denom_rohf(L_params); - else if(params.ref == 2) denom_uhf(L_params); + if (params.ref == 0) + denom_rhf(L_params); + else if (params.ref == 1) + denom_rohf(L_params); + else if (params.ref == 2) + denom_uhf(L_params); } -void denom_rhf(struct L_Params L_params) -{ - dpdfile2 FAE, FMI; - dpdfile2 dIA; - dpdfile4 dIjAb; - dpdbuf4 d, bdIJAB, bdijab, bdIjAb; - double tval; - int nirreps,L_irr; - int h, i, j, a, b, ij, ab; - int I, J, A, B; - int isym, jsym, asym, bsym; - int *occpi, *virtpi; - int *occ_off, *vir_off; - int *openpi; - double Fii, Fjj, Faa, Fbb; - - L_irr = L_params.irrep; - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; virtpi = moinfo.virtpi; - occ_off = moinfo.occ_off; vir_off = moinfo.vir_off; - - global_dpd_->file2_init(&FMI, PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->file2_mat_init(&FMI); - global_dpd_->file2_mat_rd(&FMI); - - global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->file2_mat_init(&FAE); - global_dpd_->file2_mat_rd(&FAE); - - /* Alpha one-electron denominator */ - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_mat_init(&dIA); - for(h=0; h < nirreps; h++) { /* irreps of dIA and Fii */ - for(i=0; i < occpi[h]; i++) { - Fii = FMI.matrix[h][i][i]; - for(a=0; a < virtpi[h^L_irr]; a++) { - Faa = FAE.matrix[h^L_irr][a][a]; - dIA.matrix[h][i][a] = 1.0/(Fii - Faa + L_params.cceom_energy); - } +void denom_rhf(struct L_Params L_params) { + dpdfile2 FAE, FMI; + dpdfile2 dIA; + dpdfile4 dIjAb; + dpdbuf4 d, bdIJAB, bdijab, bdIjAb; + double tval; + int nirreps, L_irr; + int h, i, j, a, b, ij, ab; + int I, J, A, B; + int isym, jsym, asym, bsym; + int *occpi, *virtpi; + int *occ_off, *vir_off; + int *openpi; + double Fii, Fjj, Faa, Fbb; + + L_irr = L_params.irrep; + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + virtpi = moinfo.virtpi; + occ_off = moinfo.occ_off; + vir_off = moinfo.vir_off; + + global_dpd_->file2_init(&FMI, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->file2_mat_init(&FMI); + global_dpd_->file2_mat_rd(&FMI); + + global_dpd_->file2_init(&FAE, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->file2_mat_init(&FAE); + global_dpd_->file2_mat_rd(&FAE); + + /* Alpha one-electron denominator */ + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_mat_init(&dIA); + for (h = 0; h < nirreps; h++) { /* irreps of dIA and Fii */ + for (i = 0; i < occpi[h]; i++) { + Fii = FMI.matrix[h][i][i]; + for (a = 0; a < virtpi[h ^ L_irr]; a++) { + Faa = FAE.matrix[h ^ L_irr][a][a]; + dIA.matrix[h][i][a] = 1.0 / (Fii - Faa + L_params.cceom_energy); + } + } } - } - global_dpd_->file2_mat_wrt(&dIA); - global_dpd_->file2_mat_close(&dIA); - global_dpd_->file2_close(&dIA); - - /* Alpha-beta two-electron denominator */ - global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, "dIjAb"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dIjAb, h); - /* Loop over the rows */ - for(ij=0; ij < dIjAb.params->rowtot[h]; ij++) { - i = dIjAb.params->roworb[h][ij][0]; - j = dIjAb.params->roworb[h][ij][1]; - isym = dIjAb.params->psym[i]; - jsym = dIjAb.params->qsym[j]; - - /* Convert to relative orbital index */ - I = i - occ_off[isym]; - J = j - occ_off[jsym]; - Fii = FMI.matrix[isym][I][I]; - Fjj = FMI.matrix[jsym][J][J]; - - /* Loop over the columns */ - for(ab=0; ab < dIjAb.params->coltot[h^L_irr]; ab++) { - a = dIjAb.params->colorb[h^L_irr][ab][0]; - b = dIjAb.params->colorb[h^L_irr][ab][1]; - asym = dIjAb.params->rsym[a]; - bsym = dIjAb.params->ssym[b]; - - /* Convert to relative orbital index */ - A = a - vir_off[asym]; - B = b - vir_off[bsym]; - - Faa = FAE.matrix[asym][A][A]; - Fbb = FAE.matrix[bsym][B][B]; - - dIjAb.matrix[h][ij][ab] = 1.0/(Fii + Fjj - Faa - Fbb + L_params.cceom_energy); + global_dpd_->file2_mat_wrt(&dIA); + global_dpd_->file2_mat_close(&dIA); + global_dpd_->file2_close(&dIA); + + /* Alpha-beta two-electron denominator */ + global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, "dIjAb"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dIjAb, h); + /* Loop over the rows */ + for (ij = 0; ij < dIjAb.params->rowtot[h]; ij++) { + i = dIjAb.params->roworb[h][ij][0]; + j = dIjAb.params->roworb[h][ij][1]; + isym = dIjAb.params->psym[i]; + jsym = dIjAb.params->qsym[j]; + + /* Convert to relative orbital index */ + I = i - occ_off[isym]; + J = j - occ_off[jsym]; + Fii = FMI.matrix[isym][I][I]; + Fjj = FMI.matrix[jsym][J][J]; + + /* Loop over the columns */ + for (ab = 0; ab < dIjAb.params->coltot[h ^ L_irr]; ab++) { + a = dIjAb.params->colorb[h ^ L_irr][ab][0]; + b = dIjAb.params->colorb[h ^ L_irr][ab][1]; + asym = dIjAb.params->rsym[a]; + bsym = dIjAb.params->ssym[b]; + + /* Convert to relative orbital index */ + A = a - vir_off[asym]; + B = b - vir_off[bsym]; + + Faa = FAE.matrix[asym][A][A]; + Fbb = FAE.matrix[bsym][B][B]; + + dIjAb.matrix[h][ij][ab] = 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy); } } - global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); - global_dpd_->file4_mat_irrep_close(&dIjAb, h); - } - global_dpd_->file4_close(&dIjAb); + global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); + global_dpd_->file4_mat_irrep_close(&dIjAb, h); + } + global_dpd_->file4_close(&dIjAb); - global_dpd_->file2_mat_close(&FMI); - global_dpd_->file2_mat_close(&FAE); - global_dpd_->file2_close(&FMI); - global_dpd_->file2_close(&FAE); + global_dpd_->file2_mat_close(&FMI); + global_dpd_->file2_mat_close(&FAE); + global_dpd_->file2_close(&FMI); + global_dpd_->file2_close(&FAE); - return; + return; } -void denom_uhf(struct L_Params L_params) -{ - int nirreps, h, i, j, a, b, ij, ab, I, J, A, B, isym, jsym, asym, bsym, m, e; - int *aoccpi, *boccpi, *avirtpi, *bvirtpi; - int *aocc_off, *bocc_off, *avir_off, *bvir_off, L_irr; - dpdfile2 LFMIt, LFmit, LFaet, LFAEt; - dpdfile2 FMI, Fmi, FAE, Fae; - dpdfile2 dIA, dia; - dpdfile4 dIJAB, dijab, dIjAb; - double Fii, Fjj, Faa, Fbb; - - L_irr = L_params.irrep; - nirreps = moinfo.nirreps; - aoccpi = moinfo.aoccpi; - boccpi = moinfo.boccpi; - avirtpi = moinfo.avirtpi; - bvirtpi = moinfo.bvirtpi; - aocc_off = moinfo.aocc_off; - bocc_off = moinfo.bocc_off; - avir_off = moinfo.avir_off; - bvir_off = moinfo.bvir_off; - - if((params.wfn == "CC2") || (params.wfn == "EOM_CC2")) { - - global_dpd_->file2_init(&LFMIt, PSIF_CC_OEI, 0, 0, 0, "fIJ"); - global_dpd_->file2_mat_init(&LFMIt); - global_dpd_->file2_mat_rd(&LFMIt); - - global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 2, 2, "fij"); - global_dpd_->file2_mat_init(&LFmit); - global_dpd_->file2_mat_rd(&LFmit); +void denom_uhf(struct L_Params L_params) { + int nirreps, h, i, j, a, b, ij, ab, I, J, A, B, isym, jsym, asym, bsym, m, e; + int *aoccpi, *boccpi, *avirtpi, *bvirtpi; + int *aocc_off, *bocc_off, *avir_off, *bvir_off, L_irr; + dpdfile2 LFMIt, LFmit, LFaet, LFAEt; + dpdfile2 FMI, Fmi, FAE, Fae; + dpdfile2 dIA, dia; + dpdfile4 dIJAB, dijab, dIjAb; + double Fii, Fjj, Faa, Fbb; + + L_irr = L_params.irrep; + nirreps = moinfo.nirreps; + aoccpi = moinfo.aoccpi; + boccpi = moinfo.boccpi; + avirtpi = moinfo.avirtpi; + bvirtpi = moinfo.bvirtpi; + aocc_off = moinfo.aocc_off; + bocc_off = moinfo.bocc_off; + avir_off = moinfo.avir_off; + bvir_off = moinfo.bvir_off; + + if ((params.wfn == "CC2") || (params.wfn == "EOM_CC2")) { + global_dpd_->file2_init(&LFMIt, PSIF_CC_OEI, 0, 0, 0, "fIJ"); + global_dpd_->file2_mat_init(&LFMIt); + global_dpd_->file2_mat_rd(&LFMIt); + + global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 2, 2, "fij"); + global_dpd_->file2_mat_init(&LFmit); + global_dpd_->file2_mat_rd(&LFmit); + + global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 3, 3, "fab"); + global_dpd_->file2_mat_init(&LFaet); + global_dpd_->file2_mat_rd(&LFaet); + + global_dpd_->file2_init(&LFAEt, PSIF_CC_OEI, 0, 1, 1, "fAB"); + global_dpd_->file2_mat_init(&LFAEt); + global_dpd_->file2_mat_rd(&LFAEt); + + } else { + global_dpd_->file2_init(&LFMIt, PSIF_CC_OEI, 0, 0, 0, "FMI"); + global_dpd_->file2_mat_init(&LFMIt); + global_dpd_->file2_mat_rd(&LFMIt); + + global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 2, 2, "Fmi"); + global_dpd_->file2_mat_init(&LFmit); + global_dpd_->file2_mat_rd(&LFmit); + + global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 3, 3, "Fae"); + global_dpd_->file2_mat_init(&LFaet); + global_dpd_->file2_mat_rd(&LFaet); + + global_dpd_->file2_init(&LFAEt, PSIF_CC_OEI, 0, 1, 1, "FAE"); + global_dpd_->file2_mat_init(&LFAEt); + global_dpd_->file2_mat_rd(&LFAEt); + } - global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 3, 3, "fab"); - global_dpd_->file2_mat_init(&LFaet); - global_dpd_->file2_mat_rd(&LFaet); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_mat_init(&dIA); + for (h = 0; h < nirreps; h++) { + for (i = 0; i < aoccpi[h]; i++) { + Fii = LFMIt.matrix[h][i][i]; + for (a = 0; a < avirtpi[h ^ L_irr]; a++) { + Faa = LFAEt.matrix[h ^ L_irr][a][a]; + dIA.matrix[h][i][a] = 1.0 / (Fii - Faa + L_params.cceom_energy); + } + } + } + global_dpd_->file2_mat_wrt(&dIA); + global_dpd_->file2_mat_close(&dIA); + global_dpd_->file2_close(&dIA); + + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); + global_dpd_->file2_mat_init(&dia); + for (h = 0; h < nirreps; h++) { + for (i = 0; i < boccpi[h]; i++) { + Fii = LFmit.matrix[h][i][i]; + for (a = 0; a < bvirtpi[h ^ L_irr]; a++) { + Faa = LFaet.matrix[h ^ L_irr][a][a]; + dia.matrix[h][i][a] = 1.0 / (Fii - Faa + L_params.cceom_energy); + } + } + } + global_dpd_->file2_mat_wrt(&dia); + global_dpd_->file2_mat_close(&dia); + global_dpd_->file2_close(&dia); + + global_dpd_->file4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, "dIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dIJAB, h); + for (ij = 0; ij < dIJAB.params->rowtot[h]; ij++) { + i = dIJAB.params->roworb[h][ij][0]; + j = dIJAB.params->roworb[h][ij][1]; + isym = dIJAB.params->psym[i]; + jsym = dIJAB.params->qsym[j]; + I = i - aocc_off[isym]; + J = j - aocc_off[jsym]; + Fii = LFMIt.matrix[isym][I][I]; + Fjj = LFMIt.matrix[jsym][J][J]; + + for (ab = 0; ab < dIJAB.params->coltot[h ^ L_irr]; ab++) { + a = dIJAB.params->colorb[h ^ L_irr][ab][0]; + b = dIJAB.params->colorb[h ^ L_irr][ab][1]; + asym = dIJAB.params->rsym[a]; + bsym = dIJAB.params->ssym[b]; + A = a - avir_off[asym]; + B = b - avir_off[bsym]; + Faa = LFAEt.matrix[asym][A][A]; + Fbb = LFAEt.matrix[bsym][B][B]; + + dIJAB.matrix[h][ij][ab] = 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy); + } + } + global_dpd_->file4_mat_irrep_wrt(&dIJAB, h); + global_dpd_->file4_mat_irrep_close(&dIJAB, h); + } + global_dpd_->file4_close(&dIJAB); + + global_dpd_->file4_init(&dijab, PSIF_CC_DENOM, L_irr, 11, 16, "dijab"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dijab, h); + for (ij = 0; ij < dijab.params->rowtot[h]; ij++) { + i = dijab.params->roworb[h][ij][0]; + j = dijab.params->roworb[h][ij][1]; + isym = dijab.params->psym[i]; + jsym = dijab.params->qsym[j]; + I = i - bocc_off[isym]; + J = j - bocc_off[jsym]; + Fii = LFmit.matrix[isym][I][I]; + Fjj = LFmit.matrix[jsym][J][J]; + + for (ab = 0; ab < dijab.params->coltot[h ^ L_irr]; ab++) { + a = dijab.params->colorb[h ^ L_irr][ab][0]; + b = dijab.params->colorb[h ^ L_irr][ab][1]; + asym = dijab.params->rsym[a]; + bsym = dijab.params->ssym[b]; + A = a - bvir_off[asym]; + B = b - bvir_off[bsym]; + Faa = LFaet.matrix[asym][A][A]; + Fbb = LFaet.matrix[bsym][B][B]; + + dijab.matrix[h][ij][ab] = 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy); + } + } + global_dpd_->file4_mat_irrep_wrt(&dijab, h); + global_dpd_->file4_mat_irrep_close(&dijab, h); + } + global_dpd_->file4_close(&dijab); + + global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 22, 28, "dIjAb"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dIjAb, h); + for (ij = 0; ij < dIjAb.params->rowtot[h]; ij++) { + i = dIjAb.params->roworb[h][ij][0]; + j = dIjAb.params->roworb[h][ij][1]; + isym = dIjAb.params->psym[i]; + jsym = dIjAb.params->qsym[j]; + I = i - aocc_off[isym]; + J = j - bocc_off[jsym]; + Fii = LFMIt.matrix[isym][I][I]; + Fjj = LFmit.matrix[jsym][J][J]; + + for (ab = 0; ab < dIjAb.params->coltot[h ^ L_irr]; ab++) { + a = dIjAb.params->colorb[h ^ L_irr][ab][0]; + b = dIjAb.params->colorb[h ^ L_irr][ab][1]; + asym = dIjAb.params->rsym[a]; + bsym = dIjAb.params->ssym[b]; + A = a - avir_off[asym]; + B = b - bvir_off[bsym]; + Faa = LFAEt.matrix[asym][A][A]; + Fbb = LFaet.matrix[bsym][B][B]; + + dIjAb.matrix[h][ij][ab] = 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy); + } + } + global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); + global_dpd_->file4_mat_irrep_close(&dIjAb, h); + } + global_dpd_->file4_close(&dIjAb); + + global_dpd_->file2_mat_close(&LFMIt); + global_dpd_->file2_mat_close(&LFmit); + global_dpd_->file2_mat_close(&LFAEt); + global_dpd_->file2_mat_close(&LFaet); + global_dpd_->file2_close(&LFMIt); + global_dpd_->file2_close(&LFmit); + global_dpd_->file2_close(&LFAEt); + global_dpd_->file2_close(&LFaet); + + /* if((!strcmp(params.wfn,"CC2")) || (!strcmp(params.wfn,"EOM_CC2"))) { */ + /* dpd_file2_init(&FMI, CC_OEI, 0, 0, 0, "FMI"); */ + /* dpd_file2_init(&Fmi, CC_OEI, 0, 2, 2, "Fmi"); */ + + /* dpd_file2_mat_init(&FMI); */ + /* dpd_file2_mat_rd(&FMI); */ + /* dpd_file2_mat_init(&Fmi); */ + /* dpd_file2_mat_rd(&Fmi); */ + + /* for(h=0; h < moinfo.nirreps; h++) { */ + /* for(m=0; m < FMI.params->rowtot[h]; m++) */ + /* FMI.matrix[h][m][m] = 0; */ + /* for(m=0; m < Fmi.params->rowtot[h]; m++) */ + /* Fmi.matrix[h][m][m] = 0; */ + /* } */ + + /* dpd_file2_mat_wrt(&FMI); */ + /* dpd_file2_mat_close(&FMI); */ + /* dpd_file2_mat_wrt(&Fmi); */ + /* dpd_file2_mat_close(&Fmi); */ + + /* dpd_file2_close(&FMI); */ + /* dpd_file2_close(&Fmi); */ + + /* dpd_file2_init(&FAE, CC_OEI, 0, 1, 1, "FAE"); */ + /* dpd_file2_init(&Fae, CC_OEI, 0, 3, 3, "Fae"); */ + + /* dpd_file2_mat_init(&FAE); */ + /* dpd_file2_mat_rd(&FAE); */ + /* dpd_file2_mat_init(&Fae); */ + /* dpd_file2_mat_rd(&Fae); */ + + /* for(h=0; h < moinfo.nirreps; h++) { */ + /* for(e=0; e < FAE.params->coltot[h]; e++) */ + /* FAE.matrix[h][e][e] = 0; */ + /* for(e=0; e < Fae.params->coltot[h]; e++) */ + /* Fae.matrix[h][e][e] = 0; */ + /* } */ + + /* dpd_file2_mat_wrt(&FAE); */ + /* dpd_file2_mat_close(&FAE); */ + /* dpd_file2_mat_wrt(&Fae); */ + /* dpd_file2_mat_close(&Fae); */ + + /* dpd_file2_close(&FAE); */ + /* dpd_file2_close(&Fae); */ + /* } */ + + return; +} - global_dpd_->file2_init(&LFAEt, PSIF_CC_OEI, 0, 1, 1, "fAB"); - global_dpd_->file2_mat_init(&LFAEt); - global_dpd_->file2_mat_rd(&LFAEt); +void denom_rohf(struct L_Params L_params) { + dpdfile2 LFAEt, LFaet, LFMIt, LFmit; + dpdfile2 dIA, dia; + dpdfile4 dIJAB, dijab, dIjAb; + dpdbuf4 d, bdIJAB, bdijab, bdIjAb; + double tval; + int nirreps, L_irr; + int h, i, j, a, b, ij, ab; + int I, J, A, B; + int isym, jsym, asym, bsym; + int *occpi, *virtpi; + int *occ_off, *vir_off; + int *openpi; + double Fii, Fjj, Faa, Fbb; + + L_irr = L_params.irrep; + nirreps = moinfo.nirreps; + occpi = moinfo.occpi; + virtpi = moinfo.virtpi; + openpi = moinfo.openpi; + occ_off = moinfo.occ_off; + vir_off = moinfo.vir_off; - } - else { global_dpd_->file2_init(&LFMIt, PSIF_CC_OEI, 0, 0, 0, "FMI"); global_dpd_->file2_mat_init(&LFMIt); global_dpd_->file2_mat_rd(&LFMIt); - global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 2, 2, "Fmi"); + global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 0, 0, "Fmi"); global_dpd_->file2_mat_init(&LFmit); global_dpd_->file2_mat_rd(&LFmit); - global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 3, 3, "Fae"); + global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 1, 1, "Fae"); global_dpd_->file2_mat_init(&LFaet); global_dpd_->file2_mat_rd(&LFaet); global_dpd_->file2_init(&LFAEt, PSIF_CC_OEI, 0, 1, 1, "FAE"); global_dpd_->file2_mat_init(&LFAEt); global_dpd_->file2_mat_rd(&LFAEt); - } - - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_mat_init(&dIA); - for(h=0; h < nirreps; h++) { - for(i=0; i < aoccpi[h]; i++) { - Fii = LFMIt.matrix[h][i][i]; - for(a=0; a < avirtpi[h^L_irr]; a++) { - Faa = LFAEt.matrix[h^L_irr][a][a]; - dIA.matrix[h][i][a] = 1.0/(Fii - Faa + L_params.cceom_energy); - } - } - } - global_dpd_->file2_mat_wrt(&dIA); - global_dpd_->file2_mat_close(&dIA); - global_dpd_->file2_close(&dIA); - - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); - global_dpd_->file2_mat_init(&dia); - for(h=0; h < nirreps; h++) { - for(i=0; i < boccpi[h]; i++) { - Fii = LFmit.matrix[h][i][i]; - for(a=0; a < bvirtpi[h^L_irr]; a++) { - Faa = LFaet.matrix[h^L_irr][a][a]; - dia.matrix[h][i][a] = 1.0/(Fii - Faa + L_params.cceom_energy); - } - } - } - global_dpd_->file2_mat_wrt(&dia); - global_dpd_->file2_mat_close(&dia); - global_dpd_->file2_close(&dia); - - global_dpd_->file4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, "dIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dIJAB, h); - for(ij=0; ij < dIJAB.params->rowtot[h]; ij++) { - i = dIJAB.params->roworb[h][ij][0]; - j = dIJAB.params->roworb[h][ij][1]; - isym = dIJAB.params->psym[i]; - jsym = dIJAB.params->qsym[j]; - I = i - aocc_off[isym]; - J = j - aocc_off[jsym]; - Fii = LFMIt.matrix[isym][I][I]; - Fjj = LFMIt.matrix[jsym][J][J]; - - for(ab=0; ab < dIJAB.params->coltot[h^L_irr]; ab++) { - a = dIJAB.params->colorb[h^L_irr][ab][0]; - b = dIJAB.params->colorb[h^L_irr][ab][1]; - asym = dIJAB.params->rsym[a]; - bsym = dIJAB.params->ssym[b]; - A = a - avir_off[asym]; - B = b - avir_off[bsym]; - Faa = LFAEt.matrix[asym][A][A]; - Fbb = LFAEt.matrix[bsym][B][B]; - - dIJAB.matrix[h][ij][ab] = 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy); - } - } - global_dpd_->file4_mat_irrep_wrt(&dIJAB, h); - global_dpd_->file4_mat_irrep_close(&dIJAB, h); - } - global_dpd_->file4_close(&dIJAB); - - global_dpd_->file4_init(&dijab, PSIF_CC_DENOM, L_irr, 11, 16, "dijab"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dijab, h); - for(ij=0; ij < dijab.params->rowtot[h]; ij++) { - i = dijab.params->roworb[h][ij][0]; - j = dijab.params->roworb[h][ij][1]; - isym = dijab.params->psym[i]; - jsym = dijab.params->qsym[j]; - I = i - bocc_off[isym]; - J = j - bocc_off[jsym]; - Fii = LFmit.matrix[isym][I][I]; - Fjj = LFmit.matrix[jsym][J][J]; - - for(ab=0; ab < dijab.params->coltot[h^L_irr]; ab++) { - a = dijab.params->colorb[h^L_irr][ab][0]; - b = dijab.params->colorb[h^L_irr][ab][1]; - asym = dijab.params->rsym[a]; - bsym = dijab.params->ssym[b]; - A = a - bvir_off[asym]; - B = b - bvir_off[bsym]; - Faa = LFaet.matrix[asym][A][A]; - Fbb = LFaet.matrix[bsym][B][B]; - - dijab.matrix[h][ij][ab] = 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy); - } - } - global_dpd_->file4_mat_irrep_wrt(&dijab, h); - global_dpd_->file4_mat_irrep_close(&dijab, h); - } - global_dpd_->file4_close(&dijab); - - global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 22, 28, "dIjAb"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dIjAb, h); - for(ij=0; ij < dIjAb.params->rowtot[h]; ij++) { - i = dIjAb.params->roworb[h][ij][0]; - j = dIjAb.params->roworb[h][ij][1]; - isym = dIjAb.params->psym[i]; - jsym = dIjAb.params->qsym[j]; - I = i - aocc_off[isym]; - J = j - bocc_off[jsym]; - Fii = LFMIt.matrix[isym][I][I]; - Fjj = LFmit.matrix[jsym][J][J]; - - for(ab=0; ab < dIjAb.params->coltot[h^L_irr]; ab++) { - a = dIjAb.params->colorb[h^L_irr][ab][0]; - b = dIjAb.params->colorb[h^L_irr][ab][1]; - asym = dIjAb.params->rsym[a]; - bsym = dIjAb.params->ssym[b]; - A = a - avir_off[asym]; - B = b - bvir_off[bsym]; - Faa = LFAEt.matrix[asym][A][A]; - Fbb = LFaet.matrix[bsym][B][B]; - - dIjAb.matrix[h][ij][ab] = 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy); - } - } - global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); - global_dpd_->file4_mat_irrep_close(&dIjAb, h); - } - global_dpd_->file4_close(&dIjAb); - - global_dpd_->file2_mat_close(&LFMIt); - global_dpd_->file2_mat_close(&LFmit); - global_dpd_->file2_mat_close(&LFAEt); - global_dpd_->file2_mat_close(&LFaet); - global_dpd_->file2_close(&LFMIt); - global_dpd_->file2_close(&LFmit); - global_dpd_->file2_close(&LFAEt); - global_dpd_->file2_close(&LFaet); - - /* if((!strcmp(params.wfn,"CC2")) || (!strcmp(params.wfn,"EOM_CC2"))) { */ - /* dpd_file2_init(&FMI, CC_OEI, 0, 0, 0, "FMI"); */ - /* dpd_file2_init(&Fmi, CC_OEI, 0, 2, 2, "Fmi"); */ - - /* dpd_file2_mat_init(&FMI); */ - /* dpd_file2_mat_rd(&FMI); */ - /* dpd_file2_mat_init(&Fmi); */ - /* dpd_file2_mat_rd(&Fmi); */ - - /* for(h=0; h < moinfo.nirreps; h++) { */ - /* for(m=0; m < FMI.params->rowtot[h]; m++) */ - /* FMI.matrix[h][m][m] = 0; */ - /* for(m=0; m < Fmi.params->rowtot[h]; m++) */ - /* Fmi.matrix[h][m][m] = 0; */ - /* } */ - - /* dpd_file2_mat_wrt(&FMI); */ - /* dpd_file2_mat_close(&FMI); */ - /* dpd_file2_mat_wrt(&Fmi); */ - /* dpd_file2_mat_close(&Fmi); */ - - /* dpd_file2_close(&FMI); */ - /* dpd_file2_close(&Fmi); */ - - /* dpd_file2_init(&FAE, CC_OEI, 0, 1, 1, "FAE"); */ - /* dpd_file2_init(&Fae, CC_OEI, 0, 3, 3, "Fae"); */ - - /* dpd_file2_mat_init(&FAE); */ - /* dpd_file2_mat_rd(&FAE); */ - /* dpd_file2_mat_init(&Fae); */ - /* dpd_file2_mat_rd(&Fae); */ - - /* for(h=0; h < moinfo.nirreps; h++) { */ - /* for(e=0; e < FAE.params->coltot[h]; e++) */ - /* FAE.matrix[h][e][e] = 0; */ - /* for(e=0; e < Fae.params->coltot[h]; e++) */ - /* Fae.matrix[h][e][e] = 0; */ - /* } */ - - /* dpd_file2_mat_wrt(&FAE); */ - /* dpd_file2_mat_close(&FAE); */ - /* dpd_file2_mat_wrt(&Fae); */ - /* dpd_file2_mat_close(&Fae); */ - - /* dpd_file2_close(&FAE); */ - /* dpd_file2_close(&Fae); */ - /* } */ - - return; -} -void denom_rohf(struct L_Params L_params) -{ - dpdfile2 LFAEt, LFaet, LFMIt, LFmit; - dpdfile2 dIA, dia; - dpdfile4 dIJAB, dijab, dIjAb; - dpdbuf4 d, bdIJAB, bdijab, bdIjAb; - double tval; - int nirreps,L_irr; - int h, i, j, a, b, ij, ab; - int I, J, A, B; - int isym, jsym, asym, bsym; - int *occpi, *virtpi; - int *occ_off, *vir_off; - int *openpi; - double Fii, Fjj, Faa, Fbb; - - L_irr = L_params.irrep; - nirreps = moinfo.nirreps; - occpi = moinfo.occpi; virtpi = moinfo.virtpi; - openpi = moinfo.openpi; - occ_off = moinfo.occ_off; vir_off = moinfo.vir_off; - - global_dpd_->file2_init(&LFMIt, PSIF_CC_OEI, 0, 0, 0, "FMI"); - global_dpd_->file2_mat_init(&LFMIt); - global_dpd_->file2_mat_rd(&LFMIt); - - global_dpd_->file2_init(&LFmit, PSIF_CC_OEI, 0, 0, 0, "Fmi"); - global_dpd_->file2_mat_init(&LFmit); - global_dpd_->file2_mat_rd(&LFmit); - - global_dpd_->file2_init(&LFaet, PSIF_CC_OEI, 0, 1, 1, "Fae"); - global_dpd_->file2_mat_init(&LFaet); - global_dpd_->file2_mat_rd(&LFaet); - - global_dpd_->file2_init(&LFAEt, PSIF_CC_OEI, 0, 1, 1, "FAE"); - global_dpd_->file2_mat_init(&LFAEt); - global_dpd_->file2_mat_rd(&LFAEt); - - /* Alpha one-electron denominator */ - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_mat_init(&dIA); - for(h=0; h < nirreps; h++) { /* irreps of dIA and Fii */ - for(i=0; i < occpi[h]; i++) { - Fii = LFMIt.matrix[h][i][i]; - for(a=0; a < (virtpi[h^L_irr] - openpi[h^L_irr]); a++) { - Faa = LFAEt.matrix[h^L_irr][a][a]; - dIA.matrix[h][i][a] = 1.0/(Fii - Faa + L_params.cceom_energy); - } + /* Alpha one-electron denominator */ + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_mat_init(&dIA); + for (h = 0; h < nirreps; h++) { /* irreps of dIA and Fii */ + for (i = 0; i < occpi[h]; i++) { + Fii = LFMIt.matrix[h][i][i]; + for (a = 0; a < (virtpi[h ^ L_irr] - openpi[h ^ L_irr]); a++) { + Faa = LFAEt.matrix[h ^ L_irr][a][a]; + dIA.matrix[h][i][a] = 1.0 / (Fii - Faa + L_params.cceom_energy); + } + } + } + global_dpd_->file2_mat_wrt(&dIA); + global_dpd_->file2_mat_close(&dIA); + global_dpd_->file2_close(&dIA); + + /* Beta one-electron denominator */ + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); + global_dpd_->file2_mat_init(&dia); + for (h = 0; h < nirreps; h++) { + for (i = 0; i < (occpi[h] - openpi[h]); i++) { + Fii = LFmit.matrix[h][i][i]; + for (a = 0; a < virtpi[h ^ L_irr]; a++) { + Faa = LFaet.matrix[h ^ L_irr][a][a]; + dia.matrix[h][i][a] = 1.0 / (Fii - Faa + L_params.cceom_energy); + } + } } - } - global_dpd_->file2_mat_wrt(&dIA); - global_dpd_->file2_mat_close(&dIA); - global_dpd_->file2_close(&dIA); - - /* Beta one-electron denominator */ - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); - global_dpd_->file2_mat_init(&dia); - for(h=0; h < nirreps; h++) { - for(i=0; i < (occpi[h] - openpi[h]); i++) { - Fii = LFmit.matrix[h][i][i]; - for(a=0; a < virtpi[h^L_irr]; a++) { - Faa = LFaet.matrix[h^L_irr][a][a]; - dia.matrix[h][i][a] = 1.0/(Fii - Faa + L_params.cceom_energy); - } + global_dpd_->file2_mat_wrt(&dia); + global_dpd_->file2_mat_close(&dia); + global_dpd_->file2_close(&dia); + + /* Alpha-alpha two-electron denominator */ + global_dpd_->file4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, "dIJAB"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dIJAB, h); + /* Loop over the rows */ + for (ij = 0; ij < dIJAB.params->rowtot[h]; ij++) { + i = dIJAB.params->roworb[h][ij][0]; + j = dIJAB.params->roworb[h][ij][1]; + isym = dIJAB.params->psym[i]; + jsym = dIJAB.params->qsym[j]; + + /* Convert to relative orbital index */ + I = i - occ_off[isym]; + J = j - occ_off[jsym]; + + Fii = LFMIt.matrix[isym][I][I]; + Fjj = LFMIt.matrix[jsym][J][J]; + + /* Loop over the columns */ + for (ab = 0; ab < dIJAB.params->coltot[h ^ L_irr]; ab++) { + a = dIJAB.params->colorb[h ^ L_irr][ab][0]; + b = dIJAB.params->colorb[h ^ L_irr][ab][1]; + asym = dIJAB.params->rsym[a]; + bsym = dIJAB.params->ssym[b]; + + /* Convert to relative orbital index */ + A = a - vir_off[asym]; + B = b - vir_off[bsym]; + + Faa = LFAEt.matrix[asym][A][A]; + Fbb = LFAEt.matrix[bsym][B][B]; + + dIJAB.matrix[h][ij][ab] = ((A >= (virtpi[asym] - openpi[asym])) || (B >= (virtpi[bsym] - openpi[bsym])) + ? 0.0 + : 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy)); + } + } + global_dpd_->file4_mat_irrep_wrt(&dIJAB, h); + global_dpd_->file4_mat_irrep_close(&dIJAB, h); } - } - global_dpd_->file2_mat_wrt(&dia); - global_dpd_->file2_mat_close(&dia); - global_dpd_->file2_close(&dia); - - /* Alpha-alpha two-electron denominator */ - global_dpd_->file4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, "dIJAB"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dIJAB, h); - /* Loop over the rows */ - for(ij=0; ij < dIJAB.params->rowtot[h]; ij++) { - i = dIJAB.params->roworb[h][ij][0]; - j = dIJAB.params->roworb[h][ij][1]; - isym = dIJAB.params->psym[i]; - jsym = dIJAB.params->qsym[j]; - - /* Convert to relative orbital index */ - I = i - occ_off[isym]; - J = j - occ_off[jsym]; - - Fii = LFMIt.matrix[isym][I][I]; - Fjj = LFMIt.matrix[jsym][J][J]; - - /* Loop over the columns */ - for(ab=0; ab < dIJAB.params->coltot[h^L_irr]; ab++) { - a = dIJAB.params->colorb[h^L_irr][ab][0]; - b = dIJAB.params->colorb[h^L_irr][ab][1]; - asym = dIJAB.params->rsym[a]; - bsym = dIJAB.params->ssym[b]; - - /* Convert to relative orbital index */ - A = a - vir_off[asym]; - B = b - vir_off[bsym]; - - Faa = LFAEt.matrix[asym][A][A]; - Fbb = LFAEt.matrix[bsym][B][B]; - - dIJAB.matrix[h][ij][ab] = - ((A >= (virtpi[asym] - openpi[asym])) || - (B >= (virtpi[bsym] - openpi[bsym])) ? - 0.0 : 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy)); - } - } - global_dpd_->file4_mat_irrep_wrt(&dIJAB, h); - global_dpd_->file4_mat_irrep_close(&dIJAB, h); - } - global_dpd_->file4_close(&dIJAB); - - /* Beta-beta two-electron denominator */ - global_dpd_->file4_init(&dijab, PSIF_CC_DENOM, L_irr, 1, 6, "dijab"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dijab, h); - /* Loop over the rows */ - for(ij=0; ij < dijab.params->rowtot[h]; ij++) { - i = dijab.params->roworb[h][ij][0]; - j = dijab.params->roworb[h][ij][1]; - isym = dijab.params->psym[i]; - jsym = dijab.params->qsym[j]; - - /* Convert to relative orbital index */ - I = i - occ_off[isym]; - J = j - occ_off[jsym]; - - Fii = LFmit.matrix[isym][I][I]; - Fjj = LFmit.matrix[jsym][J][J]; - - /* Loop over the columns */ - for(ab=0; ab < dijab.params->coltot[h^L_irr]; ab++) { - a = dijab.params->colorb[h^L_irr][ab][0]; - b = dijab.params->colorb[h^L_irr][ab][1]; - asym = dijab.params->rsym[a]; - bsym = dijab.params->ssym[b]; - - /* Convert to relative orbital index */ - A = a - vir_off[asym]; - B = b - vir_off[bsym]; - - Faa = LFaet.matrix[asym][A][A]; - Fbb = LFaet.matrix[bsym][B][B]; - - dijab.matrix[h][ij][ab] = - ((I >= (occpi[isym] - openpi[isym])) || - (J >= (occpi[jsym] - openpi[jsym])) ? - 0.0 : 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy)); - } + global_dpd_->file4_close(&dIJAB); + + /* Beta-beta two-electron denominator */ + global_dpd_->file4_init(&dijab, PSIF_CC_DENOM, L_irr, 1, 6, "dijab"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dijab, h); + /* Loop over the rows */ + for (ij = 0; ij < dijab.params->rowtot[h]; ij++) { + i = dijab.params->roworb[h][ij][0]; + j = dijab.params->roworb[h][ij][1]; + isym = dijab.params->psym[i]; + jsym = dijab.params->qsym[j]; + + /* Convert to relative orbital index */ + I = i - occ_off[isym]; + J = j - occ_off[jsym]; + + Fii = LFmit.matrix[isym][I][I]; + Fjj = LFmit.matrix[jsym][J][J]; + + /* Loop over the columns */ + for (ab = 0; ab < dijab.params->coltot[h ^ L_irr]; ab++) { + a = dijab.params->colorb[h ^ L_irr][ab][0]; + b = dijab.params->colorb[h ^ L_irr][ab][1]; + asym = dijab.params->rsym[a]; + bsym = dijab.params->ssym[b]; + + /* Convert to relative orbital index */ + A = a - vir_off[asym]; + B = b - vir_off[bsym]; + + Faa = LFaet.matrix[asym][A][A]; + Fbb = LFaet.matrix[bsym][B][B]; + + dijab.matrix[h][ij][ab] = ((I >= (occpi[isym] - openpi[isym])) || (J >= (occpi[jsym] - openpi[jsym])) + ? 0.0 + : 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy)); + } + } + global_dpd_->file4_mat_irrep_wrt(&dijab, h); + global_dpd_->file4_mat_irrep_close(&dijab, h); } - global_dpd_->file4_mat_irrep_wrt(&dijab, h); - global_dpd_->file4_mat_irrep_close(&dijab, h); - } - global_dpd_->file4_close(&dijab); - - - /* Alpha-beta two-electron denominator */ - global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, "dIjAb"); - - for(h=0; h < nirreps; h++) { - global_dpd_->file4_mat_irrep_init(&dIjAb, h); - /* Loop over the rows */ - for(ij=0; ij < dIjAb.params->rowtot[h]; ij++) { - i = dIjAb.params->roworb[h][ij][0]; - j = dIjAb.params->roworb[h][ij][1]; - isym = dIjAb.params->psym[i]; - jsym = dIjAb.params->qsym[j]; - - /* Convert to relative orbital index */ - I = i - occ_off[isym]; - J = j - occ_off[jsym]; - Fii = LFMIt.matrix[isym][I][I]; - Fjj = LFmit.matrix[jsym][J][J]; - - /* Loop over the columns */ - for(ab=0; ab < dIjAb.params->coltot[h^L_irr]; ab++) { - a = dIjAb.params->colorb[h^L_irr][ab][0]; - b = dIjAb.params->colorb[h^L_irr][ab][1]; - asym = dIjAb.params->rsym[a]; - bsym = dIjAb.params->ssym[b]; - - /* Convert to relative orbital index */ - A = a - vir_off[asym]; - B = b - vir_off[bsym]; - - Faa = LFAEt.matrix[asym][A][A]; - Fbb = LFaet.matrix[bsym][B][B]; - - dIjAb.matrix[h][ij][ab] = - ((A >= (virtpi[asym] - openpi[asym])) || - (J >= (occpi[jsym] - openpi[jsym])) ? - 0.0 : 1.0/(Fii + Fjj - Faa - Fbb - + L_params.cceom_energy)); + global_dpd_->file4_close(&dijab); + + /* Alpha-beta two-electron denominator */ + global_dpd_->file4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, "dIjAb"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->file4_mat_irrep_init(&dIjAb, h); + /* Loop over the rows */ + for (ij = 0; ij < dIjAb.params->rowtot[h]; ij++) { + i = dIjAb.params->roworb[h][ij][0]; + j = dIjAb.params->roworb[h][ij][1]; + isym = dIjAb.params->psym[i]; + jsym = dIjAb.params->qsym[j]; + + /* Convert to relative orbital index */ + I = i - occ_off[isym]; + J = j - occ_off[jsym]; + Fii = LFMIt.matrix[isym][I][I]; + Fjj = LFmit.matrix[jsym][J][J]; + + /* Loop over the columns */ + for (ab = 0; ab < dIjAb.params->coltot[h ^ L_irr]; ab++) { + a = dIjAb.params->colorb[h ^ L_irr][ab][0]; + b = dIjAb.params->colorb[h ^ L_irr][ab][1]; + asym = dIjAb.params->rsym[a]; + bsym = dIjAb.params->ssym[b]; + + /* Convert to relative orbital index */ + A = a - vir_off[asym]; + B = b - vir_off[bsym]; + + Faa = LFAEt.matrix[asym][A][A]; + Fbb = LFaet.matrix[bsym][B][B]; + + dIjAb.matrix[h][ij][ab] = ((A >= (virtpi[asym] - openpi[asym])) || (J >= (occpi[jsym] - openpi[jsym])) + ? 0.0 + : 1.0 / (Fii + Fjj - Faa - Fbb + L_params.cceom_energy)); } } - global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); - global_dpd_->file4_mat_irrep_close(&dIjAb, h); - } - global_dpd_->file4_close(&dIjAb); - - global_dpd_->file2_mat_close(&LFMIt); - global_dpd_->file2_mat_close(&LFmit); - global_dpd_->file2_mat_close(&LFAEt); - global_dpd_->file2_mat_close(&LFaet); - global_dpd_->file2_close(&LFMIt); - global_dpd_->file2_close(&LFmit); - global_dpd_->file2_close(&LFAEt); - global_dpd_->file2_close(&LFaet); - - return; + global_dpd_->file4_mat_irrep_wrt(&dIjAb, h); + global_dpd_->file4_mat_irrep_close(&dIjAb, h); + } + global_dpd_->file4_close(&dIjAb); + + global_dpd_->file2_mat_close(&LFMIt); + global_dpd_->file2_mat_close(&LFmit); + global_dpd_->file2_mat_close(&LFAEt); + global_dpd_->file2_mat_close(&LFaet); + global_dpd_->file2_close(&LFMIt); + global_dpd_->file2_close(&LFmit); + global_dpd_->file2_close(&LFAEt); + global_dpd_->file2_close(&LFaet); + + return; } - - - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/diis.cc b/psi4/src/psi4/cclambda/diis.cc index aff0d7f9cb4..3957fdf2f1a 100644 --- a/psi4/src/psi4/cclambda/diis.cc +++ b/psi4/src/psi4/cclambda/diis.cc @@ -45,7 +45,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* ** DIIS: Direct inversion in the iterative subspace routine to @@ -61,831 +62,796 @@ namespace psi { namespace cclambda { ** -TDC 12/22/01 */ -void CCLambdaWavefunction::diis(int iter, int L_irr) -{ - int nvector=8; /* Number of error vectors to keep */ - int h, nirreps; - int row, col, word, p, q, i; - int diis_cycle; - int vector_length=0; - int errcod, *ipiv; - dpdfile2 L1, L1a, L1b; - dpdbuf4 L2, L2a, L2b, L2c; - psio_address start, end, next; - double **error; - double **B, *C, **vector; - double product, determinant, maximum; - - nirreps = moinfo.nirreps; - - if(params.ref == 0) { /** RHF **/ - /* Compute the length of a single error vector */ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - vector_length += L1.params->rowtot[h] * L1.params->coltot[h^L_irr]; - vector_length += L2.params->rowtot[h] * L2.params->coltot[h^L_irr]; - } - global_dpd_->file2_close(&L1); - global_dpd_->buf4_close(&L2); - - /* Set the diis cycle value */ - diis_cycle = (iter-1) % nvector; - - /* Build the current error vector and dump it to disk */ - error = global_dpd_->dpd_block_matrix(1,vector_length); - - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - /*dpd_file2_print(&L1a,outfile);*/ - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - /*dpd_file2_print(&L1b,outfile);*/ - global_dpd_->file2_mat_init(&L1b); - global_dpd_->file2_mat_rd(&L1b); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) { - error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; - } - - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - global_dpd_->file2_mat_close(&L1b); - global_dpd_->file2_close(&L1b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - /*dpd_buf4_print(&L2a,outfile,1);*/ - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - /*dpd_buf4_print(&L2b,outfile,1);*/ - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) { - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; -/* outfile->Printf("%15.10lf\n", error[0][word-1]); */ - } - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_ERR, "DIIS Error Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - - /* Store the current amplitude vector on disk */ - word=0; - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - /* If we haven't run through enough iterations, set the correct dimensions - for the extrapolation */ - if(!(iter >= (nvector))) { - if(iter < 2) { /* Leave if we can't extrapolate at all */ +void CCLambdaWavefunction::diis(int iter, int L_irr) { + int nvector = 8; /* Number of error vectors to keep */ + int h, nirreps; + int row, col, word, p, q, i; + int diis_cycle; + int vector_length = 0; + int errcod, *ipiv; + dpdfile2 L1, L1a, L1b; + dpdbuf4 L2, L2a, L2b, L2c; + psio_address start, end, next; + double **error; + double **B, *C, **vector; + double product, determinant, maximum; + + nirreps = moinfo.nirreps; + + if (params.ref == 0) { /** RHF **/ + /* Compute the length of a single error vector */ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + vector_length += L1.params->rowtot[h] * L1.params->coltot[h ^ L_irr]; + vector_length += L2.params->rowtot[h] * L2.params->coltot[h ^ L_irr]; + } + global_dpd_->file2_close(&L1); + global_dpd_->buf4_close(&L2); + + /* Set the diis cycle value */ + diis_cycle = (iter - 1) % nvector; + + /* Build the current error vector and dump it to disk */ + error = global_dpd_->dpd_block_matrix(1, vector_length); + + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + /*dpd_file2_print(&L1a,outfile);*/ + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + /*dpd_file2_print(&L1b,outfile);*/ + global_dpd_->file2_mat_init(&L1b); + global_dpd_->file2_mat_rd(&L1b); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) { + error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; + } + + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + global_dpd_->file2_mat_close(&L1b); + global_dpd_->file2_close(&L1b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + /*dpd_buf4_print(&L2a,outfile,1);*/ + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + /*dpd_buf4_print(&L2b,outfile,1);*/ + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) { + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + /* outfile->Printf("%15.10lf\n", error[0][word-1]); */ + } + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* Store the current amplitude vector on disk */ + word = 0; + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L1a.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* If we haven't run through enough iterations, set the correct dimensions + for the extrapolation */ + if (!(iter >= (nvector))) { + if (iter < 2) { /* Leave if we can't extrapolate at all */ + global_dpd_->free_dpd_block(error, 1, vector_length); + return; + } + nvector = iter; + } + + /* Build B matrix of error vector products */ + vector = global_dpd_->dpd_block_matrix(2, vector_length); + B = block_matrix(nvector + 1, nvector + 1); + for (p = 0; p < nvector; p++) { + start = psio_get_address(PSIO_ZERO, p * vector_length * sizeof(double)); + + psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *)vector[0], vector_length * sizeof(double), start, + &end); + + /* + for(i=0; i < vector_length; i++) + outfile->Printf("E[%d][%d] = %20.15lf\n",p,i,vector[0][i]); + */ + + // dot_arr(vector[0], vector[0], vector_length, &product); + product = C_DDOT(vector_length, vector[0], 1, vector[0], 1); + + B[p][p] = product; + + for (q = 0; q < p; q++) { + start = psio_get_address(PSIO_ZERO, q * vector_length * sizeof(double)); + + psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *)vector[1], vector_length * sizeof(double), + start, &end); + + // dot_arr(vector[1], vector[0], vector_length, &product); + product = C_DDOT(vector_length, vector[1], 1, vector[0], 1); + + B[p][q] = B[q][p] = product; + } + } + global_dpd_->free_dpd_block(vector, 2, vector_length); + + for (p = 0; p < nvector; p++) { + B[p][nvector] = -1; + B[nvector][p] = -1; + } + + B[nvector][nvector] = 0; + + /* Find the maximum value in B and scale all its elements */ + maximum = std::fabs(B[0][0]); + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) + if (std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); + + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) B[p][q] /= maximum; + + /* + outfile->Printf("\nDIIS B:\n"); + print_mat(B,nvector,nvector,outfile); + */ + + /* Build the constant vector */ + C = init_array(nvector + 1); + C[nvector] = -1; + + /* Solve the linear equations */ + ipiv = init_int_array(nvector + 1); + + errcod = C_DGESV(nvector + 1, 1, &(B[0][0]), nvector + 1, &(ipiv[0]), &(C[0]), nvector + 1); + if (errcod) { + outfile->Printf("\nError in DGESV return in diis.\n"); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } + + /* Build a new amplitude vector from the old ones */ + vector = global_dpd_->dpd_block_matrix(1, vector_length); + for (p = 0; p < vector_length; p++) error[0][p] = 0.0; + for (p = 0; p < nvector; p++) { + /*outfile->Printf("C[%d] = %20.15lf\n",p,C[p]);*/ + + start = psio_get_address(PSIO_ZERO, p * vector_length * sizeof(double)); + + psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)vector[0], vector_length * sizeof(double), + start, &end); + + for (q = 0; q < vector_length; q++) error[0][q] += C[p] * vector[0][q]; + } + global_dpd_->free_dpd_block(vector, 1, vector_length); + + /* Now place these elements into the DPD amplitude arrays */ + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) L1a.matrix[h][row][col] = error[0][word++]; + global_dpd_->file2_mat_wrt(&L1a); + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_copy(&L1a, PSIF_CC_LAMBDA, "New Lia"); /* to be removed after spin-adaptation */ + /*dpd_file2_print(&L1a,outfile);*/ + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + /* to be removed after spin-adaptation */ + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 0, 5, 1, "New LIjAb"); + global_dpd_->buf4_copy(&L2a, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_copy(&L2a, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&L2a); + + /* Release memory and return */ + /* free_matrix(vector, nvector); */ + free_block(B); + free(C); + free(ipiv); global_dpd_->free_dpd_block(error, 1, vector_length); - return; - } - nvector = iter; - } - - /* Build B matrix of error vector products */ - vector = global_dpd_->dpd_block_matrix(2, vector_length); - B = block_matrix(nvector+1,nvector+1); - for(p=0; p < nvector; p++) { - - start = psio_get_address(PSIO_ZERO, p*vector_length*sizeof(double)); - - psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *) vector[0], - vector_length*sizeof(double), start, &end); - - /* - for(i=0; i < vector_length; i++) - outfile->Printf("E[%d][%d] = %20.15lf\n",p,i,vector[0][i]); - */ - - // dot_arr(vector[0], vector[0], vector_length, &product); - product = C_DDOT(vector_length, vector[0], 1, vector[0], 1); - - B[p][p] = product; - - for(q=0; q < p; q++) { - - start = psio_get_address(PSIO_ZERO, q*vector_length*sizeof(double)); - - psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *) vector[1], - vector_length*sizeof(double), start, &end); - - // dot_arr(vector[1], vector[0], vector_length, &product); - product = C_DDOT(vector_length, vector[1], 1, vector[0], 1); - - B[p][q] = B[q][p] = product; - } - } - global_dpd_->free_dpd_block(vector, 2, vector_length); - - for(p=0; p < nvector; p++) { - B[p][nvector] = -1; - B[nvector][p] = -1; - } - - B[nvector][nvector] = 0; - - /* Find the maximum value in B and scale all its elements */ - maximum = std::fabs(B[0][0]); - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - if(std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); - - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - B[p][q] /= maximum; - - /* - outfile->Printf("\nDIIS B:\n"); - print_mat(B,nvector,nvector,outfile); - */ - - /* Build the constant vector */ - C = init_array(nvector+1); - C[nvector] = -1; - - /* Solve the linear equations */ - ipiv = init_int_array(nvector+1); - - errcod = C_DGESV(nvector+1, 1, &(B[0][0]), nvector+1, &(ipiv[0]), &(C[0]), nvector+1); - if(errcod) { - outfile->Printf( "\nError in DGESV return in diis.\n"); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } - - /* Build a new amplitude vector from the old ones */ - vector = global_dpd_->dpd_block_matrix(1, vector_length); - for(p=0; p < vector_length; p++) error[0][p] = 0.0; - for(p=0; p < nvector; p++) { - /*outfile->Printf("C[%d] = %20.15lf\n",p,C[p]);*/ - - start = psio_get_address(PSIO_ZERO, p*vector_length*sizeof(double)); - - psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *) vector[0], - vector_length*sizeof(double), start, &end); - - for(q=0; q < vector_length; q++) - error[0][q] += C[p] * vector[0][q]; - - } - global_dpd_->free_dpd_block(vector, 1, vector_length); - - /* Now place these elements into the DPD amplitude arrays */ - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - L1a.matrix[h][row][col] = error[0][word++]; - global_dpd_->file2_mat_wrt(&L1a); - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_copy(&L1a, PSIF_CC_LAMBDA, "New Lia"); /* to be removed after spin-adaptation */ - /*dpd_file2_print(&L1a,outfile);*/ - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - /* to be removed after spin-adaptation */ - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 0, 5, 1, "New LIjAb"); - global_dpd_->buf4_copy(&L2a, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_copy(&L2a, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&L2a); - - /* Release memory and return */ - /* free_matrix(vector, nvector); */ - free_block(B); - free(C); - free(ipiv); - global_dpd_->free_dpd_block(error, 1, vector_length); - } - else if(params.ref == 1) { /** ROHF **/ - - /* Compute the length of a single error vector */ - /* RAK changed file nums here from CC_TMP0 */ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - vector_length += 2 * L1.params->rowtot[h] * L1.params->coltot[h^L_irr]; - vector_length += 2 * L2a.params->rowtot[h] * L2a.params->coltot[h^L_irr]; - vector_length += L2b.params->rowtot[h] * L2b.params->coltot[h^L_irr]; - } - global_dpd_->file2_close(&L1); - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - /* Set the diis cycle value */ - diis_cycle = (iter-1) % nvector; - - /* Build the current error vector and dump it to disk */ - error = global_dpd_->dpd_block_matrix(1,vector_length); - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&L1b); - global_dpd_->file2_mat_rd(&L1b); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - global_dpd_->file2_mat_close(&L1b); - global_dpd_->file2_close(&L1b); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_mat_init(&L1b); - global_dpd_->file2_mat_rd(&L1b); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - global_dpd_->file2_mat_close(&L1b); - global_dpd_->file2_close(&L1b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_ERR, "DIIS Error Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - /* Store the current amplitude vector on disk */ - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - /* If we haven't run through enough iterations, set the correct dimensions - for the extrapolation */ - if(!(iter >= (nvector))) { - if(iter < 2) { /* Leave if we can't extrapolate at all */ - free(error); - return; - } - nvector = iter; - } - - /* Now grab the full set of error vectors from the file */ - vector = init_matrix(nvector, vector_length); - next = PSIO_ZERO; - for(p=0; p < nvector; p++) - psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *) vector[p], - vector_length*sizeof(double), next, &next); - - /* Build B matrix of error vector products */ - B = init_matrix(nvector+1,nvector+1); - - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) { - // dot_arr(vector[p], vector[q], vector_length, &product); - product = C_DDOT(vector_length, vector[p], 1, vector[q], 1); - B[p][q] = product; - } - - for(p=0; p < nvector; p++) { - B[p][nvector] = -1; - B[nvector][p] = -1; - } - - B[nvector][nvector] = 0; - - /* Find the maximum value in B and scale all its elements */ - maximum = std::fabs(B[0][0]); - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - if(std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); - - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - B[p][q] /= maximum; - - /* Build the constant vector */ - C = init_array(nvector+1); - C[nvector] = -1; - - /* Solve the linear equations */ - flin(B, C, nvector+1, 1, &determinant); - - /* Grab the old amplitude vectors */ - next = PSIO_ZERO; - for(p=0; p < nvector; p++) - psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *) vector[p], - vector_length*sizeof(double), next, &next); - - /* Build the new amplitude vector from the old ones */ - for(q=0; q < vector_length; q++) { - error[0][q] = 0.0; - for(p=0; p < nvector; p++) - error[0][q] += C[p] * vector[p][q]; - } - - /* Now place these elements into the DPD amplitude arrays */ - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - L1a.matrix[h][row][col] = error[0][word++]; - global_dpd_->file2_mat_wrt(&L1a); - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - L1a.matrix[h][row][col] = error[0][word++]; - global_dpd_->file2_mat_wrt(&L1a); - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - /* Release memory and return */ - free_matrix(vector, nvector); - free_matrix(B, nvector+1); - free(C); - global_dpd_->free_dpd_block(error, 1, vector_length); - } /** ROHF **/ - else if(params.ref == 2) { /** UHF **/ - - /* Compute the length of a single error vector */ - global_dpd_->file2_init(&L1a, PSIF_CC_TMP0, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&L1b, PSIF_CC_TMP0, L_irr, 2, 3, "Lia"); - global_dpd_->buf4_init(&L2a, PSIF_CC_TMP0, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&L2b, PSIF_CC_TMP0, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&L2c, PSIF_CC_TMP0, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - vector_length += L1a.params->rowtot[h] * L1a.params->coltot[h^L_irr]; - vector_length += L1b.params->rowtot[h] * L1b.params->coltot[h^L_irr]; - vector_length += L2a.params->rowtot[h] * L2a.params->coltot[h^L_irr]; - vector_length += L2b.params->rowtot[h] * L2b.params->coltot[h^L_irr]; - vector_length += L2c.params->rowtot[h] * L2c.params->coltot[h^L_irr]; - } - global_dpd_->file2_close(&L1a); - global_dpd_->file2_close(&L1b); - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - global_dpd_->buf4_close(&L2c); - - /* Set the diis cycle value */ - diis_cycle = (iter-1) % nvector; - - /* Build the current error vector and dump it to disk */ - error = global_dpd_->dpd_block_matrix(1,vector_length); - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_mat_init(&L1b); - global_dpd_->file2_mat_rd(&L1b); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - global_dpd_->file2_mat_close(&L1b); - global_dpd_->file2_close(&L1b); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_mat_init(&L1b); - global_dpd_->file2_mat_rd(&L1b); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - global_dpd_->file2_mat_close(&L1b); - global_dpd_->file2_close(&L1b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - global_dpd_->buf4_mat_irrep_init(&L2b, h); - global_dpd_->buf4_mat_irrep_rd(&L2b, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2b, h); - } - global_dpd_->buf4_close(&L2a); - global_dpd_->buf4_close(&L2b); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_ERR, "DIIS Error[0] Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - /* Store the current amplitude vector on disk */ - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - global_dpd_->file2_mat_rd(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - error[0][word++] = L1a.matrix[h][row][col]; - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - global_dpd_->buf4_mat_irrep_rd(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - error[0][word++] = L2a.matrix[h][row][col]; - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - start = psio_get_address(PSIO_ZERO, diis_cycle*vector_length*sizeof(double)); - psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors" , (char *) error[0], - vector_length*sizeof(double), start, &end); - - /* If we haven't run through enough iterations, set the correct dimensions - for the extrapolation */ - if(!(iter >= (nvector))) { - if(iter < 2) { /* Leave if we can't extrapolate at all */ - free(error[0]); - return; - } - nvector = iter; - } - - /* Now grab the full set of error[0] vectors from the file */ - vector = init_matrix(nvector, vector_length); - next = PSIO_ZERO; - for(p=0; p < nvector; p++) - psio_read(PSIF_CC_DIIS_ERR, "DIIS Error[0] Vectors", (char *) vector[p], - vector_length*sizeof(double), next, &next); - - /* Build B matrix of error[0] vector products */ - B = init_matrix(nvector+1,nvector+1); - - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) { - // dot_arr(vector[p], vector[q], vector_length, &product); - product = C_DDOT(vector_length, vector[p], 1, vector[q], 1); - B[p][q] = product; - } - - for(p=0; p < nvector; p++) { - B[p][nvector] = -1; - B[nvector][p] = -1; - } - - B[nvector][nvector] = 0; - - /* Find the maximum value in B and scale all its elements */ - maximum = std::fabs(B[0][0]); - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - if(std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); - - for(p=0; p < nvector; p++) - for(q=0; q < nvector; q++) - B[p][q] /= maximum; - - /* Build the constant vector */ - C = init_array(nvector+1); - C[nvector] = -1; - - /* Solve the linear equations */ - flin(B, C, nvector+1, 1, &determinant); - - /* Grab the old amplitude vectors */ - next = PSIO_ZERO; - for(p=0; p < nvector; p++) - psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *) vector[p], - vector_length*sizeof(double), next, &next); - - /* Build the new amplitude vector from the old ones */ - for(q=0; q < vector_length; q++) { - error[0][q] = 0.0; - for(p=0; p < nvector; p++) - error[0][q] += C[p] * vector[p][q]; - } - - /* Now place these elements into the DPD amplitude arrays */ - word=0; - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); - global_dpd_->file2_mat_init(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - L1a.matrix[h][row][col] = error[0][word++]; - global_dpd_->file2_mat_wrt(&L1a); - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); - global_dpd_->file2_mat_init(&L1a); - for(h=0; h < nirreps; h++) - for(row=0; row < L1a.params->rowtot[h]; row++) - for(col=0; col < L1a.params->coltot[h^L_irr]; col++) - L1a.matrix[h][row][col] = error[0][word++]; - global_dpd_->file2_mat_wrt(&L1a); - global_dpd_->file2_mat_close(&L1a); - global_dpd_->file2_close(&L1a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2a, h); - for(row=0; row < L2a.params->rowtot[h]; row++) - for(col=0; col < L2a.params->coltot[h^L_irr]; col++) - L2a.matrix[h][row][col] = error[0][word++]; - global_dpd_->buf4_mat_irrep_wrt(&L2a, h); - global_dpd_->buf4_mat_irrep_close(&L2a, h); - } - global_dpd_->buf4_close(&L2a); - - /* Release memory and return */ - free_matrix(vector, nvector); - free_matrix(B, nvector+1); - free(C); - global_dpd_->free_dpd_block(error, 1, vector_length); - } /** UHF **/ - - return; + } else if (params.ref == 1) { /** ROHF **/ + + /* Compute the length of a single error vector */ + /* RAK changed file nums here from CC_TMP0 */ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + vector_length += 2 * L1.params->rowtot[h] * L1.params->coltot[h ^ L_irr]; + vector_length += 2 * L2a.params->rowtot[h] * L2a.params->coltot[h ^ L_irr]; + vector_length += L2b.params->rowtot[h] * L2b.params->coltot[h ^ L_irr]; + } + global_dpd_->file2_close(&L1); + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + /* Set the diis cycle value */ + diis_cycle = (iter - 1) % nvector; + + /* Build the current error vector and dump it to disk */ + error = global_dpd_->dpd_block_matrix(1, vector_length); + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_mat_init(&L1b); + global_dpd_->file2_mat_rd(&L1b); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + global_dpd_->file2_mat_close(&L1b); + global_dpd_->file2_close(&L1b); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_mat_init(&L1b); + global_dpd_->file2_mat_rd(&L1b); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + global_dpd_->file2_mat_close(&L1b); + global_dpd_->file2_close(&L1b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* Store the current amplitude vector on disk */ + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L1a.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L1a.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* If we haven't run through enough iterations, set the correct dimensions + for the extrapolation */ + if (!(iter >= (nvector))) { + if (iter < 2) { /* Leave if we can't extrapolate at all */ + free(error); + return; + } + nvector = iter; + } + + /* Now grab the full set of error vectors from the file */ + vector = init_matrix(nvector, vector_length); + next = PSIO_ZERO; + for (p = 0; p < nvector; p++) + psio_read(PSIF_CC_DIIS_ERR, "DIIS Error Vectors", (char *)vector[p], vector_length * sizeof(double), next, + &next); + + /* Build B matrix of error vector products */ + B = init_matrix(nvector + 1, nvector + 1); + + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) { + // dot_arr(vector[p], vector[q], vector_length, &product); + product = C_DDOT(vector_length, vector[p], 1, vector[q], 1); + B[p][q] = product; + } + + for (p = 0; p < nvector; p++) { + B[p][nvector] = -1; + B[nvector][p] = -1; + } + + B[nvector][nvector] = 0; + + /* Find the maximum value in B and scale all its elements */ + maximum = std::fabs(B[0][0]); + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) + if (std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); + + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) B[p][q] /= maximum; + + /* Build the constant vector */ + C = init_array(nvector + 1); + C[nvector] = -1; + + /* Solve the linear equations */ + flin(B, C, nvector + 1, 1, &determinant); + + /* Grab the old amplitude vectors */ + next = PSIO_ZERO; + for (p = 0; p < nvector; p++) + psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)vector[p], vector_length * sizeof(double), + next, &next); + + /* Build the new amplitude vector from the old ones */ + for (q = 0; q < vector_length; q++) { + error[0][q] = 0.0; + for (p = 0; p < nvector; p++) error[0][q] += C[p] * vector[p][q]; + } + + /* Now place these elements into the DPD amplitude arrays */ + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) L1a.matrix[h][row][col] = error[0][word++]; + global_dpd_->file2_mat_wrt(&L1a); + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) L1a.matrix[h][row][col] = error[0][word++]; + global_dpd_->file2_mat_wrt(&L1a); + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + /* Release memory and return */ + free_matrix(vector, nvector); + free_matrix(B, nvector + 1); + free(C); + global_dpd_->free_dpd_block(error, 1, vector_length); + } /** ROHF **/ + else if (params.ref == 2) { /** UHF **/ + + /* Compute the length of a single error vector */ + global_dpd_->file2_init(&L1a, PSIF_CC_TMP0, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&L1b, PSIF_CC_TMP0, L_irr, 2, 3, "Lia"); + global_dpd_->buf4_init(&L2a, PSIF_CC_TMP0, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&L2b, PSIF_CC_TMP0, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&L2c, PSIF_CC_TMP0, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + vector_length += L1a.params->rowtot[h] * L1a.params->coltot[h ^ L_irr]; + vector_length += L1b.params->rowtot[h] * L1b.params->coltot[h ^ L_irr]; + vector_length += L2a.params->rowtot[h] * L2a.params->coltot[h ^ L_irr]; + vector_length += L2b.params->rowtot[h] * L2b.params->coltot[h ^ L_irr]; + vector_length += L2c.params->rowtot[h] * L2c.params->coltot[h ^ L_irr]; + } + global_dpd_->file2_close(&L1a); + global_dpd_->file2_close(&L1b); + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + global_dpd_->buf4_close(&L2c); + + /* Set the diis cycle value */ + diis_cycle = (iter - 1) % nvector; + + /* Build the current error vector and dump it to disk */ + error = global_dpd_->dpd_block_matrix(1, vector_length); + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_mat_init(&L1b); + global_dpd_->file2_mat_rd(&L1b); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + global_dpd_->file2_mat_close(&L1b); + global_dpd_->file2_close(&L1b); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + global_dpd_->file2_init(&L1b, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_mat_init(&L1b); + global_dpd_->file2_mat_rd(&L1b); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L1a.matrix[h][row][col] - L1b.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + global_dpd_->file2_mat_close(&L1b); + global_dpd_->file2_close(&L1b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2b, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + global_dpd_->buf4_mat_irrep_init(&L2b, h); + global_dpd_->buf4_mat_irrep_rd(&L2b, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) + error[0][word++] = L2a.matrix[h][row][col] - L2b.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2b, h); + } + global_dpd_->buf4_close(&L2a); + global_dpd_->buf4_close(&L2b); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_ERR, "DIIS Error[0] Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* Store the current amplitude vector on disk */ + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L1a.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + global_dpd_->file2_mat_rd(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L1a.matrix[h][row][col]; + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + global_dpd_->buf4_mat_irrep_rd(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) error[0][word++] = L2a.matrix[h][row][col]; + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + start = psio_get_address(PSIO_ZERO, diis_cycle * vector_length * sizeof(double)); + psio_write(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)error[0], vector_length * sizeof(double), start, + &end); + + /* If we haven't run through enough iterations, set the correct dimensions + for the extrapolation */ + if (!(iter >= (nvector))) { + if (iter < 2) { /* Leave if we can't extrapolate at all */ + free(error[0]); + return; + } + nvector = iter; + } + + /* Now grab the full set of error[0] vectors from the file */ + vector = init_matrix(nvector, vector_length); + next = PSIO_ZERO; + for (p = 0; p < nvector; p++) + psio_read(PSIF_CC_DIIS_ERR, "DIIS Error[0] Vectors", (char *)vector[p], vector_length * sizeof(double), + next, &next); + + /* Build B matrix of error[0] vector products */ + B = init_matrix(nvector + 1, nvector + 1); + + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) { + // dot_arr(vector[p], vector[q], vector_length, &product); + product = C_DDOT(vector_length, vector[p], 1, vector[q], 1); + B[p][q] = product; + } + + for (p = 0; p < nvector; p++) { + B[p][nvector] = -1; + B[nvector][p] = -1; + } + + B[nvector][nvector] = 0; + + /* Find the maximum value in B and scale all its elements */ + maximum = std::fabs(B[0][0]); + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) + if (std::fabs(B[p][q]) > maximum) maximum = std::fabs(B[p][q]); + + for (p = 0; p < nvector; p++) + for (q = 0; q < nvector; q++) B[p][q] /= maximum; + + /* Build the constant vector */ + C = init_array(nvector + 1); + C[nvector] = -1; + + /* Solve the linear equations */ + flin(B, C, nvector + 1, 1, &determinant); + + /* Grab the old amplitude vectors */ + next = PSIO_ZERO; + for (p = 0; p < nvector; p++) + psio_read(PSIF_CC_DIIS_AMP, "DIIS Amplitude Vectors", (char *)vector[p], vector_length * sizeof(double), + next, &next); + + /* Build the new amplitude vector from the old ones */ + for (q = 0; q < vector_length; q++) { + error[0][q] = 0.0; + for (p = 0; p < nvector; p++) error[0][q] += C[p] * vector[p][q]; + } + + /* Now place these elements into the DPD amplitude arrays */ + word = 0; + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 0, 1, "New LIA"); + global_dpd_->file2_mat_init(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) L1a.matrix[h][row][col] = error[0][word++]; + global_dpd_->file2_mat_wrt(&L1a); + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->file2_init(&L1a, PSIF_CC_LAMBDA, L_irr, 2, 3, "New Lia"); + global_dpd_->file2_mat_init(&L1a); + for (h = 0; h < nirreps; h++) + for (row = 0; row < L1a.params->rowtot[h]; row++) + for (col = 0; col < L1a.params->coltot[h ^ L_irr]; col++) L1a.matrix[h][row][col] = error[0][word++]; + global_dpd_->file2_mat_wrt(&L1a); + global_dpd_->file2_mat_close(&L1a); + global_dpd_->file2_close(&L1a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + global_dpd_->buf4_init(&L2a, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2a, h); + for (row = 0; row < L2a.params->rowtot[h]; row++) + for (col = 0; col < L2a.params->coltot[h ^ L_irr]; col++) L2a.matrix[h][row][col] = error[0][word++]; + global_dpd_->buf4_mat_irrep_wrt(&L2a, h); + global_dpd_->buf4_mat_irrep_close(&L2a, h); + } + global_dpd_->buf4_close(&L2a); + + /* Release memory and return */ + free_matrix(vector, nvector); + free_matrix(B, nvector + 1); + free(C); + global_dpd_->free_dpd_block(error, 1, vector_length); + } /** UHF **/ + + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/dijabL2.cc b/psi4/src/psi4/cclambda/dijabL2.cc index d29bff6c64d..04c8d0e9958 100644 --- a/psi4/src/psi4/cclambda/dijabL2.cc +++ b/psi4/src/psi4/cclambda/dijabL2.cc @@ -37,126 +37,124 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void local_filter_T1(dpdfile2 *T1); void local_filter_T2(dpdbuf4 *T2); -void dijabL2(int L_irr) -{ - dpdbuf4 L2, newLIJAB, newLijab, newLIjAb; - dpdbuf4 d2, dIJAB, dijab, dIjAb; - - if(params.ref == 0) { /** RHF **/ - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_copy(&newLIjAb, PSIF_CC_LAMBDA, "New LIjAb Increment"); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); - if(params.local) local_filter_T2(&newLIjAb); - else { - global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&dIjAb, &newLIjAb); - global_dpd_->buf4_close(&dIjAb); +void dijabL2(int L_irr) { + dpdbuf4 L2, newLIJAB, newLijab, newLIjAb; + dpdbuf4 d2, dIJAB, dijab, dIjAb; + + if (params.ref == 0) { /** RHF **/ + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_copy(&newLIjAb, PSIF_CC_LAMBDA, "New LIjAb Increment"); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); + if (params.local) + local_filter_T2(&newLIjAb); + else { + global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&dIjAb, &newLIjAb); + global_dpd_->buf4_close(&dIjAb); + } + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); + global_dpd_->buf4_axpy(&L2, &newLIjAb, 1); + global_dpd_->buf4_close(&L2); + /*dpd_buf4_print(&newLIjAb,outfile,1);*/ + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 0, 5, 1, "New LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 1) { /** ROHF **/ + + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_copy(&newLIJAB, PSIF_CC_LAMBDA, "New LIJAB Increment"); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB Increment"); + global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dIJAB"); + global_dpd_->buf4_dirprd(&dIJAB, &newLIJAB); + global_dpd_->buf4_close(&dIJAB); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB Increment"); + global_dpd_->buf4_axpy(&L2, &newLIJAB, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&newLIJAB); + + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_copy(&newLijab, PSIF_CC_LAMBDA, "New Lijab Increment"); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab Increment"); + global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dijab"); + global_dpd_->buf4_dirprd(&dijab, &newLijab); + global_dpd_->buf4_close(&dijab); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab Increment"); + global_dpd_->buf4_axpy(&L2, &newLijab, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&newLijab); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_copy(&newLIjAb, PSIF_CC_LAMBDA, "New LIjAb Increment"); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); + global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&dIjAb, &newLIjAb); + global_dpd_->buf4_close(&dIjAb); + global_dpd_->buf4_close(&newLIjAb); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIjAb"); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); + global_dpd_->buf4_axpy(&L2, &newLIjAb, 1); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&newLIjAb); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); + global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dIJAB"); + global_dpd_->buf4_dirprd(&d2, &L2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&d2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); + global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 11, 16, 11, 16, 0, "dijab"); + global_dpd_->buf4_dirprd(&d2, &L2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&d2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); + global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 22, 28, 22, 28, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&d2, &L2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&d2); } - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); - global_dpd_->buf4_axpy(&L2, &newLIjAb, 1); - global_dpd_->buf4_close(&L2); - /*dpd_buf4_print(&newLIjAb,outfile,1);*/ - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 0, 5, 1, "New LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 1) { /** ROHF **/ - - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_copy(&newLIJAB, PSIF_CC_LAMBDA, "New LIJAB Increment"); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB Increment"); - global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dIJAB"); - global_dpd_->buf4_dirprd(&dIJAB, &newLIJAB); - global_dpd_->buf4_close(&dIJAB); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIJAB"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&newLIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB Increment"); - global_dpd_->buf4_axpy(&L2, &newLIJAB, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&newLIJAB); - - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_copy(&newLijab, PSIF_CC_LAMBDA, "New Lijab Increment"); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab Increment"); - global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dijab"); - global_dpd_->buf4_dirprd(&dijab, &newLijab); - global_dpd_->buf4_close(&dijab); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New Lijab"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&newLijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New Lijab Increment"); - global_dpd_->buf4_axpy(&L2, &newLijab, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&newLijab); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_copy(&newLIjAb, PSIF_CC_LAMBDA, "New LIjAb Increment"); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); - global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&dIjAb, &newLIjAb); - global_dpd_->buf4_close(&dIjAb); - global_dpd_->buf4_close(&newLIjAb); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_copy(&L2, PSIF_CC_LAMBDA, "New LIjAb"); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&newLIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "New LIjAb Increment"); - global_dpd_->buf4_axpy(&L2, &newLIjAb, 1); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&newLIjAb); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "New LIJAB"); - global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 1, 6, 1, 6, 0, "dIJAB"); - global_dpd_->buf4_dirprd(&d2, &L2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&d2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "New Lijab"); - global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 11, 16, 11, 16, 0, "dijab"); - global_dpd_->buf4_dirprd(&d2, &L2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&d2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "New LIjAb"); - global_dpd_->buf4_init(&d2, PSIF_CC_DENOM, L_irr, 22, 28, 22, 28, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&d2, &L2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&d2); - - } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/get_moinfo.cc b/psi4/src/psi4/cclambda/get_moinfo.cc index 9c58ca7cafc..513aafed364 100644 --- a/psi4/src/psi4/cclambda/get_moinfo.cc +++ b/psi4/src/psi4/cclambda/get_moinfo.cc @@ -44,7 +44,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* ** get_moinfo(wfn): Routine to obtain basic orbital information from @@ -55,9 +56,8 @@ namespace psi { namespace cclambda { ** Modified for UHF references by TDC, June 2002. */ -void CCLambdaWavefunction::get_moinfo(std::shared_ptr wfn) -{ - int i,j, h, p, q, errcod, nactive, nirreps, sym; +void CCLambdaWavefunction::get_moinfo(std::shared_ptr wfn) { + int i, j, h, p, q, errcod, nactive, nirreps, sym; double ***C, ***Ca, ***Cb; psio_address next; @@ -67,7 +67,7 @@ void CCLambdaWavefunction::get_moinfo(std::shared_ptr wfn) moinfo.nao = wfn->basisset()->nao(); moinfo.labels = wfn->molecule()->irrep_labels(); moinfo.enuc = wfn->molecule()->nuclear_repulsion_energy(wfn->get_dipole_field_strength()); - if(wfn->reference_wavefunction()) + if (wfn->reference_wavefunction()) moinfo.escf = wfn->reference_wavefunction()->reference_energy(); else moinfo.escf = wfn->reference_energy(); @@ -76,7 +76,7 @@ void CCLambdaWavefunction::get_moinfo(std::shared_ptr wfn) moinfo.orbspi = init_int_array(moinfo.nirreps); moinfo.clsdpi = init_int_array(moinfo.nirreps); moinfo.openpi = init_int_array(moinfo.nirreps); - for(int h = 0; h < moinfo.nirreps; ++h){ + for (int h = 0; h < moinfo.nirreps; ++h) { moinfo.sopi[h] = wfn->nsopi()[h]; moinfo.orbspi[h] = wfn->nmopi()[h]; moinfo.clsdpi[h] = wfn->doccpi()[h]; @@ -84,194 +84,167 @@ void CCLambdaWavefunction::get_moinfo(std::shared_ptr wfn) } sym = 0; - for (i=0;iPrintf("\n\tNuclear Rep. energy (wfn) = %20.15f\n",moinfo.enuc); - outfile->Printf( "\tReference (wfn) = %20d\n",params.ref); - outfile->Printf( "\tSCF energy (wfn) = %20.15f\n",moinfo.escf); - outfile->Printf( "\tReference energy (CC_INFO) = %20.15f\n",moinfo.eref); - + psio_read_entry(PSIF_CC_INFO, "Reference Energy", (char *)&(moinfo.eref), sizeof(double)); + outfile->Printf("\n\tNuclear Rep. energy (wfn) = %20.15f\n", moinfo.enuc); + outfile->Printf("\tReference (wfn) = %20d\n", params.ref); + outfile->Printf("\tSCF energy (wfn) = %20.15f\n", moinfo.escf); + outfile->Printf("\tReference energy (CC_INFO) = %20.15f\n", moinfo.eref); } /* Frees memory allocated in get_moinfo() and dumps some info. */ -void CCLambdaWavefunction::cleanup(void) -{ +void CCLambdaWavefunction::cleanup(void) { int i, h; - psio_write_entry(PSIF_CC_INFO, "Lambda Pseudoenergy", (char *) &(moinfo.lcc), - sizeof(double)); + psio_write_entry(PSIF_CC_INFO, "Lambda Pseudoenergy", (char *)&(moinfo.lcc), sizeof(double)); - if(params.ref == 0 || params.ref == 1) { - for(h=0; h < moinfo.nirreps; h++) - if(moinfo.sopi[h] && moinfo.virtpi[h]) free_block(moinfo.C[h]); + if (params.ref == 0 || params.ref == 1) { + for (h = 0; h < moinfo.nirreps; h++) + if (moinfo.sopi[h] && moinfo.virtpi[h]) free_block(moinfo.C[h]); free(moinfo.C); - } - else if(params.ref == 2) { - for(h=0; h < moinfo.nirreps; h++) - if(moinfo.sopi[h] && moinfo.avirtpi[h]) free_block(moinfo.Ca[h]); + } else if (params.ref == 2) { + for (h = 0; h < moinfo.nirreps; h++) + if (moinfo.sopi[h] && moinfo.avirtpi[h]) free_block(moinfo.Ca[h]); free(moinfo.Ca); - for(h=0; h < moinfo.nirreps; h++) - if(moinfo.sopi[h] && moinfo.bvirtpi[h]) free_block(moinfo.Cb[h]); + for (h = 0; h < moinfo.nirreps; h++) + if (moinfo.sopi[h] && moinfo.bvirtpi[h]) free_block(moinfo.Cb[h]); free(moinfo.Cb); } free(moinfo.sopi); -// free(moinfo.sosym); + // free(moinfo.sosym); free(moinfo.orbspi); free(moinfo.clsdpi); free(moinfo.openpi); -// free(moinfo.uoccpi); -// free(moinfo.fruocc); -// free(moinfo.frdocc); - if(params.ref == 2) { + // free(moinfo.uoccpi); + // free(moinfo.fruocc); + // free(moinfo.frdocc); + if (params.ref == 2) { free(moinfo.aocc_sym); free(moinfo.bocc_sym); free(moinfo.avir_sym); @@ -284,8 +257,7 @@ void CCLambdaWavefunction::cleanup(void) free(moinfo.boccpi); free(moinfo.avirtpi); free(moinfo.bvirtpi); - } - else { + } else { free(moinfo.occ_sym); free(moinfo.vir_sym); free(moinfo.occ_off); @@ -295,5 +267,5 @@ void CCLambdaWavefunction::cleanup(void) } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/get_params.cc b/psi4/src/psi4/cclambda/get_params.cc index 10bdf23dd34..9d4fc749c9a 100644 --- a/psi4/src/psi4/cclambda/get_params.cc +++ b/psi4/src/psi4/cclambda/get_params.cc @@ -50,438 +50,409 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void CCLambdaWavefunction::get_params(Options& options) -{ - int errcod, iconv,i,j,k,l,prop_sym,prop_root, excited_method=0; - int *states_per_irrep, prop_all, lambda_and_Ls = 0; - char lbl[32]; - std::string junk; - - /* check WFN keyword in input */ - params.wfn = options.get_str("WFN"); - excited_method = cc_excited(params.wfn); - - if(params.wfn == "CC2" || params.wfn == "EOM_CC2") { - psio_read_entry(PSIF_CC_INFO, "CC2 Energy", (char *) &(moinfo.ecc), - sizeof(double)); - outfile->Printf( "\tCC2 energy (CC_INFO) = %20.15f\n",moinfo.ecc); - outfile->Printf( "\tTotal CC2 energy (CC_INFO) = %20.15f\n", - moinfo.eref+moinfo.ecc); - } - else if(params.wfn == "CCSD" || params.wfn == "EOM_CCSD") { - psio_read_entry(PSIF_CC_INFO, "CCSD Energy", (char *) &(moinfo.ecc), - sizeof(double)); - outfile->Printf( "\tCCSD energy (CC_INFO) = %20.15f\n",moinfo.ecc); - outfile->Printf( "\tTotal CCSD energy (CC_INFO) = %20.15f\n", - moinfo.eref+moinfo.ecc); - } - else if(params.wfn == "CC3" || params.wfn == "EOM_CC3") { - psio_read_entry(PSIF_CC_INFO, "CC3 Energy", (char *) &(moinfo.ecc), - sizeof(double)); - outfile->Printf( "\tCC3 energy (CC_INFO) = %20.15f\n",moinfo.ecc); - outfile->Printf( "\tTotal CC3 energy (CC_INFO) = %20.15f\n", - moinfo.eref+moinfo.ecc); - } - - /* read in the easy-to-understand parameters */ - - params.convergence = 1e-7; - params.convergence = options.get_double("R_CONVERGENCE"); - - params.restart = options.get_bool("RESTART"); - - params.memory = Process::environment.get_memory(); - - params.print = 0; - params.print = options.get_int("PRINT"); - - params.cachelev = 2; - params.cachelev = options.get_int("CACHELEVEL"); - - params.sekino = 0; - params.sekino = options.get_bool("SEKINO"); - - params.diis = 1; - params.diis = options.get_bool("DIIS"); - - params.aobasis = 0; - params.aobasis = options.get_bool("AO_BASIS"); - params.aobasis = 0; /* AO basis code not yet working for lambda */ - - params.abcd = options.get_str("ABCD"); - if(params.abcd == "NEW" && params.abcd == "OLD") { - outfile->Printf( "Invalid ABCD algorithm: %s\n", params.abcd.c_str()); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } - - params.num_amps = 10; - params.num_amps = options.get_int("NUM_AMPS_PRINT"); - - /* Determine DERTYPE */ - params.dertype = 0; - if(options["DERTYPE"].has_changed()) { - junk = options.get_str("DERTYPE"); - if(junk == "NONE") params.dertype = 0; - else if(junk == "FIRST") params.dertype = 1; - else if(junk == "RESPONSE") params.dertype = 3; /* linear response */ - else { - printf("Invalid value of input keyword DERTYPE: %s\n", junk.c_str()); - throw PsiException("cclambda: error", __FILE__, __LINE__); +namespace psi { +namespace cclambda { + +void CCLambdaWavefunction::get_params(Options &options) { + int errcod, iconv, i, j, k, l, prop_sym, prop_root, excited_method = 0; + int *states_per_irrep, prop_all, lambda_and_Ls = 0; + char lbl[32]; + std::string junk; + + /* check WFN keyword in input */ + params.wfn = options.get_str("WFN"); + excited_method = cc_excited(params.wfn); + + if (params.wfn == "CC2" || params.wfn == "EOM_CC2") { + psio_read_entry(PSIF_CC_INFO, "CC2 Energy", (char *)&(moinfo.ecc), sizeof(double)); + outfile->Printf("\tCC2 energy (CC_INFO) = %20.15f\n", moinfo.ecc); + outfile->Printf("\tTotal CC2 energy (CC_INFO) = %20.15f\n", moinfo.eref + moinfo.ecc); + } else if (params.wfn == "CCSD" || params.wfn == "EOM_CCSD") { + psio_read_entry(PSIF_CC_INFO, "CCSD Energy", (char *)&(moinfo.ecc), sizeof(double)); + outfile->Printf("\tCCSD energy (CC_INFO) = %20.15f\n", moinfo.ecc); + outfile->Printf("\tTotal CCSD energy (CC_INFO) = %20.15f\n", moinfo.eref + moinfo.ecc); + } else if (params.wfn == "CC3" || params.wfn == "EOM_CC3") { + psio_read_entry(PSIF_CC_INFO, "CC3 Energy", (char *)&(moinfo.ecc), sizeof(double)); + outfile->Printf("\tCC3 energy (CC_INFO) = %20.15f\n", moinfo.ecc); + outfile->Printf("\tTotal CC3 energy (CC_INFO) = %20.15f\n", moinfo.eref + moinfo.ecc); } - } - - /* begin local parameters */ - params.local = 0; - params.local = options.get_bool("LOCAL"); - local.cutoff = 0.02; - local.cutoff = options.get_double("LOCAL_CUTOFF"); - if(options["LOCAL_METHOD"].has_changed()) { - local.method = options.get_str("LOCAL_METHOD"); - if(local.method == "AOBASIS" && local.method == "WERNER") { - outfile->Printf( "Invalid local correlation method: %s\n", local.method.c_str()); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } - } - else if(params.local) { - local.method = "WERNER"; - } - - if(options["LOCAL_WEAKP"].has_changed()) { - local.weakp = options.get_str("LOCAL_WEAKP"); - if(local.weakp != "MP2" && local.weakp != "NEGLECT" && local.weakp != "NONE") { - outfile->Printf( "Invalid method for treating local pairs: %s\n", local.weakp.c_str()); - throw PsiException("cclambda: error", __FILE__, __LINE__); - } - } - else if(params.local) { - local.weakp = "NONE"; - } - if(params.dertype == 3) - local.filter_singles = 0; - else - local.filter_singles = 1; + /* read in the easy-to-understand parameters */ + + params.convergence = 1e-7; + params.convergence = options.get_double("R_CONVERGENCE"); + + params.restart = options.get_bool("RESTART"); + + params.memory = Process::environment.get_memory(); + + params.print = 0; + params.print = options.get_int("PRINT"); + + params.cachelev = 2; + params.cachelev = options.get_int("CACHELEVEL"); - local.filter_singles = options.get_bool("LOCAL_FILTER_SINGLES"); + params.sekino = 0; + params.sekino = options.get_bool("SEKINO"); - local.cphf_cutoff = 0.10; - local.cphf_cutoff = options.get_double("LOCAL_CPHF_CUTOFF"); + params.diis = 1; + params.diis = options.get_bool("DIIS"); - local.freeze_core = "FALSE"; - local.freeze_core = options.get_str("FREEZE_CORE"); + params.aobasis = 0; + params.aobasis = options.get_bool("AO_BASIS"); + params.aobasis = 0; /* AO basis code not yet working for lambda */ - if(options["LOCAL_PAIRDEF"].has_changed()){ - local.pairdef = options.get_str("LOCAL_PAIRDEF"); - if(local.pairdef != "BP" && local.pairdef != "RESPONSE") { - outfile->Printf( "Invalid keyword for strong/weak pair definition: %s\n", local.pairdef.c_str()); - throw PsiException("cclambda: error", __FILE__, __LINE__); + params.abcd = options.get_str("ABCD"); + if (params.abcd == "NEW" && params.abcd == "OLD") { + outfile->Printf("Invalid ABCD algorithm: %s\n", params.abcd.c_str()); + throw PsiException("cclambda: error", __FILE__, __LINE__); } - } - else if(params.local && params.dertype == 3) - local.pairdef = "RESPONSE"; - else if(params.local) - local.pairdef = "BP"; - - /* Now setup the structure which determines what will be solved */ - /* if --zeta, use Xi and solve for Zeta */ - /* if (DERTYPE == FIRST) determine ground vs. excited from wfn. - if ground, do only lambda. - if excited, compute only one L chosen as described below. - */ - /* if (DERTYPE == RESPONSE), determine ground vs. excited from wfn. - Compute lambda. - if excited, also do L(s) chosen as described below */ - /* if (DERTYPE == NONE) determine ground vs. excited from wfn. - Compute lambda. - if excited, also do L(s) chosen as described below */ -/* To determine which L(s) to compute for multiple L(s): - Check PROP_ALL in input - - If (PROP_ALL == true), compute L for all excited states. - - If false, check PROP_SYM for irrep desired, and PROP_ROOT - for root desired, as in cceom. */ -/* To determine which L(s) to compute for single L(s) - - Check PROP_SYM for irrep desired, and PROP_ROOT - for root desired, as in cceom. */ - - /* setup property variables for excited states */ - if (cc_excited(params.wfn)) { - states_per_irrep = options.get_int_array("ROOTS_PER_IRREP"); - - prop_all = 1; - prop_all = options.get_bool("PROP_ALL"); - /* command-line overrides this keyword (at least for now) */ - if (params.all) prop_all = 1; - - if (options["PROP_SYM"].has_changed()) { /* read symmetry of state for properties */ - prop_sym = options.get_int("PROP_SYM"); - prop_sym -= 1; - prop_sym = moinfo.sym^prop_sym; - } - else { /* just use last irrep of states requested for symmetry of states */ - for (i=0;i 0) - prop_sym = i^moinfo.sym; - } + + params.num_amps = 10; + params.num_amps = options.get_int("NUM_AMPS_PRINT"); + + /* Determine DERTYPE */ + params.dertype = 0; + if (options["DERTYPE"].has_changed()) { + junk = options.get_str("DERTYPE"); + if (junk == "NONE") + params.dertype = 0; + else if (junk == "FIRST") + params.dertype = 1; + else if (junk == "RESPONSE") + params.dertype = 3; /* linear response */ + else { + printf("Invalid value of input keyword DERTYPE: %s\n", junk.c_str()); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } } - if (options["PROP_ROOT"].has_changed()) { /* read prop_root */ - prop_root = options.get_int("PROP_ROOT"); - prop_root -= 1; + /* begin local parameters */ + params.local = 0; + params.local = options.get_bool("LOCAL"); + local.cutoff = 0.02; + local.cutoff = options.get_double("LOCAL_CUTOFF"); + if (options["LOCAL_METHOD"].has_changed()) { + local.method = options.get_str("LOCAL_METHOD"); + if (local.method == "AOBASIS" && local.method == "WERNER") { + outfile->Printf("Invalid local correlation method: %s\n", local.method.c_str()); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } + } else if (params.local) { + local.method = "WERNER"; } - else { /* just use highest root, if you need only one of them */ - prop_root = states_per_irrep[prop_sym^moinfo.sym]; - prop_root -= 1; + + if (options["LOCAL_WEAKP"].has_changed()) { + local.weakp = options.get_str("LOCAL_WEAKP"); + if (local.weakp != "MP2" && local.weakp != "NEGLECT" && local.weakp != "NONE") { + outfile->Printf("Invalid method for treating local pairs: %s\n", local.weakp.c_str()); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } + } else if (params.local) { + local.weakp = "NONE"; } - } - - params.zeta = options.get_bool("ZETA"); - - if (params.zeta) { /* only use Xi to solve for Zeta */ - params.nstates = 1; - pL_params = (struct L_Params *) malloc(params.nstates * sizeof(struct L_Params)); - psio_read_entry(PSIF_CC_INFO, "XI Irrep", (char *) &i,sizeof(int)); - outfile->Printf("\tIrrep of Zeta (CC_INFO) = %d\n", i); - pL_params[0].irrep = prop_sym = i; /* is this always A1? I forget */ - pL_params[0].root = prop_root = 0; - pL_params[0].ground = 0; - pL_params[0].cceom_energy = 0.0; - pL_params[0].R0 = 0.0; /* = 0, since zeta_0 = 0 */ - sprintf(pL_params[0].L1A_lbl,"ZIA"); - sprintf(pL_params[0].L1B_lbl,"Zia"); - sprintf(pL_params[0].L2AA_lbl,"ZIJAB"); - sprintf(pL_params[0].L2BB_lbl,"Zijab"); - sprintf(pL_params[0].L2AB_lbl,"ZIjAb"); - sprintf(pL_params[0].L2RHF_lbl,"2ZIjAb - ZIjbA"); - } - else if (params.dertype == 1) { /* analytic gradient, ignore prop_all */ - if (!cc_excited(params.wfn)) { /* do only lambda for ground state */ + + if (params.dertype == 3) + local.filter_singles = 0; + else + local.filter_singles = 1; + + local.filter_singles = options.get_bool("LOCAL_FILTER_SINGLES"); + + local.cphf_cutoff = 0.10; + local.cphf_cutoff = options.get_double("LOCAL_CPHF_CUTOFF"); + + local.freeze_core = "FALSE"; + local.freeze_core = options.get_str("FREEZE_CORE"); + + if (options["LOCAL_PAIRDEF"].has_changed()) { + local.pairdef = options.get_str("LOCAL_PAIRDEF"); + if (local.pairdef != "BP" && local.pairdef != "RESPONSE") { + outfile->Printf("Invalid keyword for strong/weak pair definition: %s\n", local.pairdef.c_str()); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } + } else if (params.local && params.dertype == 3) + local.pairdef = "RESPONSE"; + else if (params.local) + local.pairdef = "BP"; + + /* Now setup the structure which determines what will be solved */ + /* if --zeta, use Xi and solve for Zeta */ + /* if (DERTYPE == FIRST) determine ground vs. excited from wfn. + if ground, do only lambda. + if excited, compute only one L chosen as described below. + */ + /* if (DERTYPE == RESPONSE), determine ground vs. excited from wfn. + Compute lambda. + if excited, also do L(s) chosen as described below */ + /* if (DERTYPE == NONE) determine ground vs. excited from wfn. + Compute lambda. + if excited, also do L(s) chosen as described below */ + /* To determine which L(s) to compute for multiple L(s): + Check PROP_ALL in input + - If (PROP_ALL == true), compute L for all excited states. + - If false, check PROP_SYM for irrep desired, and PROP_ROOT + for root desired, as in cceom. */ + /* To determine which L(s) to compute for single L(s) + - Check PROP_SYM for irrep desired, and PROP_ROOT + for root desired, as in cceom. */ + + /* setup property variables for excited states */ + if (cc_excited(params.wfn)) { + states_per_irrep = options.get_int_array("ROOTS_PER_IRREP"); + + prop_all = 1; + prop_all = options.get_bool("PROP_ALL"); + /* command-line overrides this keyword (at least for now) */ + if (params.all) prop_all = 1; + + if (options["PROP_SYM"].has_changed()) { /* read symmetry of state for properties */ + prop_sym = options.get_int("PROP_SYM"); + prop_sym -= 1; + prop_sym = moinfo.sym ^ prop_sym; + } else { /* just use last irrep of states requested for symmetry of states */ + for (i = 0; i < moinfo.nirreps; ++i) { + if (states_per_irrep[i] > 0) prop_sym = i ^ moinfo.sym; + } + } + + if (options["PROP_ROOT"].has_changed()) { /* read prop_root */ + prop_root = options.get_int("PROP_ROOT"); + prop_root -= 1; + } else { /* just use highest root, if you need only one of them */ + prop_root = states_per_irrep[prop_sym ^ moinfo.sym]; + prop_root -= 1; + } + } + + params.zeta = options.get_bool("ZETA"); + + if (params.zeta) { /* only use Xi to solve for Zeta */ + params.nstates = 1; + pL_params = (struct L_Params *)malloc(params.nstates * sizeof(struct L_Params)); + psio_read_entry(PSIF_CC_INFO, "XI Irrep", (char *)&i, sizeof(int)); + outfile->Printf("\tIrrep of Zeta (CC_INFO) = %d\n", i); + pL_params[0].irrep = prop_sym = i; /* is this always A1? I forget */ + pL_params[0].root = prop_root = 0; + pL_params[0].ground = 0; + pL_params[0].cceom_energy = 0.0; + pL_params[0].R0 = 0.0; /* = 0, since zeta_0 = 0 */ + sprintf(pL_params[0].L1A_lbl, "ZIA"); + sprintf(pL_params[0].L1B_lbl, "Zia"); + sprintf(pL_params[0].L2AA_lbl, "ZIJAB"); + sprintf(pL_params[0].L2BB_lbl, "Zijab"); + sprintf(pL_params[0].L2AB_lbl, "ZIjAb"); + sprintf(pL_params[0].L2RHF_lbl, "2ZIjAb - ZIjbA"); + } else if (params.dertype == 1) { /* analytic gradient, ignore prop_all */ + if (!cc_excited(params.wfn)) { /* do only lambda for ground state */ params.nstates = 1; - pL_params = (struct L_Params *) malloc(params.nstates * sizeof(struct L_Params)); - pL_params[0].irrep = 0; - pL_params[0].root = -1; - pL_params[0].ground = 1; - pL_params[0].R0 = 1.0; - pL_params[0].cceom_energy = 0.0; - sprintf(pL_params[0].L1A_lbl,"LIA %d %d",0, -1); - sprintf(pL_params[0].L1B_lbl,"Lia %d %d",0, -1); - sprintf(pL_params[0].L2AA_lbl,"LIJAB %d %d",0, -1); - sprintf(pL_params[0].L2BB_lbl,"Lijab %d %d",0, -1); - sprintf(pL_params[0].L2AB_lbl,"LIjAb %d %d",0, -1); - sprintf(pL_params[0].L2RHF_lbl,"2LIjAb - LIjbA %d %d",0, -1); - } - else { /* do only one L for excited state */ - params.nstates = 1; - pL_params = (struct L_Params *) malloc(params.nstates * sizeof(struct L_Params)); - pL_params[0].irrep = prop_sym; - pL_params[0].root = prop_root; - pL_params[0].ground = 0; - if(params.wfn == "EOM_CC2") { - sprintf(lbl,"EOM CC2 Energy for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].cceom_energy),sizeof(double)); - sprintf(lbl,"EOM CC2 R0 for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].R0),sizeof(double)); - } - else if(params.wfn == "EOM_CCSD") { - sprintf(lbl,"EOM CCSD Energy for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].cceom_energy),sizeof(double)); - sprintf(lbl,"EOM CCSD R0 for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].R0),sizeof(double)); - } - else if(params.wfn == "EOM_CC3") { - sprintf(lbl,"EOM CC3 Energy for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].cceom_energy),sizeof(double)); - sprintf(lbl,"EOM CC3 R0 for root %d %d", prop_sym, prop_root); - psio_read_entry(PSIF_CC_INFO, lbl, (char *) &(pL_params[0].R0),sizeof(double)); - } - sprintf(pL_params[0].L1A_lbl,"LIA %d %d",prop_sym, prop_root); - sprintf(pL_params[0].L1B_lbl,"Lia %d %d",prop_sym, prop_root); - sprintf(pL_params[0].L2AA_lbl,"LIJAB %d %d",prop_sym, prop_root); - sprintf(pL_params[0].L2BB_lbl,"Lijab %d %d",prop_sym, prop_root); - sprintf(pL_params[0].L2AB_lbl,"LIjAb %d %d",prop_sym, prop_root); - sprintf(pL_params[0].L2RHF_lbl,"2LIjAb - LIjbA %d %d",prop_sym, prop_root); - } - } - else if (params.dertype == 3) { /* response calculation */ - if (!cc_excited(params.wfn)) { /* ground state */ + pL_params = (struct L_Params *)malloc(params.nstates * sizeof(struct L_Params)); + pL_params[0].irrep = 0; + pL_params[0].root = -1; + pL_params[0].ground = 1; + pL_params[0].R0 = 1.0; + pL_params[0].cceom_energy = 0.0; + sprintf(pL_params[0].L1A_lbl, "LIA %d %d", 0, -1); + sprintf(pL_params[0].L1B_lbl, "Lia %d %d", 0, -1); + sprintf(pL_params[0].L2AA_lbl, "LIJAB %d %d", 0, -1); + sprintf(pL_params[0].L2BB_lbl, "Lijab %d %d", 0, -1); + sprintf(pL_params[0].L2AB_lbl, "LIjAb %d %d", 0, -1); + sprintf(pL_params[0].L2RHF_lbl, "2LIjAb - LIjbA %d %d", 0, -1); + } else { /* do only one L for excited state */ params.nstates = 1; - pL_params = (struct L_Params *) malloc(params.nstates * sizeof(struct L_Params)); - pL_params[0].irrep = 0; - pL_params[0].root = -1; - pL_params[0].ground = 1; - pL_params[0].R0 = 1.0; - pL_params[0].cceom_energy = 0.0; - sprintf(pL_params[0].L1A_lbl,"LIA %d %d",0, -1); - sprintf(pL_params[0].L1B_lbl,"Lia %d %d",0, -1); - sprintf(pL_params[0].L2AA_lbl,"LIJAB %d %d",0, -1); - sprintf(pL_params[0].L2BB_lbl,"Lijab %d %d",0, -1); - sprintf(pL_params[0].L2AB_lbl,"LIjAb %d %d",0, -1); - sprintf(pL_params[0].L2RHF_lbl,"2LIjAb - LIjbA %d %d",0, -1); - } - else { /* excited state */ - lambda_and_Ls = 1; /* code is below */ - } + pL_params = (struct L_Params *)malloc(params.nstates * sizeof(struct L_Params)); + pL_params[0].irrep = prop_sym; + pL_params[0].root = prop_root; + pL_params[0].ground = 0; + if (params.wfn == "EOM_CC2") { + sprintf(lbl, "EOM CC2 Energy for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].cceom_energy), sizeof(double)); + sprintf(lbl, "EOM CC2 R0 for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].R0), sizeof(double)); + } else if (params.wfn == "EOM_CCSD") { + sprintf(lbl, "EOM CCSD Energy for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].cceom_energy), sizeof(double)); + sprintf(lbl, "EOM CCSD R0 for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].R0), sizeof(double)); + } else if (params.wfn == "EOM_CC3") { + sprintf(lbl, "EOM CC3 Energy for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].cceom_energy), sizeof(double)); + sprintf(lbl, "EOM CC3 R0 for root %d %d", prop_sym, prop_root); + psio_read_entry(PSIF_CC_INFO, lbl, (char *)&(pL_params[0].R0), sizeof(double)); + } + sprintf(pL_params[0].L1A_lbl, "LIA %d %d", prop_sym, prop_root); + sprintf(pL_params[0].L1B_lbl, "Lia %d %d", prop_sym, prop_root); + sprintf(pL_params[0].L2AA_lbl, "LIJAB %d %d", prop_sym, prop_root); + sprintf(pL_params[0].L2BB_lbl, "Lijab %d %d", prop_sym, prop_root); + sprintf(pL_params[0].L2AB_lbl, "LIjAb %d %d", prop_sym, prop_root); + sprintf(pL_params[0].L2RHF_lbl, "2LIjAb - LIjbA %d %d", prop_sym, prop_root); } - else if (params.dertype == 0) { - if (!cc_excited(params.wfn)) { /* ground state */ + } else if (params.dertype == 3) { /* response calculation */ + if (!cc_excited(params.wfn)) { /* ground state */ params.nstates = 1; - pL_params = (struct L_Params *) malloc(params.nstates * sizeof(struct L_Params)); - pL_params[0].irrep = 0; - pL_params[0].root = -1; - pL_params[0].ground = 1; - pL_params[0].R0 = 1.0; - pL_params[0].cceom_energy = 0.0; - sprintf(pL_params[0].L1A_lbl,"LIA %d %d",0, -1); - sprintf(pL_params[0].L1B_lbl,"Lia %d %d",0, -1); - sprintf(pL_params[0].L2AA_lbl,"LIJAB %d %d",0, -1); - sprintf(pL_params[0].L2BB_lbl,"Lijab %d %d",0, -1); - sprintf(pL_params[0].L2AB_lbl,"LIjAb %d %d",0, -1); - sprintf(pL_params[0].L2RHF_lbl,"2LIjAb - LIjbA %d %d",0, -1); - } - else { /* excited state */ - lambda_and_Ls = 1; /* code is below */ - } + pL_params = (struct L_Params *)malloc(params.nstates * sizeof(struct L_Params)); + pL_params[0].irrep = 0; + pL_params[0].root = -1; + pL_params[0].ground = 1; + pL_params[0].R0 = 1.0; + pL_params[0].cceom_energy = 0.0; + sprintf(pL_params[0].L1A_lbl, "LIA %d %d", 0, -1); + sprintf(pL_params[0].L1B_lbl, "Lia %d %d", 0, -1); + sprintf(pL_params[0].L2AA_lbl, "LIJAB %d %d", 0, -1); + sprintf(pL_params[0].L2BB_lbl, "Lijab %d %d", 0, -1); + sprintf(pL_params[0].L2AB_lbl, "LIjAb %d %d", 0, -1); + sprintf(pL_params[0].L2RHF_lbl, "2LIjAb - LIjbA %d %d", 0, -1); + } else { /* excited state */ + lambda_and_Ls = 1; /* code is below */ } + } else if (params.dertype == 0) { + if (!cc_excited(params.wfn)) { /* ground state */ + params.nstates = 1; + pL_params = (struct L_Params *)malloc(params.nstates * sizeof(struct L_Params)); + pL_params[0].irrep = 0; + pL_params[0].root = -1; + pL_params[0].ground = 1; + pL_params[0].R0 = 1.0; + pL_params[0].cceom_energy = 0.0; + sprintf(pL_params[0].L1A_lbl, "LIA %d %d", 0, -1); + sprintf(pL_params[0].L1B_lbl, "Lia %d %d", 0, -1); + sprintf(pL_params[0].L2AA_lbl, "LIJAB %d %d", 0, -1); + sprintf(pL_params[0].L2BB_lbl, "Lijab %d %d", 0, -1); + sprintf(pL_params[0].L2AB_lbl, "LIjAb %d %d", 0, -1); + sprintf(pL_params[0].L2RHF_lbl, "2LIjAb - LIjbA %d %d", 0, -1); + } else { /* excited state */ + lambda_and_Ls = 1; /* code is below */ + } + } + /* do lambda for ground state AND do L(s) for excited states */ + if (lambda_and_Ls) { + /* determine number of states to converge */ + params.nstates = 1; /* for ground state */ + if (prop_all) { + for (i = 0; i < moinfo.nirreps; ++i) params.nstates += states_per_irrep[i]; /* do all L(s) */ + } else { + params.nstates += 1; /* do only one L */ + } - /* do lambda for ground state AND do L(s) for excited states */ - if (lambda_and_Ls) { - /* determine number of states to converge */ - params.nstates = 1; /* for ground state */ - if (prop_all) { - for (i=0; iPrintf( "\n\tInput parameters:\n"); - outfile->Printf( "\t-----------------\n"); - outfile->Printf( "\tMaxiter = %4d\n", params.maxiter); - outfile->Printf( "\tConvergence = %3.1e\n", params.convergence); - outfile->Printf( "\tRestart = %s\n", params.restart ? "Yes" : "No"); - outfile->Printf( "\tCache Level = %1d\n", params.cachelev); - outfile->Printf( "\tModel III = %s\n", params.sekino ? "Yes" : "No"); - outfile->Printf( "\tDIIS = %s\n", params.diis ? "Yes" : "No"); - outfile->Printf( "\tAO Basis = %s\n", - params.aobasis ? "Yes" : "No"); - outfile->Printf( "\tABCD = %s\n", params.abcd.c_str()); - outfile->Printf( "\tLocal CC = %s\n", params.local ? "Yes" : "No"); - if(params.local) { - outfile->Printf( "\tLocal Cutoff = %3.1e\n", local.cutoff); - outfile->Printf( "\tLocal Method = %s\n", local.method.c_str()); - outfile->Printf( "\tWeak pairs = %s\n", local.weakp.c_str()); - outfile->Printf( "\tFilter singles = %s\n", local.filter_singles ? "Yes" : "No"); - outfile->Printf( "\tLocal pairs = %s\n", local.pairdef.c_str()); - outfile->Printf( "\tLocal CPHF cutoff = %3.1e\n", local.cphf_cutoff); - } - - outfile->Printf("\tParameters for left-handed eigenvectors:\n"); - outfile->Printf("\t Irr Root Ground-State? EOM energy R0\n"); - for (i=0; iPrintf("\t%3d %3d %5d %10s %18.10lf %14.10lf\n", i+1, pL_params[i].irrep, pL_params[i].root+1, - (pL_params[i].ground ? "Yes":"No"), pL_params[i].cceom_energy, pL_params[i].R0); - } - - for (i=0; iPrintf("\tLabels for eigenvector %d:\n\t%s, %s, %s, %s, %s, %s\n", - i+1,pL_params[i].L1A_lbl,pL_params[i].L1B_lbl,pL_params[i].L2AA_lbl,pL_params[i].L2BB_lbl, - pL_params[i].L2AB_lbl, pL_params[i].L2RHF_lbl); - } - - - return; + sprintf(pL_params[1].L1A_lbl, "LIA %d %d", prop_sym, prop_root); + sprintf(pL_params[1].L1B_lbl, "Lia %d %d", prop_sym, prop_root); + sprintf(pL_params[1].L2AA_lbl, "LIJAB %d %d", prop_sym, prop_root); + sprintf(pL_params[1].L2BB_lbl, "Lijab %d %d", prop_sym, prop_root); + sprintf(pL_params[1].L2AB_lbl, "LIjAb %d %d", prop_sym, prop_root); + sprintf(pL_params[1].L2RHF_lbl, "2LIjAb - LIjbA %d %d", prop_sym, prop_root); + } + } + + params.maxiter = 50 * params.nstates; + params.maxiter = options.get_int("MAXITER"); + + outfile->Printf("\n\tInput parameters:\n"); + outfile->Printf("\t-----------------\n"); + outfile->Printf("\tMaxiter = %4d\n", params.maxiter); + outfile->Printf("\tConvergence = %3.1e\n", params.convergence); + outfile->Printf("\tRestart = %s\n", params.restart ? "Yes" : "No"); + outfile->Printf("\tCache Level = %1d\n", params.cachelev); + outfile->Printf("\tModel III = %s\n", params.sekino ? "Yes" : "No"); + outfile->Printf("\tDIIS = %s\n", params.diis ? "Yes" : "No"); + outfile->Printf("\tAO Basis = %s\n", params.aobasis ? "Yes" : "No"); + outfile->Printf("\tABCD = %s\n", params.abcd.c_str()); + outfile->Printf("\tLocal CC = %s\n", params.local ? "Yes" : "No"); + if (params.local) { + outfile->Printf("\tLocal Cutoff = %3.1e\n", local.cutoff); + outfile->Printf("\tLocal Method = %s\n", local.method.c_str()); + outfile->Printf("\tWeak pairs = %s\n", local.weakp.c_str()); + outfile->Printf("\tFilter singles = %s\n", local.filter_singles ? "Yes" : "No"); + outfile->Printf("\tLocal pairs = %s\n", local.pairdef.c_str()); + outfile->Printf("\tLocal CPHF cutoff = %3.1e\n", local.cphf_cutoff); + } + + outfile->Printf("\tParameters for left-handed eigenvectors:\n"); + outfile->Printf("\t Irr Root Ground-State? EOM energy R0\n"); + for (i = 0; i < params.nstates; ++i) { + outfile->Printf("\t%3d %3d %5d %10s %18.10lf %14.10lf\n", i + 1, pL_params[i].irrep, pL_params[i].root + 1, + (pL_params[i].ground ? "Yes" : "No"), pL_params[i].cceom_energy, pL_params[i].R0); + } + + for (i = 0; i < params.nstates; ++i) { + outfile->Printf("\tLabels for eigenvector %d:\n\t%s, %s, %s, %s, %s, %s\n", i + 1, pL_params[i].L1A_lbl, + pL_params[i].L1B_lbl, pL_params[i].L2AA_lbl, pL_params[i].L2BB_lbl, pL_params[i].L2AB_lbl, + pL_params[i].L2RHF_lbl); + } + + return; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/globals.h b/psi4/src/psi4/cclambda/globals.h index d70173123c3..3bad0e56977 100644 --- a/psi4/src/psi4/cclambda/globals.h +++ b/psi4/src/psi4/cclambda/globals.h @@ -55,5 +55,5 @@ EXTERN struct Params params; EXTERN struct L_Params *pL_params; EXTERN struct Local local; void check_sum(char *lbl, int L_irr); - -}} // namespace psi::cclambda +} +} // namespace psi diff --git a/psi4/src/psi4/cclambda/halftrans.cc b/psi4/src/psi4/cclambda/halftrans.cc index 6bf86e443fc..cde14fb3d3b 100644 --- a/psi4/src/psi4/cclambda/halftrans.cc +++ b/psi4/src/psi4/cclambda/halftrans.cc @@ -34,7 +34,8 @@ #include "psi4/libqt/qt.h" #include "psi4/libciomr/libciomr.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* halftrans(): Routine to transform the last two indices of a dpdbuf4 ** between the MO and SO bases. @@ -56,81 +57,81 @@ namespace psi { namespace cclambda { ** double beta: multiplicative factor for the target */ -void halftrans(dpdbuf4 *Buf1, int dpdnum1, dpdbuf4 *Buf2, int dpdnum2, double ***C, int nirreps, - int **mo_row, int **so_row, int *mospi, int *sospi, int type, double alpha, double beta) -{ - int h, Gc, Gd, cd, pq, ij; - double **X; - - for(h=0; h < nirreps; h++) { - - dpd_set_default(dpdnum1); - global_dpd_->buf4_mat_irrep_init(Buf1, h); - - dpd_set_default(dpdnum2); - global_dpd_->buf4_mat_irrep_init(Buf2, h); - - if(type==0) { /* alpha * Buf1 --> beta * Buf2 */ - if(alpha != 0.0) { dpd_set_default(dpdnum1); global_dpd_->buf4_mat_irrep_rd(Buf1, h); } - if(beta != 0.0) { dpd_set_default(dpdnum2); global_dpd_->buf4_mat_irrep_rd(Buf2, h); } - } - if(type==1) { /* alpha * Buf2 --> beta * Buf1 */ - if(alpha != 0.0) { dpd_set_default(dpdnum2); global_dpd_->buf4_mat_irrep_rd(Buf2, h); } - if(beta != 0.0) { dpd_set_default(dpdnum1); global_dpd_->buf4_mat_irrep_rd(Buf1, h); } - } - - for(Gc=0; Gc < nirreps; Gc++) { - Gd = h^Gc; - - cd = mo_row[h][Gc]; - pq = so_row[h][Gc]; - - if(mospi[Gc] && mospi[Gd] && sospi[Gc] && sospi[Gd]) { - - if(type == 0) { - X = block_matrix(mospi[Gc],sospi[Gd]); - - for(ij=0; ij < Buf1->params->rowtot[h]; ij++) { - - C_DGEMM('n','t', mospi[Gc], sospi[Gd], mospi[Gd], 1.0, - &(Buf1->matrix[h][ij][cd]), mospi[Gd], &(C[Gd][0][0]), mospi[Gd], - 0.0, &(X[0][0]), sospi[Gd]); - - C_DGEMM('n','n', sospi[Gc], sospi[Gd], mospi[Gc], alpha, - &(C[Gc][0][0]), mospi[Gc], &(X[0][0]), sospi[Gd], - beta, &(Buf2->matrix[h][ij][pq]), sospi[Gd]); - } - } - else { - X = block_matrix(sospi[Gc],mospi[Gd]); - - for(ij=0; ij < Buf1->params->rowtot[h]; ij++) { - - C_DGEMM('n','n', sospi[Gc], mospi[Gd], sospi[Gd], 1.0, - &(Buf2->matrix[h][ij][pq]), sospi[Gd], &(C[Gd][0][0]), mospi[Gd], - 0.0, &(X[0][0]), mospi[Gd]); - - C_DGEMM('t','n', mospi[Gc], mospi[Gd], sospi[Gc], alpha, - &(C[Gc][0][0]), mospi[Gc], &(X[0][0]), mospi[Gd], - beta, &(Buf1->matrix[h][ij][cd]), mospi[Gd]); - - } - } - - free_block(X); - } +void halftrans(dpdbuf4 *Buf1, int dpdnum1, dpdbuf4 *Buf2, int dpdnum2, double ***C, int nirreps, int **mo_row, + int **so_row, int *mospi, int *sospi, int type, double alpha, double beta) { + int h, Gc, Gd, cd, pq, ij; + double **X; + + for (h = 0; h < nirreps; h++) { + dpd_set_default(dpdnum1); + global_dpd_->buf4_mat_irrep_init(Buf1, h); + + dpd_set_default(dpdnum2); + global_dpd_->buf4_mat_irrep_init(Buf2, h); + + if (type == 0) { /* alpha * Buf1 --> beta * Buf2 */ + if (alpha != 0.0) { + dpd_set_default(dpdnum1); + global_dpd_->buf4_mat_irrep_rd(Buf1, h); + } + if (beta != 0.0) { + dpd_set_default(dpdnum2); + global_dpd_->buf4_mat_irrep_rd(Buf2, h); + } + } + if (type == 1) { /* alpha * Buf2 --> beta * Buf1 */ + if (alpha != 0.0) { + dpd_set_default(dpdnum2); + global_dpd_->buf4_mat_irrep_rd(Buf2, h); + } + if (beta != 0.0) { + dpd_set_default(dpdnum1); + global_dpd_->buf4_mat_irrep_rd(Buf1, h); + } + } + + for (Gc = 0; Gc < nirreps; Gc++) { + Gd = h ^ Gc; + + cd = mo_row[h][Gc]; + pq = so_row[h][Gc]; + + if (mospi[Gc] && mospi[Gd] && sospi[Gc] && sospi[Gd]) { + if (type == 0) { + X = block_matrix(mospi[Gc], sospi[Gd]); + + for (ij = 0; ij < Buf1->params->rowtot[h]; ij++) { + C_DGEMM('n', 't', mospi[Gc], sospi[Gd], mospi[Gd], 1.0, &(Buf1->matrix[h][ij][cd]), mospi[Gd], + &(C[Gd][0][0]), mospi[Gd], 0.0, &(X[0][0]), sospi[Gd]); + + C_DGEMM('n', 'n', sospi[Gc], sospi[Gd], mospi[Gc], alpha, &(C[Gc][0][0]), mospi[Gc], &(X[0][0]), + sospi[Gd], beta, &(Buf2->matrix[h][ij][pq]), sospi[Gd]); + } + } else { + X = block_matrix(sospi[Gc], mospi[Gd]); + + for (ij = 0; ij < Buf1->params->rowtot[h]; ij++) { + C_DGEMM('n', 'n', sospi[Gc], mospi[Gd], sospi[Gd], 1.0, &(Buf2->matrix[h][ij][pq]), sospi[Gd], + &(C[Gd][0][0]), mospi[Gd], 0.0, &(X[0][0]), mospi[Gd]); + + C_DGEMM('t', 'n', mospi[Gc], mospi[Gd], sospi[Gc], alpha, &(C[Gc][0][0]), mospi[Gc], &(X[0][0]), + mospi[Gd], beta, &(Buf1->matrix[h][ij][cd]), mospi[Gd]); + } + } + + free_block(X); + } + } + + dpd_set_default(dpdnum1); + if (type == 1) global_dpd_->buf4_mat_irrep_wrt(Buf1, h); + global_dpd_->buf4_mat_irrep_close(Buf1, h); + + dpd_set_default(dpdnum2); + if (type == 0) global_dpd_->buf4_mat_irrep_wrt(Buf2, h); + global_dpd_->buf4_mat_irrep_close(Buf2, h); } - - dpd_set_default(dpdnum1); - if(type==1) global_dpd_->buf4_mat_irrep_wrt(Buf1, h); - global_dpd_->buf4_mat_irrep_close(Buf1, h); - - dpd_set_default(dpdnum2); - if(type==0) global_dpd_->buf4_mat_irrep_wrt(Buf2, h); - global_dpd_->buf4_mat_irrep_close(Buf2, h); - - } - } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/hbar_extra.cc b/psi4/src/psi4/cclambda/hbar_extra.cc index 62ac1fea7b5..1ee817e7b93 100644 --- a/psi4/src/psi4/cclambda/hbar_extra.cc +++ b/psi4/src/psi4/cclambda/hbar_extra.cc @@ -37,27 +37,29 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { void hbar_extra(void) { - dpdbuf4 W1, W2, W; + dpdbuf4 W1, W2, W; - if(params.ref == 0) { - /* 2 W(ME,jb) + W(Me,Jb) */ - global_dpd_->buf4_init(&W1, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); - global_dpd_->buf4_copy(&W1, PSIF_CC_HBAR, "2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->buf4_close(&W1); - global_dpd_->buf4_init(&W1, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); - global_dpd_->buf4_init(&W2, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); - global_dpd_->buf4_axpy(&W2, &W1, 2); - global_dpd_->buf4_close(&W2); - global_dpd_->buf4_close(&W1); + if (params.ref == 0) { + /* 2 W(ME,jb) + W(Me,Jb) */ + global_dpd_->buf4_init(&W1, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbeJ"); + global_dpd_->buf4_copy(&W1, PSIF_CC_HBAR, "2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->buf4_close(&W1); + global_dpd_->buf4_init(&W1, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "2 W(ME,jb) + W(Me,Jb)"); + global_dpd_->buf4_init(&W2, PSIF_CC_HBAR, 0, 10, 10, 10, 10, 0, "WMbEj"); + global_dpd_->buf4_axpy(&W2, &W1, 2); + global_dpd_->buf4_close(&W2); + global_dpd_->buf4_close(&W1); -/* dpd_buf4_init(&W, CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); */ -/* dpd_buf4_scmcopy(&W, CC_HBAR, "WAmEf 2(Am,Ef) - (Am,fE)", 2); */ -/* dpd_buf4_sort_axpy(&W, CC_HBAR, pqsr, 11, 5, "WAmEf 2(Am,Ef) - (Am,fE)", -1); */ -/* dpd_buf4_close(&W); */ - } + /* dpd_buf4_init(&W, CC_HBAR, 0, 11, 5, 11, 5, 0, "WAmEf"); */ + /* dpd_buf4_scmcopy(&W, CC_HBAR, "WAmEf 2(Am,Ef) - (Am,fE)", 2); */ + /* dpd_buf4_sort_axpy(&W, CC_HBAR, pqsr, 11, 5, "WAmEf 2(Am,Ef) - (Am,fE)", -1); */ + /* dpd_buf4_close(&W); */ + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/init_amps.cc b/psi4/src/psi4/cclambda/init_amps.cc index 99ce3c8a81c..fba7f28a0f3 100644 --- a/psi4/src/psi4/cclambda/init_amps.cc +++ b/psi4/src/psi4/cclambda/init_amps.cc @@ -38,359 +38,348 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void CCLambdaWavefunction::init_amps(struct L_Params L_params) -{ - double norm; - dpdfile2 T1, R1, LIA, Lia, dIA, dia, XIA, Xia; - dpdbuf4 T2, R2, LIJAB, Lijab, LIjAb, dIJAB, dijab, dIjAb, XIJAB, Xijab, XIjAb; - char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; - int L_irr; - L_irr = L_params.irrep; - - /* if solving zeta equations, initial guess is Xi * denom */ - if (params.zeta) { - if (params.ref == 0) { /* RHF */ - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&XIA); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &LIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&LIA); - - global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); - global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&XIjAb); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); - global_dpd_->buf4_close(&dIjAb); - global_dpd_->buf4_close(&LIjAb); - } - else if (params.ref == 1) { /* ROHF */ - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&XIA); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &LIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&LIA); - - global_dpd_->file2_init(&Xia, PSIF_EOM_XI, L_irr, 0, 1, "Xia"); - global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&Xia); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); - global_dpd_->file2_dirprd(&dia, &Lia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&Lia); - - global_dpd_->buf4_init(&XIJAB, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); - global_dpd_->buf4_copy(&XIJAB, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&XIJAB); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dIJAB"); - global_dpd_->buf4_dirprd(&dIJAB, &LIJAB); - global_dpd_->buf4_close(&dIJAB); - global_dpd_->buf4_close(&LIJAB); - - global_dpd_->buf4_init(&Xijab, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "Xijab"); - global_dpd_->buf4_copy(&Xijab, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&Xijab); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dijab"); - global_dpd_->buf4_dirprd(&dijab, &Lijab); - global_dpd_->buf4_close(&dijab); - global_dpd_->buf4_close(&Lijab); - - global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); - global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&XIjAb); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); - global_dpd_->buf4_close(&dIjAb); - global_dpd_->buf4_close(&LIjAb); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); - global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&XIA); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); - global_dpd_->file2_dirprd(&dIA, &LIA); - global_dpd_->file2_close(&dIA); - global_dpd_->file2_close(&LIA); - - global_dpd_->file2_init(&Xia, PSIF_EOM_XI, L_irr, 2, 3, "Xia"); - global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&Xia); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); - global_dpd_->file2_dirprd(&dia, &Lia); - global_dpd_->file2_close(&dia); - global_dpd_->file2_close(&Lia); - - global_dpd_->buf4_init(&XIJAB, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); - global_dpd_->buf4_copy(&XIJAB, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&XIJAB); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dIJAB"); - global_dpd_->buf4_dirprd(&dIJAB, &LIJAB); - global_dpd_->buf4_close(&dIJAB); - global_dpd_->buf4_close(&LIJAB); - - global_dpd_->buf4_init(&Xijab, PSIF_EOM_XI, L_irr, 12, 17, 12, 17, 0, "Xijab"); - global_dpd_->buf4_copy(&Xijab, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&Xijab); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 12, 17, 12, 17, 0, "dijab"); - global_dpd_->buf4_dirprd(&dijab, &Lijab); - global_dpd_->buf4_close(&dijab); - global_dpd_->buf4_close(&Lijab); - - global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 22, 28, 22, 28, 0, "XIjAb"); - global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&XIjAb); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 22, 28, 22, 28, 0, "dIjAb"); - global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); - global_dpd_->buf4_close(&dIjAb); - global_dpd_->buf4_close(&LIjAb); - } - return; - } - - /* ground state guess L <= T */ - /* excited state guess L <= R0 * T + R */ - if (L_params.ground || L_params.irrep == 0) { - if(params.ref == 0) { /** RHF **/ - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA")) { - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&T1); - } - else outfile->Printf( "\tUsing old L1 amplitudes.\n"); - - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb")) { - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&T2); - } - else outfile->Printf( "\tUsing old L2 amplitudes.\n"); - - global_dpd_->buf4_init(&T2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "LIjAb"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&T2); - } - else if(params.ref == 1) { /** ROHF **/ - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA") || - !psio_tocscan(PSIF_CC_LAMBDA, "Lia")) { - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&T1); - - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&T1); - } - else outfile->Printf( "\tUsing old L1 amplitudes.\n"); - - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb") || - !psio_tocscan(PSIF_CC_LAMBDA, "LIJAB") || - !psio_tocscan(PSIF_CC_LAMBDA, "Lijab")) { - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&T2); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&T2); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&T2); - } - else outfile->Printf( "\tUsing old L2 amplitudes.\n"); - } - else if(params.ref == 2) { /** UHF **/ - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA") || - !psio_tocscan(PSIF_CC_LAMBDA, "Lia")) { - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); - global_dpd_->file2_close(&T1); - - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&T1); - } - else outfile->Printf( "\tUsing old L1 amplitudes.\n"); - - if(!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb") || - !psio_tocscan(PSIF_CC_LAMBDA, "LIJAB") || - !psio_tocscan(PSIF_CC_LAMBDA, "Lijab")) { - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_close(&T2); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&T2); - - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); - global_dpd_->buf4_close(&T2); - } - else outfile->Printf( "\tUsing old L2 amplitudes.\n"); - } - } - - if (!L_params.ground) { - sprintf(R1A_lbl, "RIA %d %d", L_params.irrep, L_params.root); - sprintf(R1B_lbl, "Ria %d %d", L_params.irrep, L_params.root); - sprintf(R2AA_lbl, "RIJAB %d %d", L_params.irrep, L_params.root); - sprintf(R2BB_lbl, "Rijab %d %d", L_params.irrep, L_params.root); - sprintf(R2AB_lbl, "RIjAb %d %d", L_params.irrep, L_params.root); - - /* multiply by R0 and create nonsymmetric L files */ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - if (params.ref <= 1) { - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - } - else { - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); +namespace psi { +namespace cclambda { + +void CCLambdaWavefunction::init_amps(struct L_Params L_params) { + double norm; + dpdfile2 T1, R1, LIA, Lia, dIA, dia, XIA, Xia; + dpdbuf4 T2, R2, LIJAB, Lijab, LIjAb, dIJAB, dijab, dIjAb, XIJAB, Xijab, XIjAb; + char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; + int L_irr; + L_irr = L_params.irrep; + + /* if solving zeta equations, initial guess is Xi * denom */ + if (params.zeta) { + if (params.ref == 0) { /* RHF */ + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&XIA); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &LIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&LIA); + + global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); + global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&XIjAb); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); + global_dpd_->buf4_close(&dIjAb); + global_dpd_->buf4_close(&LIjAb); + } else if (params.ref == 1) { /* ROHF */ + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&XIA); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &LIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&LIA); + + global_dpd_->file2_init(&Xia, PSIF_EOM_XI, L_irr, 0, 1, "Xia"); + global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&Xia); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 0, 1, "dia"); + global_dpd_->file2_dirprd(&dia, &Lia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&Lia); + + global_dpd_->buf4_init(&XIJAB, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); + global_dpd_->buf4_copy(&XIJAB, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&XIJAB); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dIJAB"); + global_dpd_->buf4_dirprd(&dIJAB, &LIJAB); + global_dpd_->buf4_close(&dIJAB); + global_dpd_->buf4_close(&LIJAB); + + global_dpd_->buf4_init(&Xijab, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "Xijab"); + global_dpd_->buf4_copy(&Xijab, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&Xijab); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dijab"); + global_dpd_->buf4_dirprd(&dijab, &Lijab); + global_dpd_->buf4_close(&dijab); + global_dpd_->buf4_close(&Lijab); + + global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 0, 5, 0, 5, 0, "XIjAb"); + global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&XIjAb); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 0, 5, 0, 5, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); + global_dpd_->buf4_close(&dIjAb); + global_dpd_->buf4_close(&LIjAb); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&XIA, PSIF_EOM_XI, L_irr, 0, 1, "XIA"); + global_dpd_->file2_copy(&XIA, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&XIA); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&dIA, PSIF_CC_DENOM, L_irr, 0, 1, "dIA"); + global_dpd_->file2_dirprd(&dIA, &LIA); + global_dpd_->file2_close(&dIA); + global_dpd_->file2_close(&LIA); + + global_dpd_->file2_init(&Xia, PSIF_EOM_XI, L_irr, 2, 3, "Xia"); + global_dpd_->file2_copy(&Xia, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&Xia); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_init(&dia, PSIF_CC_DENOM, L_irr, 2, 3, "dia"); + global_dpd_->file2_dirprd(&dia, &Lia); + global_dpd_->file2_close(&dia); + global_dpd_->file2_close(&Lia); + + global_dpd_->buf4_init(&XIJAB, PSIF_EOM_XI, L_irr, 2, 7, 2, 7, 0, "XIJAB"); + global_dpd_->buf4_copy(&XIJAB, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&XIJAB); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&dIJAB, PSIF_CC_DENOM, L_irr, 2, 7, 2, 7, 0, "dIJAB"); + global_dpd_->buf4_dirprd(&dIJAB, &LIJAB); + global_dpd_->buf4_close(&dIJAB); + global_dpd_->buf4_close(&LIJAB); + + global_dpd_->buf4_init(&Xijab, PSIF_EOM_XI, L_irr, 12, 17, 12, 17, 0, "Xijab"); + global_dpd_->buf4_copy(&Xijab, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&Xijab); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&dijab, PSIF_CC_DENOM, L_irr, 12, 17, 12, 17, 0, "dijab"); + global_dpd_->buf4_dirprd(&dijab, &Lijab); + global_dpd_->buf4_close(&dijab); + global_dpd_->buf4_close(&Lijab); + + global_dpd_->buf4_init(&XIjAb, PSIF_EOM_XI, L_irr, 22, 28, 22, 28, 0, "XIjAb"); + global_dpd_->buf4_copy(&XIjAb, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&XIjAb); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&dIjAb, PSIF_CC_DENOM, L_irr, 22, 28, 22, 28, 0, "dIjAb"); + global_dpd_->buf4_dirprd(&dIjAb, &LIjAb); + global_dpd_->buf4_close(&dIjAb); + global_dpd_->buf4_close(&LIjAb); + } + return; } - global_dpd_->file2_scm(&LIA, L_params.R0); - global_dpd_->file2_scm(&Lia, L_params.R0); - global_dpd_->buf4_scm(&LIJAB, L_params.R0); - global_dpd_->buf4_scm(&Lijab, L_params.R0); - global_dpd_->buf4_scm(&LIjAb, L_params.R0); - - /* add R1 and R2 */ - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); - global_dpd_->file2_axpy(&R1, &LIA, 1.0, 0); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); - global_dpd_->buf4_axpy(&R2, &LIJAB, 1.0); - global_dpd_->buf4_close(&R2); - - if (params.ref <= 1) { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); - global_dpd_->file2_axpy(&R1, &Lia, 1.0, 0); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); - global_dpd_->buf4_axpy(&R2, &Lijab, 1.0); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); - global_dpd_->buf4_axpy(&R2, &LIjAb, 1.0); - global_dpd_->buf4_close(&R2); - } - else { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); - global_dpd_->file2_axpy(&R1, &Lia, 1.0, 0); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); - global_dpd_->buf4_axpy(&R2, &Lijab, 1.0); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); - global_dpd_->buf4_axpy(&R2, &LIjAb, 1.0); - global_dpd_->buf4_close(&R2); - } - - /* dot L and R together */ - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); - norm = global_dpd_->file2_dot(&LIA, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); - norm += global_dpd_->buf4_dot(&LIJAB, &R2); - global_dpd_->buf4_close(&R2); - if (params.ref <= 1) { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); - norm += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); - norm += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); - norm += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); - } - else { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); - norm += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); - norm += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); - norm += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); + /* ground state guess L <= T */ + /* excited state guess L <= R0 * T + R */ + if (L_params.ground || L_params.irrep == 0) { + if (params.ref == 0) { /** RHF **/ + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA")) { + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&T1); + } else + outfile->Printf("\tUsing old L1 amplitudes.\n"); + + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb")) { + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&T2); + } else + outfile->Printf("\tUsing old L2 amplitudes.\n"); + + global_dpd_->buf4_init(&T2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "LIjAb"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&T2); + } else if (params.ref == 1) { /** ROHF **/ + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA") || !psio_tocscan(PSIF_CC_LAMBDA, "Lia")) { + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&T1); + + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&T1); + } else + outfile->Printf("\tUsing old L1 amplitudes.\n"); + + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb") || !psio_tocscan(PSIF_CC_LAMBDA, "LIJAB") || + !psio_tocscan(PSIF_CC_LAMBDA, "Lijab")) { + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&T2); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&T2); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&T2); + } else + outfile->Printf("\tUsing old L2 amplitudes.\n"); + } else if (params.ref == 2) { /** UHF **/ + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIA") || !psio_tocscan(PSIF_CC_LAMBDA, "Lia")) { + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "LIA"); + global_dpd_->file2_close(&T1); + + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&T1); + } else + outfile->Printf("\tUsing old L1 amplitudes.\n"); + + if (!params.restart || !psio_tocscan(PSIF_CC_LAMBDA, "LIjAb") || !psio_tocscan(PSIF_CC_LAMBDA, "LIJAB") || + !psio_tocscan(PSIF_CC_LAMBDA, "Lijab")) { + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_close(&T2); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&T2); + + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIjAb"); + global_dpd_->buf4_close(&T2); + } else + outfile->Printf("\tUsing old L2 amplitudes.\n"); + } } - outfile->Printf("\tInitial overlap of initial guess = %15.10lf\n", norm); - - global_dpd_->file2_scm(&LIA, 1.0/norm); - global_dpd_->file2_scm(&Lia, 1.0/norm); - global_dpd_->buf4_scm(&LIJAB, 1.0/norm); - global_dpd_->buf4_scm(&Lijab, 1.0/norm); - global_dpd_->buf4_scm(&LIjAb, 1.0/norm); - - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); - norm = global_dpd_->file2_dot(&LIA, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); - norm += global_dpd_->buf4_dot(&LIJAB, &R2); - global_dpd_->buf4_close(&R2); - - if (params.ref <= 1) { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); - norm += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); - norm += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); - norm += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); - } - else { - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); - norm += global_dpd_->file2_dot(&Lia, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); - norm += global_dpd_->buf4_dot(&Lijab, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); - norm += global_dpd_->buf4_dot(&LIjAb, &R2); - global_dpd_->buf4_close(&R2); + if (!L_params.ground) { + sprintf(R1A_lbl, "RIA %d %d", L_params.irrep, L_params.root); + sprintf(R1B_lbl, "Ria %d %d", L_params.irrep, L_params.root); + sprintf(R2AA_lbl, "RIJAB %d %d", L_params.irrep, L_params.root); + sprintf(R2BB_lbl, "Rijab %d %d", L_params.irrep, L_params.root); + sprintf(R2AB_lbl, "RIjAb %d %d", L_params.irrep, L_params.root); + + /* multiply by R0 and create nonsymmetric L files */ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + if (params.ref <= 1) { + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + } else { + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + } + + global_dpd_->file2_scm(&LIA, L_params.R0); + global_dpd_->file2_scm(&Lia, L_params.R0); + global_dpd_->buf4_scm(&LIJAB, L_params.R0); + global_dpd_->buf4_scm(&Lijab, L_params.R0); + global_dpd_->buf4_scm(&LIjAb, L_params.R0); + + /* add R1 and R2 */ + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); + global_dpd_->file2_axpy(&R1, &LIA, 1.0, 0); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); + global_dpd_->buf4_axpy(&R2, &LIJAB, 1.0); + global_dpd_->buf4_close(&R2); + + if (params.ref <= 1) { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); + global_dpd_->file2_axpy(&R1, &Lia, 1.0, 0); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); + global_dpd_->buf4_axpy(&R2, &Lijab, 1.0); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); + global_dpd_->buf4_axpy(&R2, &LIjAb, 1.0); + global_dpd_->buf4_close(&R2); + } else { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); + global_dpd_->file2_axpy(&R1, &Lia, 1.0, 0); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); + global_dpd_->buf4_axpy(&R2, &Lijab, 1.0); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); + global_dpd_->buf4_axpy(&R2, &LIjAb, 1.0); + global_dpd_->buf4_close(&R2); + } + + /* dot L and R together */ + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); + norm = global_dpd_->file2_dot(&LIA, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); + norm += global_dpd_->buf4_dot(&LIJAB, &R2); + global_dpd_->buf4_close(&R2); + if (params.ref <= 1) { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); + norm += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); + norm += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); + norm += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } else { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); + norm += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); + norm += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); + norm += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } + + outfile->Printf("\tInitial overlap of initial guess = %15.10lf\n", norm); + + global_dpd_->file2_scm(&LIA, 1.0 / norm); + global_dpd_->file2_scm(&Lia, 1.0 / norm); + global_dpd_->buf4_scm(&LIJAB, 1.0 / norm); + global_dpd_->buf4_scm(&Lijab, 1.0 / norm); + global_dpd_->buf4_scm(&LIjAb, 1.0 / norm); + + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1A_lbl); + norm = global_dpd_->file2_dot(&LIA, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2AA_lbl); + norm += global_dpd_->buf4_dot(&LIJAB, &R2); + global_dpd_->buf4_close(&R2); + + if (params.ref <= 1) { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 0, 1, R1B_lbl); + norm += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 2, 7, 2, 7, 0, R2BB_lbl); + norm += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 0, 5, 0, 5, 0, R2AB_lbl); + norm += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } else { + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, L_irr, 2, 3, R1B_lbl); + norm += global_dpd_->file2_dot(&Lia, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 12, 17, 12, 17, 0, R2BB_lbl); + norm += global_dpd_->buf4_dot(&Lijab, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, L_irr, 22, 28, 22, 28, 0, R2AB_lbl); + norm += global_dpd_->buf4_dot(&LIjAb, &R2); + global_dpd_->buf4_close(&R2); + } + outfile->Printf("\tChecking overlap of initial guess = %15.10lf\n", norm); + + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Lia); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&LIjAb); } - outfile->Printf("\tChecking overlap of initial guess = %15.10lf\n", norm); - - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Lia); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&LIjAb); - } #ifdef EOM_DEBUG - outfile->Printf("initial guess\n"); - dpd_file2_init(&LIA, CC_LAMBDA, L_irr, 0, 1, "LIA"); - dpd_file2_print(&LIA,outfile); - dpd_file2_close(&LIA); + outfile->Printf("initial guess\n"); + dpd_file2_init(&LIA, CC_LAMBDA, L_irr, 0, 1, "LIA"); + dpd_file2_print(&LIA, outfile); + dpd_file2_close(&LIA); #endif } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/local.cc b/psi4/src/psi4/cclambda/local.cc index 699d3644050..37055cde785 100644 --- a/psi4/src/psi4/cclambda/local.cc +++ b/psi4/src/psi4/cclambda/local.cc @@ -49,7 +49,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /*! ** local_init(): Set up parameters of local excitation domains. @@ -65,238 +66,220 @@ namespace psi { namespace cclambda { ** TDC, Jan-June 2002 */ -void CCLambdaWavefunction::local_init(void) -{ - local.nso = moinfo.nso; - local.nocc = moinfo.occpi[0]; /* active doubly occupied orbitals */ - local.nvir = moinfo.virtpi[0]; /* active virtual orbitals */ +void CCLambdaWavefunction::local_init(void) { + local.nso = moinfo.nso; + local.nocc = moinfo.occpi[0]; /* active doubly occupied orbitals */ + local.nvir = moinfo.virtpi[0]; /* active virtual orbitals */ - outfile->Printf( "\tLocalization parameters ready.\n\n"); - -} - -void CCLambdaWavefunction::local_done(void) -{ - outfile->Printf( "\tLocal parameters free.\n"); + outfile->Printf("\tLocalization parameters ready.\n\n"); } -void local_filter_T1(dpdfile2 *T1) -{ - int i, a, ij, ii; - int nocc, nvir; - double *T1tilde, *T1bar; - psio_address next; - - nocc = local.nocc; - nvir = local.nvir; - - local.pairdom_len = init_int_array(nocc*nocc); - local.pairdom_nrlen = init_int_array(nocc*nocc); - local.eps_occ = init_array(nocc); - psio_read_entry(PSIF_CC_INFO, "Local Pair Domain Length", (char *) local.pairdom_len, - nocc*nocc*sizeof(int)); - psio_read_entry(PSIF_CC_INFO, "Local Pair Domain NR Length", (char *) local.pairdom_nrlen, - nocc*nocc*sizeof(int)); - psio_read_entry(PSIF_CC_INFO, "Local Occupied Orbital Energies", (char *) local.eps_occ, - nocc*sizeof(double)); - - local.W = (double ***) malloc(nocc * nocc * sizeof(double **)); - local.V = (double ***) malloc(nocc * nocc * sizeof(double **)); - local.eps_vir = (double **) malloc(nocc * nocc * sizeof(double *)); - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.eps_vir[ij] = init_array(local.pairdom_nrlen[ij]); - psio_read(PSIF_CC_INFO, "Local Virtual Orbital Energies", (char *) local.eps_vir[ij], - local.pairdom_nrlen[ij]*sizeof(double), next, &next); - } - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.V[ij] = block_matrix(nvir,local.pairdom_len[ij]); - psio_read(PSIF_CC_INFO, "Local Residual Vector (V)", (char *) local.V[ij][0], - nvir*local.pairdom_len[ij]*sizeof(double), next, &next); - } - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.W[ij] = block_matrix(local.pairdom_len[ij],local.pairdom_nrlen[ij]); - psio_read(PSIF_CC_INFO, "Local Transformation Matrix (W)", (char *) local.W[ij][0], - local.pairdom_len[ij]*local.pairdom_nrlen[ij]*sizeof(double), next, &next); - } - - global_dpd_->file2_mat_init(T1); - global_dpd_->file2_mat_rd(T1); - - for(i=0; i < nocc; i++) { - ii = i * nocc + i; /* diagonal element of pair matrices */ - - if(!local.pairdom_len[ii]) { - outfile->Printf( "\n\tlocal_filter_T1: Pair ii = [%d] is zero-length, which makes no sense.\n",ii); - throw PsiException("cclambda: error", __FILE__, __LINE__); +void CCLambdaWavefunction::local_done(void) { outfile->Printf("\tLocal parameters free.\n"); } + +void local_filter_T1(dpdfile2 *T1) { + int i, a, ij, ii; + int nocc, nvir; + double *T1tilde, *T1bar; + psio_address next; + + nocc = local.nocc; + nvir = local.nvir; + + local.pairdom_len = init_int_array(nocc * nocc); + local.pairdom_nrlen = init_int_array(nocc * nocc); + local.eps_occ = init_array(nocc); + psio_read_entry(PSIF_CC_INFO, "Local Pair Domain Length", (char *)local.pairdom_len, nocc * nocc * sizeof(int)); + psio_read_entry(PSIF_CC_INFO, "Local Pair Domain NR Length", (char *)local.pairdom_nrlen, + nocc * nocc * sizeof(int)); + psio_read_entry(PSIF_CC_INFO, "Local Occupied Orbital Energies", (char *)local.eps_occ, nocc * sizeof(double)); + + local.W = (double ***)malloc(nocc * nocc * sizeof(double **)); + local.V = (double ***)malloc(nocc * nocc * sizeof(double **)); + local.eps_vir = (double **)malloc(nocc * nocc * sizeof(double *)); + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.eps_vir[ij] = init_array(local.pairdom_nrlen[ij]); + psio_read(PSIF_CC_INFO, "Local Virtual Orbital Energies", (char *)local.eps_vir[ij], + local.pairdom_nrlen[ij] * sizeof(double), next, &next); + } + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.V[ij] = block_matrix(nvir, local.pairdom_len[ij]); + psio_read(PSIF_CC_INFO, "Local Residual Vector (V)", (char *)local.V[ij][0], + nvir * local.pairdom_len[ij] * sizeof(double), next, &next); + } + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.W[ij] = block_matrix(local.pairdom_len[ij], local.pairdom_nrlen[ij]); + psio_read(PSIF_CC_INFO, "Local Transformation Matrix (W)", (char *)local.W[ij][0], + local.pairdom_len[ij] * local.pairdom_nrlen[ij] * sizeof(double), next, &next); } - T1tilde = init_array(local.pairdom_len[ii]); - T1bar = init_array(local.pairdom_nrlen[ii]); + global_dpd_->file2_mat_init(T1); + global_dpd_->file2_mat_rd(T1); - /* Transform the virtuals to the redundant projected virtual basis */ - C_DGEMV('t', nvir, local.pairdom_len[ii], 1.0, &(local.V[ii][0][0]), local.pairdom_len[ii], - &(T1->matrix[0][i][0]), 1, 0.0, &(T1tilde[0]), 1); + for (i = 0; i < nocc; i++) { + ii = i * nocc + i; /* diagonal element of pair matrices */ - /* Transform the virtuals to the non-redundant virtual basis */ - C_DGEMV('t', local.pairdom_len[ii], local.pairdom_nrlen[ii], 1.0, &(local.W[ii][0][0]), local.pairdom_nrlen[ii], - &(T1tilde[0]), 1, 0.0, &(T1bar[0]), 1); + if (!local.pairdom_len[ii]) { + outfile->Printf("\n\tlocal_filter_T1: Pair ii = [%d] is zero-length, which makes no sense.\n", ii); + throw PsiException("cclambda: error", __FILE__, __LINE__); + } - /* Apply the denominators */ - for(a=0; a < local.pairdom_nrlen[ii]; a++) - T1bar[a] /= (local.eps_occ[i] - local.eps_vir[ii][a]); + T1tilde = init_array(local.pairdom_len[ii]); + T1bar = init_array(local.pairdom_nrlen[ii]); - /* Transform the new T1's to the redundant projected virtual basis */ - C_DGEMV('n', local.pairdom_len[ii], local.pairdom_nrlen[ii], 1.0, &(local.W[ii][0][0]), local.pairdom_nrlen[ii], - &(T1bar[0]), 1, 0.0, &(T1tilde[0]), 1); + /* Transform the virtuals to the redundant projected virtual basis */ + C_DGEMV('t', nvir, local.pairdom_len[ii], 1.0, &(local.V[ii][0][0]), local.pairdom_len[ii], + &(T1->matrix[0][i][0]), 1, 0.0, &(T1tilde[0]), 1); + /* Transform the virtuals to the non-redundant virtual basis */ + C_DGEMV('t', local.pairdom_len[ii], local.pairdom_nrlen[ii], 1.0, &(local.W[ii][0][0]), local.pairdom_nrlen[ii], + &(T1tilde[0]), 1, 0.0, &(T1bar[0]), 1); - /* Transform the new T1's to the MO basis */ - C_DGEMV('n', nvir, local.pairdom_len[ii], 1.0, &(local.V[ii][0][0]), local.pairdom_len[ii], - &(T1tilde[0]), 1, 0.0, &(T1->matrix[0][i][0]), 1); + /* Apply the denominators */ + for (a = 0; a < local.pairdom_nrlen[ii]; a++) T1bar[a] /= (local.eps_occ[i] - local.eps_vir[ii][a]); - free(T1bar); - free(T1tilde); + /* Transform the new T1's to the redundant projected virtual basis */ + C_DGEMV('n', local.pairdom_len[ii], local.pairdom_nrlen[ii], 1.0, &(local.W[ii][0][0]), local.pairdom_nrlen[ii], + &(T1bar[0]), 1, 0.0, &(T1tilde[0]), 1); - } + /* Transform the new T1's to the MO basis */ + C_DGEMV('n', nvir, local.pairdom_len[ii], 1.0, &(local.V[ii][0][0]), local.pairdom_len[ii], &(T1tilde[0]), 1, + 0.0, &(T1->matrix[0][i][0]), 1); - global_dpd_->file2_mat_wrt(T1); - global_dpd_->file2_mat_close(T1); + free(T1bar); + free(T1tilde); + } - for(i=0; i < nocc*nocc; i++) { - free_block(local.W[i]); - free_block(local.V[i]); - free(local.eps_vir[i]); - } - free(local.W); - free(local.V); - free(local.eps_vir); + global_dpd_->file2_mat_wrt(T1); + global_dpd_->file2_mat_close(T1); - free(local.eps_occ); - free(local.pairdom_len); - free(local.pairdom_nrlen); -} + for (i = 0; i < nocc * nocc; i++) { + free_block(local.W[i]); + free_block(local.V[i]); + free(local.eps_vir[i]); + } + free(local.W); + free(local.V); + free(local.eps_vir); -void local_filter_T2(dpdbuf4 *T2) -{ - int ij, i, j, a, b; - int nso, nocc, nvir; - double **X1, **X2, **T2tilde, **T2bar; - psio_address next; - - nso = local.nso; - nocc = local.nocc; - nvir = local.nvir; - - local.pairdom_len = init_int_array(nocc*nocc); - local.pairdom_nrlen = init_int_array(nocc*nocc); - local.weak_pairs = init_int_array(nocc*nocc); - local.eps_occ = init_array(nocc); - psio_read_entry(PSIF_CC_INFO, "Local Pair Domain Length", (char *) local.pairdom_len, - nocc*nocc*sizeof(int)); - psio_read_entry(PSIF_CC_INFO, "Local Pair Domain NR Length", (char *) local.pairdom_nrlen, - nocc*nocc*sizeof(int)); - psio_read_entry(PSIF_CC_INFO, "Local Occupied Orbital Energies", (char *) local.eps_occ, - nocc*sizeof(double)); - psio_read_entry(PSIF_CC_INFO, "Local Weak Pairs", (char *) local.weak_pairs, - nocc*nocc*sizeof(int)); - local.W = (double ***) malloc(nocc * nocc * sizeof(double **)); - local.V = (double ***) malloc(nocc * nocc * sizeof(double **)); - local.eps_vir = (double **) malloc(nocc * nocc * sizeof(double *)); - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.eps_vir[ij] = init_array(local.pairdom_nrlen[ij]); - psio_read(PSIF_CC_INFO, "Local Virtual Orbital Energies", (char *) local.eps_vir[ij], - local.pairdom_nrlen[ij]*sizeof(double), next, &next); - } - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.V[ij] = block_matrix(nvir,local.pairdom_len[ij]); - psio_read(PSIF_CC_INFO, "Local Residual Vector (V)", (char *) local.V[ij][0], - nvir*local.pairdom_len[ij]*sizeof(double), next, &next); - } - next = PSIO_ZERO; - for(ij=0; ij < nocc*nocc; ij++) { - local.W[ij] = block_matrix(local.pairdom_len[ij],local.pairdom_nrlen[ij]); - psio_read(PSIF_CC_INFO, "Local Transformation Matrix (W)", (char *) local.W[ij][0], - local.pairdom_len[ij]*local.pairdom_nrlen[ij]*sizeof(double), next, &next); - } - - /* Grab the MO-basis T2's */ - global_dpd_->buf4_mat_irrep_init(T2, 0); - global_dpd_->buf4_mat_irrep_rd(T2, 0); - - X1 = block_matrix(nso,nvir); - X2 = block_matrix(nvir,nso); - T2tilde = block_matrix(nso,nso); - T2bar = block_matrix(nvir, nvir); - - for(i=0,ij=0; i < nocc; i++) { - for(j=0; j < nocc; j++,ij++) { - - if(!local.weak_pairs[ij]) { + free(local.eps_occ); + free(local.pairdom_len); + free(local.pairdom_nrlen); +} - /* Transform the virtuals to the redundant projected virtual basis */ - C_DGEMM('t', 'n', local.pairdom_len[ij], nvir, nvir, 1.0, &(local.V[ij][0][0]), local.pairdom_len[ij], - &(T2->matrix[0][ij][0]), nvir, 0.0, &(X1[0][0]), nvir); - C_DGEMM('n', 'n', local.pairdom_len[ij], local.pairdom_len[ij], nvir, 1.0, &(X1[0][0]), nvir, - &(local.V[ij][0][0]), local.pairdom_len[ij], 0.0, &(T2tilde[0][0]), nso); +void local_filter_T2(dpdbuf4 *T2) { + int ij, i, j, a, b; + int nso, nocc, nvir; + double **X1, **X2, **T2tilde, **T2bar; + psio_address next; + + nso = local.nso; + nocc = local.nocc; + nvir = local.nvir; + + local.pairdom_len = init_int_array(nocc * nocc); + local.pairdom_nrlen = init_int_array(nocc * nocc); + local.weak_pairs = init_int_array(nocc * nocc); + local.eps_occ = init_array(nocc); + psio_read_entry(PSIF_CC_INFO, "Local Pair Domain Length", (char *)local.pairdom_len, nocc * nocc * sizeof(int)); + psio_read_entry(PSIF_CC_INFO, "Local Pair Domain NR Length", (char *)local.pairdom_nrlen, + nocc * nocc * sizeof(int)); + psio_read_entry(PSIF_CC_INFO, "Local Occupied Orbital Energies", (char *)local.eps_occ, nocc * sizeof(double)); + psio_read_entry(PSIF_CC_INFO, "Local Weak Pairs", (char *)local.weak_pairs, nocc * nocc * sizeof(int)); + local.W = (double ***)malloc(nocc * nocc * sizeof(double **)); + local.V = (double ***)malloc(nocc * nocc * sizeof(double **)); + local.eps_vir = (double **)malloc(nocc * nocc * sizeof(double *)); + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.eps_vir[ij] = init_array(local.pairdom_nrlen[ij]); + psio_read(PSIF_CC_INFO, "Local Virtual Orbital Energies", (char *)local.eps_vir[ij], + local.pairdom_nrlen[ij] * sizeof(double), next, &next); + } + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.V[ij] = block_matrix(nvir, local.pairdom_len[ij]); + psio_read(PSIF_CC_INFO, "Local Residual Vector (V)", (char *)local.V[ij][0], + nvir * local.pairdom_len[ij] * sizeof(double), next, &next); + } + next = PSIO_ZERO; + for (ij = 0; ij < nocc * nocc; ij++) { + local.W[ij] = block_matrix(local.pairdom_len[ij], local.pairdom_nrlen[ij]); + psio_read(PSIF_CC_INFO, "Local Transformation Matrix (W)", (char *)local.W[ij][0], + local.pairdom_len[ij] * local.pairdom_nrlen[ij] * sizeof(double), next, &next); + } - /* Transform the virtuals to the non-redundant virtual basis */ - C_DGEMM('t', 'n', local.pairdom_nrlen[ij], local.pairdom_len[ij], local.pairdom_len[ij], 1.0, - &(local.W[ij][0][0]), local.pairdom_nrlen[ij], &(T2tilde[0][0]), nso, 0.0, &(X2[0][0]), nso); - C_DGEMM('n', 'n', local.pairdom_nrlen[ij], local.pairdom_nrlen[ij], local.pairdom_len[ij], 1.0, - &(X2[0][0]), nso, &(local.W[ij][0][0]), local.pairdom_nrlen[ij], 0.0, &(T2bar[0][0]), nvir); - - /* Divide the new amplitudes by the denominators */ - for(a=0; a < local.pairdom_nrlen[ij]; a++) { - for(b=0; b < local.pairdom_nrlen[ij]; b++) { - T2bar[a][b] /= (local.eps_occ[i] + local.eps_occ[j] - - local.eps_vir[ij][a] - local.eps_vir[ij][b]); - } + /* Grab the MO-basis T2's */ + global_dpd_->buf4_mat_irrep_init(T2, 0); + global_dpd_->buf4_mat_irrep_rd(T2, 0); + + X1 = block_matrix(nso, nvir); + X2 = block_matrix(nvir, nso); + T2tilde = block_matrix(nso, nso); + T2bar = block_matrix(nvir, nvir); + + for (i = 0, ij = 0; i < nocc; i++) { + for (j = 0; j < nocc; j++, ij++) { + if (!local.weak_pairs[ij]) { + /* Transform the virtuals to the redundant projected virtual basis */ + C_DGEMM('t', 'n', local.pairdom_len[ij], nvir, nvir, 1.0, &(local.V[ij][0][0]), local.pairdom_len[ij], + &(T2->matrix[0][ij][0]), nvir, 0.0, &(X1[0][0]), nvir); + C_DGEMM('n', 'n', local.pairdom_len[ij], local.pairdom_len[ij], nvir, 1.0, &(X1[0][0]), nvir, + &(local.V[ij][0][0]), local.pairdom_len[ij], 0.0, &(T2tilde[0][0]), nso); + + /* Transform the virtuals to the non-redundant virtual basis */ + C_DGEMM('t', 'n', local.pairdom_nrlen[ij], local.pairdom_len[ij], local.pairdom_len[ij], 1.0, + &(local.W[ij][0][0]), local.pairdom_nrlen[ij], &(T2tilde[0][0]), nso, 0.0, &(X2[0][0]), nso); + C_DGEMM('n', 'n', local.pairdom_nrlen[ij], local.pairdom_nrlen[ij], local.pairdom_len[ij], 1.0, + &(X2[0][0]), nso, &(local.W[ij][0][0]), local.pairdom_nrlen[ij], 0.0, &(T2bar[0][0]), nvir); + + /* Divide the new amplitudes by the denominators */ + for (a = 0; a < local.pairdom_nrlen[ij]; a++) { + for (b = 0; b < local.pairdom_nrlen[ij]; b++) { + T2bar[a][b] /= + (local.eps_occ[i] + local.eps_occ[j] - local.eps_vir[ij][a] - local.eps_vir[ij][b]); + } + } + + /* Transform the new T2's to the redundant virtual basis */ + C_DGEMM('n', 'n', local.pairdom_len[ij], local.pairdom_nrlen[ij], local.pairdom_nrlen[ij], 1.0, + &(local.W[ij][0][0]), local.pairdom_nrlen[ij], &(T2bar[0][0]), nvir, 0.0, &(X1[0][0]), nvir); + C_DGEMM('n', 't', local.pairdom_len[ij], local.pairdom_len[ij], local.pairdom_nrlen[ij], 1.0, + &(X1[0][0]), nvir, &(local.W[ij][0][0]), local.pairdom_nrlen[ij], 0.0, &(T2tilde[0][0]), nso); + + /* Transform the new T2's to the MO basis */ + C_DGEMM('n', 'n', nvir, local.pairdom_len[ij], local.pairdom_len[ij], 1.0, &(local.V[ij][0][0]), + local.pairdom_len[ij], &(T2tilde[0][0]), nso, 0.0, &(X2[0][0]), nso); + C_DGEMM('n', 't', nvir, nvir, local.pairdom_len[ij], 1.0, &(X2[0][0]), nso, &(local.V[ij][0][0]), + local.pairdom_len[ij], 0.0, &(T2->matrix[0][ij][0]), nvir); + } else /* This must be a neglected weak pair; force it to zero */ + memset((void *)T2->matrix[0][ij], 0, nvir * nvir * sizeof(double)); } - - /* Transform the new T2's to the redundant virtual basis */ - C_DGEMM('n', 'n', local.pairdom_len[ij], local.pairdom_nrlen[ij], local.pairdom_nrlen[ij], 1.0, - &(local.W[ij][0][0]), local.pairdom_nrlen[ij], &(T2bar[0][0]), nvir, 0.0, &(X1[0][0]), nvir); - C_DGEMM('n','t', local.pairdom_len[ij], local.pairdom_len[ij], local.pairdom_nrlen[ij], 1.0, - &(X1[0][0]), nvir, &(local.W[ij][0][0]), local.pairdom_nrlen[ij], 0.0, &(T2tilde[0][0]), nso); - - /* Transform the new T2's to the MO basis */ - C_DGEMM('n', 'n', nvir, local.pairdom_len[ij], local.pairdom_len[ij], 1.0, - &(local.V[ij][0][0]), local.pairdom_len[ij], &(T2tilde[0][0]), nso, 0.0, &(X2[0][0]), nso); - C_DGEMM('n', 't', nvir, nvir, local.pairdom_len[ij], 1.0, &(X2[0][0]), nso, - &(local.V[ij][0][0]), local.pairdom_len[ij], 0.0, &(T2->matrix[0][ij][0]), nvir); - } - else /* This must be a neglected weak pair; force it to zero */ - memset((void *) T2->matrix[0][ij], 0, nvir*nvir*sizeof(double)); - } - } - free_block(X1); - free_block(X2); - free_block(T2tilde); - free_block(T2bar); - - /* Write the updated MO-basis T2's to disk */ - global_dpd_->buf4_mat_irrep_wrt(T2, 0); - global_dpd_->buf4_mat_irrep_close(T2, 0); - - for(i=0; i < nocc*nocc; i++) { - free_block(local.W[i]); - free_block(local.V[i]); - free(local.eps_vir[i]); - } - free(local.W); - free(local.V); - free(local.eps_vir); - - free(local.eps_occ); - free(local.pairdom_len); - free(local.pairdom_nrlen); - free(local.weak_pairs); + free_block(X1); + free_block(X2); + free_block(T2tilde); + free_block(T2bar); + + /* Write the updated MO-basis T2's to disk */ + global_dpd_->buf4_mat_irrep_wrt(T2, 0); + global_dpd_->buf4_mat_irrep_close(T2, 0); + + for (i = 0; i < nocc * nocc; i++) { + free_block(local.W[i]); + free_block(local.V[i]); + free(local.eps_vir[i]); + } + free(local.W); + free(local.V); + free(local.eps_vir); + + free(local.eps_occ); + free(local.pairdom_len); + free(local.pairdom_nrlen); + free(local.weak_pairs); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/ortho_Rs.cc b/psi4/src/psi4/cclambda/ortho_Rs.cc index 4fbe9b13256..20ecf6fdd55 100644 --- a/psi4/src/psi4/cclambda/ortho_Rs.cc +++ b/psi4/src/psi4/cclambda/ortho_Rs.cc @@ -38,7 +38,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { double LRi_dot(int IRR, int R_index); void LRi_minus(int IRR, int R_index, double overlap, double R0); @@ -49,92 +50,90 @@ void LRi_minus(int IRR, int R_index, double overlap, double R0); - ROHF and UHF still need to be added */ void ortho_Rs(struct L_Params *pL_params, int current_L) { - int L_state_index, L_root, L_irr; - int R_state_index, R_root, R_irr; - double **O, tval, overlap; - int L, R; + int L_state_index, L_root, L_irr; + int R_state_index, R_root, R_irr; + double **O, tval, overlap; + int L, R; - if (params.ref != 0) return; + if (params.ref != 0) return; - L_irr = pL_params[current_L].irrep; - L_root = pL_params[current_L].root; + L_irr = pL_params[current_L].irrep; + L_root = pL_params[current_L].root; - for (R=1; RPrintf("overlap with R[%d][%d]: %15.10lf\n", R_irr, R_root, overlap); */ - LRi_minus(L_irr, R_root, overlap, pL_params[R].R0); - /* overlap = LRi_dot(L_irr, R_root); - if (L_root == -1) - overlap += pL_params[R].R0; - outfile->Printf("overlap with R[%d][%d]: %15.10lf\n", R_irr, R_root, overlap); */ - } - return; + /* outfile->Printf("overlap with R[%d][%d]: %15.10lf\n", R_irr, R_root, overlap); */ + LRi_minus(L_irr, R_root, overlap, pL_params[R].R0); + /* overlap = LRi_dot(L_irr, R_root); + if (L_root == -1) + overlap += pL_params[R].R0; + outfile->Printf("overlap with R[%d][%d]: %15.10lf\n", R_irr, R_root, overlap); */ + } + return; } double LRi_dot(int IRR, int R_index) { - dpdfile2 R1, L1; - dpdbuf4 R2, L2; - double overlap; - char R1A_lbl[32], lbl[32]; - - sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); - overlap = 2.0 * global_dpd_->file2_dot(&L1, &R1); - global_dpd_->file2_close(&R1); - global_dpd_->file2_close(&L1); - - sprintf(lbl, "2RIjAb - RIjbA %d %d", IRR, R_index); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, IRR, 0, 5, 0, 5, 0, "New LIjAb"); - overlap += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&R2); - - return overlap; + dpdfile2 R1, L1; + dpdbuf4 R2, L2; + double overlap; + char R1A_lbl[32], lbl[32]; + + sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); + overlap = 2.0 * global_dpd_->file2_dot(&L1, &R1); + global_dpd_->file2_close(&R1); + global_dpd_->file2_close(&L1); + + sprintf(lbl, "2RIjAb - RIjbA %d %d", IRR, R_index); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, IRR, 0, 5, 0, 5, 0, "New LIjAb"); + overlap += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&R2); + + return overlap; } void LRi_minus(int IRR, int R_index, double overlap, double R0) { - dpdfile2 R1, L1; - dpdbuf4 R2, L2; - char L1A_lbl[32], R1A_lbl[32], lbl[32]; - - sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); - global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); - global_dpd_->file2_axpy(&R1, &L1, -overlap/(1.0 - R0*R0), 0); - global_dpd_->file2_close(&R1); - global_dpd_->file2_close(&L1); - - sprintf(lbl, "RIjAb %d %d", IRR, R_index); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, IRR, 0, 5, 0, 5, 0, "New LIjAb"); - global_dpd_->buf4_axpy(&R2, &L2, -overlap/(1.0 - R0*R0)); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_close(&R2); - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); - global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "New Lia"); - global_dpd_->file2_close(&L1); - /* - dpd_buf4_init(&L2, CC_LAMBDA, IRR, 2, 7, 0, 5, 1, "New LIjAb"); - dpd_buf4_copy(&L2, CC_LAMBDA, "New LIJAB"); - dpd_buf4_copy(&L2, CC_LAMBDA, "New Lijab"); - dpd_buf4_close(&L2); - */ - return; + dpdfile2 R1, L1; + dpdbuf4 R2, L2; + char L1A_lbl[32], R1A_lbl[32], lbl[32]; + + sprintf(R1A_lbl, "RIA %d %d", IRR, R_index); + global_dpd_->file2_init(&R1, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); + global_dpd_->file2_axpy(&R1, &L1, -overlap / (1.0 - R0 * R0), 0); + global_dpd_->file2_close(&R1); + global_dpd_->file2_close(&L1); + + sprintf(lbl, "RIjAb %d %d", IRR, R_index); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, lbl); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, IRR, 0, 5, 0, 5, 0, "New LIjAb"); + global_dpd_->buf4_axpy(&R2, &L2, -overlap / (1.0 - R0 * R0)); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_close(&R2); + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, IRR, 0, 1, "New LIA"); + global_dpd_->file2_copy(&L1, PSIF_CC_LAMBDA, "New Lia"); + global_dpd_->file2_close(&L1); + /* + dpd_buf4_init(&L2, CC_LAMBDA, IRR, 2, 7, 0, 5, 1, "New LIjAb"); + dpd_buf4_copy(&L2, CC_LAMBDA, "New LIJAB"); + dpd_buf4_copy(&L2, CC_LAMBDA, "New Lijab"); + dpd_buf4_close(&L2); + */ + return; } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/overlap.cc b/psi4/src/psi4/cclambda/overlap.cc index 12b5f99c6c5..db6d94f3a54 100644 --- a/psi4/src/psi4/cclambda/overlap.cc +++ b/psi4/src/psi4/cclambda/overlap.cc @@ -37,186 +37,190 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void overlap(int L_irr) -{ - int h, nirreps; - int row, col; - int i,j,a,b,I,J,A,B,Isym,Jsym,Asym,Bsym; - dpdfile2 T1, L1, T1A, T1B; - dpdbuf4 T2, L2; - double value = 1.0; - double ST1A, ST1B, ST2AA, ST2BB, ST2AB, ST12AA, ST12BB, ST12AB; - - nirreps = moinfo.nirreps; - - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); - ST1A = global_dpd_->file2_dot(&T1, &L1); - global_dpd_->file2_close(&L1); - global_dpd_->file2_close(&T1); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); - } - ST1B = global_dpd_->file2_dot(&T1, &L1); - global_dpd_->file2_close(&L1); - global_dpd_->file2_close(&T1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - ST2AA = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); - } - ST2BB = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - } - ST2AB = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_mat_init(&T1A); - global_dpd_->file2_mat_rd(&T1A); - if(params.ref == 0 || params.ref == 1) /** RHF/ROHF **/ - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); - else if(params.ref == 2) /** UHF **/ - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); - global_dpd_->file2_mat_init(&T1B); - global_dpd_->file2_mat_rd(&T1B); - - ST12AA = 0.0; - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1A.params->rowidx[i]; Isym = T1A.params->psym[i]; - J = T1A.params->rowidx[j]; Jsym = T1A.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1A.params->colidx[a]; Asym = T1A.params->qsym[a]; - B = T1A.params->colidx[b]; Bsym = T1A.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12AA += L2.matrix[h][row][col] * - T1A.matrix[Isym][I][A] * T1A.matrix[Jsym][J][B]; - if((Isym == Bsym) && (Jsym == Asym)) - ST12AA -= L2.matrix[h][row][col] * - T1A.matrix[Isym][I][B] * T1A.matrix[Jsym][J][A]; - } +namespace psi { +namespace cclambda { + +void overlap(int L_irr) { + int h, nirreps; + int row, col; + int i, j, a, b, I, J, A, B, Isym, Jsym, Asym, Bsym; + dpdfile2 T1, L1, T1A, T1B; + dpdbuf4 T2, L2; + double value = 1.0; + double ST1A, ST1B, ST2AA, ST2BB, ST2AB, ST12AA, ST12BB, ST12AB; + + nirreps = moinfo.nirreps; + + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); + ST1A = global_dpd_->file2_dot(&T1, &L1); + global_dpd_->file2_close(&L1); + global_dpd_->file2_close(&T1); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - ST12BB = 0.0; - - if(params.ref == 0 || params.ref == 1) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - else if(params.ref == 2) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1B.params->rowidx[i]; Isym = T1B.params->psym[i]; - J = T1B.params->rowidx[j]; Jsym = T1B.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1B.params->colidx[a]; Asym = T1B.params->qsym[a]; - B = T1B.params->colidx[b]; Bsym = T1B.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12BB += L2.matrix[h][row][col] * - T1B.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; - if((Isym == Bsym) && (Jsym == Asym)) - ST12BB -= L2.matrix[h][row][col] * - T1B.matrix[Isym][I][B] * T1B.matrix[Jsym][J][A]; - } + ST1B = global_dpd_->file2_dot(&T1, &L1); + global_dpd_->file2_close(&L1); + global_dpd_->file2_close(&T1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + ST2AA = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - ST12AB = 0.0; - - if(params.ref == 0 || params.ref == 1) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - else if(params.ref == 2) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1A.params->rowidx[i]; Isym = T1A.params->psym[i]; - J = T1B.params->rowidx[j]; Jsym = T1B.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1A.params->colidx[a]; Asym = T1A.params->qsym[a]; - B = T1B.params->colidx[b]; Bsym = T1B.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12AB += L2.matrix[h][row][col] * - T1A.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; - } + ST2BB = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - - global_dpd_->file2_mat_close(&T1A); - global_dpd_->file2_close(&T1A); - global_dpd_->file2_mat_close(&T1B); - global_dpd_->file2_close(&T1B); - - /* - outfile->Printf( "\tST1A = %20.15f\n", ST1A); - outfile->Printf( "\tST1B = %20.15f\n", ST1B); - outfile->Printf( "\tST2AA = %20.15f\n", ST2AA); - outfile->Printf( "\tST2BB = %20.15f\n", ST2BB); - outfile->Printf( "\tST2AB = %20.15f\n", ST2AB); - outfile->Printf( "\tST12AA = %20.15f\n", ST12AA); - outfile->Printf( "\tST12BB = %20.15f\n", ST12BB); - outfile->Printf( "\tST12AB = %20.15f\n", ST12AB); - */ - - value = 1.0 - ST1A - ST1B - ST2AA - ST2BB - ST2AB + ST12AA + ST12BB + ST12AB; - - outfile->Printf( "\tOverlap = %20.11f\n", value); + ST2AB = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_mat_init(&T1A); + global_dpd_->file2_mat_rd(&T1A); + if (params.ref == 0 || params.ref == 1) /** RHF/ROHF **/ + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); + else if (params.ref == 2) /** UHF **/ + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); + global_dpd_->file2_mat_init(&T1B); + global_dpd_->file2_mat_rd(&T1B); + + ST12AA = 0.0; + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1A.params->rowidx[i]; + Isym = T1A.params->psym[i]; + J = T1A.params->rowidx[j]; + Jsym = T1A.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1A.params->colidx[a]; + Asym = T1A.params->qsym[a]; + B = T1A.params->colidx[b]; + Bsym = T1A.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12AA += L2.matrix[h][row][col] * T1A.matrix[Isym][I][A] * T1A.matrix[Jsym][J][B]; + if ((Isym == Bsym) && (Jsym == Asym)) + ST12AA -= L2.matrix[h][row][col] * T1A.matrix[Isym][I][B] * T1A.matrix[Jsym][J][A]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + ST12BB = 0.0; + + if (params.ref == 0 || params.ref == 1) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + else if (params.ref == 2) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1B.params->rowidx[i]; + Isym = T1B.params->psym[i]; + J = T1B.params->rowidx[j]; + Jsym = T1B.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1B.params->colidx[a]; + Asym = T1B.params->qsym[a]; + B = T1B.params->colidx[b]; + Bsym = T1B.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12BB += L2.matrix[h][row][col] * T1B.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; + if ((Isym == Bsym) && (Jsym == Asym)) + ST12BB -= L2.matrix[h][row][col] * T1B.matrix[Isym][I][B] * T1B.matrix[Jsym][J][A]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + ST12AB = 0.0; + + if (params.ref == 0 || params.ref == 1) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + else if (params.ref == 2) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1A.params->rowidx[i]; + Isym = T1A.params->psym[i]; + J = T1B.params->rowidx[j]; + Jsym = T1B.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1A.params->colidx[a]; + Asym = T1A.params->qsym[a]; + B = T1B.params->colidx[b]; + Bsym = T1B.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12AB += L2.matrix[h][row][col] * T1A.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_mat_close(&T1A); + global_dpd_->file2_close(&T1A); + global_dpd_->file2_mat_close(&T1B); + global_dpd_->file2_close(&T1B); + + /* + outfile->Printf( "\tST1A = %20.15f\n", ST1A); + outfile->Printf( "\tST1B = %20.15f\n", ST1B); + outfile->Printf( "\tST2AA = %20.15f\n", ST2AA); + outfile->Printf( "\tST2BB = %20.15f\n", ST2BB); + outfile->Printf( "\tST2AB = %20.15f\n", ST2AB); + outfile->Printf( "\tST12AA = %20.15f\n", ST12AA); + outfile->Printf( "\tST12BB = %20.15f\n", ST12BB); + outfile->Printf( "\tST12AB = %20.15f\n", ST12AB); + */ + + value = 1.0 - ST1A - ST1B - ST2AA - ST2BB - ST2AB + ST12AA + ST12BB + ST12AB; + + outfile->Printf("\tOverlap = %20.11f\n", value); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/overlap_LAMPS.cc b/psi4/src/psi4/cclambda/overlap_LAMPS.cc index 94b308aedf5..136dc08978b 100644 --- a/psi4/src/psi4/cclambda/overlap_LAMPS.cc +++ b/psi4/src/psi4/cclambda/overlap_LAMPS.cc @@ -37,194 +37,198 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void overlap_LAMPS(struct L_Params L_params) -{ - int h, nirreps, L_irr; - int row, col; - int i,j,a,b,I,J,A,B,Isym,Jsym,Asym,Bsym; - dpdfile2 T1, L1, T1A, T1B; - dpdbuf4 T2, L2; - double value = 1.0; - double ST1A, ST1B, ST2AA, ST2BB, ST2AB, ST12AA, ST12BB, ST12AB; - char *L1A_lbl, *L1B_lbl, *L2AA_lbl, *L2BB_lbl, *L2AB_lbl, *L2RHF_lbl; - char lbl[32]; - L1A_lbl = L_params.L1A_lbl; - L1B_lbl = L_params.L1B_lbl; - L2AA_lbl = L_params.L2AA_lbl; - L2BB_lbl = L_params.L2BB_lbl; - L2AB_lbl = L_params.L2AB_lbl; - L2RHF_lbl = L_params.L2RHF_lbl; - nirreps = moinfo.nirreps; - L_irr = L_params.irrep; - - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 0, 1, L1A_lbl); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); - ST1A = global_dpd_->file2_dot(&T1, &L1); - global_dpd_->file2_close(&L1); - global_dpd_->file2_close(&T1); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 0, 1, L1B_lbl); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 2, 3, L1B_lbl); - global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); - } - ST1B = global_dpd_->file2_dot(&T1, &L1); - global_dpd_->file2_close(&L1); - global_dpd_->file2_close(&T1); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2AA_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - ST2AA = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2BB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 12, 17, 12, 17, 0, L2BB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); - } - ST2BB = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - if(params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - } - else if(params.ref == 2) { /** UHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - } - ST2AB = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - - global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_mat_init(&T1A); - global_dpd_->file2_mat_rd(&T1A); - if(params.ref == 0 || params.ref == 1) /** RHF/ROHF **/ - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); - else if(params.ref == 2) /** UHF **/ - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); - global_dpd_->file2_mat_init(&T1B); - global_dpd_->file2_mat_rd(&T1B); - - ST12AA = 0.0; - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2AA_lbl); - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1A.params->rowidx[i]; Isym = T1A.params->psym[i]; - J = T1A.params->rowidx[j]; Jsym = T1A.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1A.params->colidx[a]; Asym = T1A.params->qsym[a]; - B = T1A.params->colidx[b]; Bsym = T1A.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12AA += L2.matrix[h][row][col] * - T1A.matrix[Isym][I][A] * T1A.matrix[Jsym][J][B]; - if((Isym == Bsym) && (Jsym == Asym)) - ST12AA -= L2.matrix[h][row][col] * - T1A.matrix[Isym][I][B] * T1A.matrix[Jsym][J][A]; - } +namespace psi { +namespace cclambda { + +void overlap_LAMPS(struct L_Params L_params) { + int h, nirreps, L_irr; + int row, col; + int i, j, a, b, I, J, A, B, Isym, Jsym, Asym, Bsym; + dpdfile2 T1, L1, T1A, T1B; + dpdbuf4 T2, L2; + double value = 1.0; + double ST1A, ST1B, ST2AA, ST2BB, ST2AB, ST12AA, ST12BB, ST12AB; + char *L1A_lbl, *L1B_lbl, *L2AA_lbl, *L2BB_lbl, *L2AB_lbl, *L2RHF_lbl; + char lbl[32]; + L1A_lbl = L_params.L1A_lbl; + L1B_lbl = L_params.L1B_lbl; + L2AA_lbl = L_params.L2AA_lbl; + L2BB_lbl = L_params.L2BB_lbl; + L2AB_lbl = L_params.L2AB_lbl; + L2RHF_lbl = L_params.L2RHF_lbl; + nirreps = moinfo.nirreps; + L_irr = L_params.irrep; + + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 0, 1, L1A_lbl); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tIA"); + ST1A = global_dpd_->file2_dot(&T1, &L1); + global_dpd_->file2_close(&L1); + global_dpd_->file2_close(&T1); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 0, 1, L1B_lbl); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 0, 1, "tia"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->file2_init(&L1, PSIF_CC_LAMPS, L_irr, 2, 3, L1B_lbl); + global_dpd_->file2_init(&T1, PSIF_CC_OEI, 0, 2, 3, "tia"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - ST12BB = 0.0; - - if(params.ref == 0 || params.ref == 1) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2BB_lbl); - else if(params.ref == 2) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 12, 17, 12, 17, 0, L2BB_lbl); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1B.params->rowidx[i]; Isym = T1B.params->psym[i]; - J = T1B.params->rowidx[j]; Jsym = T1B.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1B.params->colidx[a]; Asym = T1B.params->qsym[a]; - B = T1B.params->colidx[b]; Bsym = T1B.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12BB += L2.matrix[h][row][col] * - T1B.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; - if((Isym == Bsym) && (Jsym == Asym)) - ST12BB -= L2.matrix[h][row][col] * - T1B.matrix[Isym][I][B] * T1B.matrix[Jsym][J][A]; - } + ST1B = global_dpd_->file2_dot(&T1, &L1); + global_dpd_->file2_close(&L1); + global_dpd_->file2_close(&T1); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2AA_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + ST2AA = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2BB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 12, 17, 12, 17, 0, L2BB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - ST12AB = 0.0; - - if(params.ref == 0 || params.ref == 1) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); - else if(params.ref == 2) - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 22, 28, 22, 28, 0, L2AB_lbl); - - for(h=0; h < nirreps; h++) { - global_dpd_->buf4_mat_irrep_init(&L2, h); - global_dpd_->buf4_mat_irrep_rd(&L2, h); - for(row=0; row < L2.params->rowtot[h]; row++) { - i = L2.params->roworb[h][row][0]; - j = L2.params->roworb[h][row][1]; - I = T1A.params->rowidx[i]; Isym = T1A.params->psym[i]; - J = T1B.params->rowidx[j]; Jsym = T1B.params->psym[j]; - for(col=0; col < L2.params->coltot[h^L_irr]; col++) { - a = L2.params->colorb[h^L_irr][col][0]; - b = L2.params->colorb[h^L_irr][col][1]; - A = T1A.params->colidx[a]; Asym = T1A.params->qsym[a]; - B = T1B.params->colidx[b]; Bsym = T1B.params->qsym[b]; - if((Isym == Asym) && (Jsym == Bsym)) - ST12AB += L2.matrix[h][row][col] * - T1A.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; - } + ST2BB = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + if (params.ref == 0 || params.ref == 1) { /** RHF/ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + } else if (params.ref == 2) { /** UHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); } - global_dpd_->buf4_mat_irrep_close(&L2, h); - } - global_dpd_->buf4_close(&L2); - - - global_dpd_->file2_mat_close(&T1A); - global_dpd_->file2_close(&T1A); - global_dpd_->file2_mat_close(&T1B); - global_dpd_->file2_close(&T1B); - - /* - outfile->Printf( "\tST1A = %20.15f\n", ST1A); - outfile->Printf( "\tST1B = %20.15f\n", ST1B); - outfile->Printf( "\tST2AA = %20.15f\n", ST2AA); - outfile->Printf( "\tST2BB = %20.15f\n", ST2BB); - outfile->Printf( "\tST2AB = %20.15f\n", ST2AB); - outfile->Printf( "\tST12AA = %20.15f\n", ST12AA); - outfile->Printf( "\tST12BB = %20.15f\n", ST12BB); - outfile->Printf( "\tST12AB = %20.15f\n", ST12AB); - */ - - value = 1.0 - ST1A - ST1B - ST2AA - ST2BB - ST2AB + ST12AA + ST12BB + ST12AB; - - outfile->Printf( "\tOverlap = %20.11f\n", value); + ST2AB = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_mat_init(&T1A); + global_dpd_->file2_mat_rd(&T1A); + if (params.ref == 0 || params.ref == 1) /** RHF/ROHF **/ + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); + else if (params.ref == 2) /** UHF **/ + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); + global_dpd_->file2_mat_init(&T1B); + global_dpd_->file2_mat_rd(&T1B); + + ST12AA = 0.0; + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2AA_lbl); + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1A.params->rowidx[i]; + Isym = T1A.params->psym[i]; + J = T1A.params->rowidx[j]; + Jsym = T1A.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1A.params->colidx[a]; + Asym = T1A.params->qsym[a]; + B = T1A.params->colidx[b]; + Bsym = T1A.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12AA += L2.matrix[h][row][col] * T1A.matrix[Isym][I][A] * T1A.matrix[Jsym][J][B]; + if ((Isym == Bsym) && (Jsym == Asym)) + ST12AA -= L2.matrix[h][row][col] * T1A.matrix[Isym][I][B] * T1A.matrix[Jsym][J][A]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + ST12BB = 0.0; + + if (params.ref == 0 || params.ref == 1) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 2, 7, 2, 7, 0, L2BB_lbl); + else if (params.ref == 2) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 12, 17, 12, 17, 0, L2BB_lbl); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1B.params->rowidx[i]; + Isym = T1B.params->psym[i]; + J = T1B.params->rowidx[j]; + Jsym = T1B.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1B.params->colidx[a]; + Asym = T1B.params->qsym[a]; + B = T1B.params->colidx[b]; + Bsym = T1B.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12BB += L2.matrix[h][row][col] * T1B.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; + if ((Isym == Bsym) && (Jsym == Asym)) + ST12BB -= L2.matrix[h][row][col] * T1B.matrix[Isym][I][B] * T1B.matrix[Jsym][J][A]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + ST12AB = 0.0; + + if (params.ref == 0 || params.ref == 1) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 0, 5, 0, 5, 0, L2AB_lbl); + else if (params.ref == 2) + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, L_irr, 22, 28, 22, 28, 0, L2AB_lbl); + + for (h = 0; h < nirreps; h++) { + global_dpd_->buf4_mat_irrep_init(&L2, h); + global_dpd_->buf4_mat_irrep_rd(&L2, h); + for (row = 0; row < L2.params->rowtot[h]; row++) { + i = L2.params->roworb[h][row][0]; + j = L2.params->roworb[h][row][1]; + I = T1A.params->rowidx[i]; + Isym = T1A.params->psym[i]; + J = T1B.params->rowidx[j]; + Jsym = T1B.params->psym[j]; + for (col = 0; col < L2.params->coltot[h ^ L_irr]; col++) { + a = L2.params->colorb[h ^ L_irr][col][0]; + b = L2.params->colorb[h ^ L_irr][col][1]; + A = T1A.params->colidx[a]; + Asym = T1A.params->qsym[a]; + B = T1B.params->colidx[b]; + Bsym = T1B.params->qsym[b]; + if ((Isym == Asym) && (Jsym == Bsym)) + ST12AB += L2.matrix[h][row][col] * T1A.matrix[Isym][I][A] * T1B.matrix[Jsym][J][B]; + } + } + global_dpd_->buf4_mat_irrep_close(&L2, h); + } + global_dpd_->buf4_close(&L2); + + global_dpd_->file2_mat_close(&T1A); + global_dpd_->file2_close(&T1A); + global_dpd_->file2_mat_close(&T1B); + global_dpd_->file2_close(&T1B); + + /* + outfile->Printf( "\tST1A = %20.15f\n", ST1A); + outfile->Printf( "\tST1B = %20.15f\n", ST1B); + outfile->Printf( "\tST2AA = %20.15f\n", ST2AA); + outfile->Printf( "\tST2BB = %20.15f\n", ST2BB); + outfile->Printf( "\tST2AB = %20.15f\n", ST2AB); + outfile->Printf( "\tST12AA = %20.15f\n", ST12AA); + outfile->Printf( "\tST12BB = %20.15f\n", ST12BB); + outfile->Printf( "\tST12AB = %20.15f\n", ST12AB); + */ + + value = 1.0 - ST1A - ST1B - ST2AA - ST2BB - ST2AB + ST12AA + ST12BB + ST12AB; + + outfile->Printf("\tOverlap = %20.11f\n", value); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/projections.cc b/psi4/src/psi4/cclambda/projections.cc index 4027fd98d3b..0f54273f9b1 100644 --- a/psi4/src/psi4/cclambda/projections.cc +++ b/psi4/src/psi4/cclambda/projections.cc @@ -38,7 +38,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* projections() computes the projection of the EOM CCSD wavefunction onto the reference, singles and doubles spaces, respectively. These values may be @@ -60,318 +61,304 @@ where dot_L1T1 = Lme Tme dot_L2T2 = Lmnef Tmnef */ void projections(struct L_Params *pL_params) { - int IRR; - int i,j, root; - double R0, projection_0, projection_S, projection_D, projection_tot, ael; - double dot_L1T1=0, dot_L2T2=0, dot_L2T1T1=0, dot_L1R1=0, dot_L2T1R1=0; - double dot_L2R2=0; - char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; - char L1A_lbl[32], L1B_lbl[32], L2AA_lbl[32], L2BB_lbl[32], L2AB_lbl[32], L2AB_lbl2[32]; - dpdfile2 L1A, L1B, T1A, T1B, I1, R1A, R1B; - dpdbuf4 T2, L2, R2; - /* assumes that the excited-Rs are available */ + int IRR; + int i, j, root; + double R0, projection_0, projection_S, projection_D, projection_tot, ael; + double dot_L1T1 = 0, dot_L2T2 = 0, dot_L2T1T1 = 0, dot_L1R1 = 0, dot_L2T1R1 = 0; + double dot_L2R2 = 0; + char R1A_lbl[32], R1B_lbl[32], R2AA_lbl[32], R2BB_lbl[32], R2AB_lbl[32]; + char L1A_lbl[32], L1B_lbl[32], L2AA_lbl[32], L2BB_lbl[32], L2AB_lbl[32], L2AB_lbl2[32]; + dpdfile2 L1A, L1B, T1A, T1B, I1, R1A, R1B; + dpdbuf4 T2, L2, R2; + /* assumes that the excited-Rs are available */ - if (params.ref == 0) { - global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); - global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); - } + if (params.ref == 0) { + global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); + } else if (params.ref == 1) { + global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 0, 1, "tia"); + } else if (params.ref == 2) { + global_dpd_->file2_init(&T1A, PSIF_CC_OEI, 0, 0, 1, "tIA"); + global_dpd_->file2_init(&T1B, PSIF_CC_OEI, 0, 2, 3, "tia"); + } - for (i=1; ifile2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); - global_dpd_->file2_init(&L1B, PSIF_CC_LAMPS, IRR, 0, 1, L1B_lbl); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); - global_dpd_->file2_init(&L1B, PSIF_CC_LAMPS, IRR, 2, 3, L1B_lbl); - } + if (params.ref == 0) { + global_dpd_->file2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); + } else if (params.ref == 1) { + global_dpd_->file2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); + global_dpd_->file2_init(&L1B, PSIF_CC_LAMPS, IRR, 0, 1, L1B_lbl); + } else if (params.ref == 2) { + global_dpd_->file2_init(&L1A, PSIF_CC_LAMPS, IRR, 0, 1, L1A_lbl); + global_dpd_->file2_init(&L1B, PSIF_CC_LAMPS, IRR, 2, 3, L1B_lbl); + } - if (IRR == 0) { - /* dot_L1T1 = <0|Lme Tme|0>, assuming L0=0 (excited state) */ - if (params.ref == 0) { - dot_L1T1 = 2.0 * global_dpd_->file2_dot(&L1A, &T1A); - } - else if (params.ref >= 1) { - dot_L1T1 = global_dpd_->file2_dot(&L1A, &T1A); - dot_L1T1 += global_dpd_->file2_dot(&L1B, &T1B); - } + if (IRR == 0) { + /* dot_L1T1 = <0|Lme Tme|0>, assuming L0=0 (excited state) */ + if (params.ref == 0) { + dot_L1T1 = 2.0 * global_dpd_->file2_dot(&L1A, &T1A); + } else if (params.ref >= 1) { + dot_L1T1 = global_dpd_->file2_dot(&L1A, &T1A); + dot_L1T1 += global_dpd_->file2_dot(&L1B, &T1B); + } - /* dot_L2T2 = <0|Lmnef Tmnef|0> */ - if (params.ref == 0) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "2 tIjAb - tIjBa"); - dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - } - else if (params.ref == 1) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); - dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); - dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - } - else if (params.ref == 2) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); - dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 12, 17, 12, 17, 0, L2BB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); - dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); - dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); - global_dpd_->buf4_close(&T2); - global_dpd_->buf4_close(&L2); - } - /* dot_L2T1T1 = TNF (TME LMNEF) + Tnf (Tme Lmnef) + 2*Tnf(TME LMnEf) */ - if (params.ref == 0) { - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 = 2.0 * global_dpd_->file2_dot(&T1A, &I1); - global_dpd_->file2_close(&I1); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 = global_dpd_->file2_dot(&T1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2BB_lbl); - global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 += global_dpd_->file2_dot(&T1B, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 += 2.0 * global_dpd_->file2_dot(&T1B, &I1); - global_dpd_->file2_close(&I1); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 = global_dpd_->file2_dot(&T1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 10, 15, 12, 17, 0, L2BB_lbl); - global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 += global_dpd_->file2_dot(&T1B, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1T1 += 2.0 * global_dpd_->file2_dot(&T1B, &I1); - global_dpd_->file2_close(&I1); - } - } + /* dot_L2T2 = <0|Lmnef Tmnef|0> */ + if (params.ref == 0) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "2 tIjAb - tIjBa"); + dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 1) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tijab"); + dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 0, 5, 0, 5, 0, "tIjAb"); + dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 2, 7, 2, 7, 0, "tIJAB"); + dot_L2T2 = global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 12, 17, 12, 17, 0, L2BB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 12, 17, 12, 17, 0, "tijab"); + dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->buf4_init(&T2, PSIF_CC_TAMPS, 0, 22, 28, 22, 28, 0, "tIjAb"); + dot_L2T2 += global_dpd_->buf4_dot(&L2, &T2); + global_dpd_->buf4_close(&T2); + global_dpd_->buf4_close(&L2); + } + /* dot_L2T1T1 = TNF (TME LMNEF) + Tnf (Tme Lmnef) + 2*Tnf(TME LMnEf) */ + if (params.ref == 0) { + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 = 2.0 * global_dpd_->file2_dot(&T1A, &I1); + global_dpd_->file2_close(&I1); + } else if (params.ref == 1) { + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 = global_dpd_->file2_dot(&T1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2BB_lbl); + global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 += global_dpd_->file2_dot(&T1B, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 += 2.0 * global_dpd_->file2_dot(&T1B, &I1); + global_dpd_->file2_close(&I1); + } else if (params.ref == 2) { + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X(N,F)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 = global_dpd_->file2_dot(&T1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 10, 15, 12, 17, 0, L2BB_lbl); + global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 += global_dpd_->file2_dot(&T1B, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1T1 += 2.0 * global_dpd_->file2_dot(&T1B, &I1); + global_dpd_->file2_close(&I1); + } + } - /* open R files */ - if (params.ref == 0) { - global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&R1B, PSIF_CC_RAMPS, IRR, 0, 1, R1B_lbl); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); - global_dpd_->file2_init(&R1B, PSIF_CC_RAMPS, IRR, 2, 3, R1B_lbl); - } + /* open R files */ + if (params.ref == 0) { + global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + } else if (params.ref == 1) { + global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&R1B, PSIF_CC_RAMPS, IRR, 0, 1, R1B_lbl); + } else if (params.ref == 2) { + global_dpd_->file2_init(&R1A, PSIF_CC_RAMPS, IRR, 0, 1, R1A_lbl); + global_dpd_->file2_init(&R1B, PSIF_CC_RAMPS, IRR, 2, 3, R1B_lbl); + } - /* dot_L1R1 = Lme Rme */ - if (params.ref == 0) { - dot_L1R1 = 2.0 * global_dpd_->file2_dot(&L1A,&R1A); - } - else if (params.ref >= 1) { - dot_L1R1 = global_dpd_->file2_dot(&L1A,&R1A); - dot_L1R1 += global_dpd_->file2_dot(&L1B,&R1B); - } + /* dot_L1R1 = Lme Rme */ + if (params.ref == 0) { + dot_L1R1 = 2.0 * global_dpd_->file2_dot(&L1A, &R1A); + } else if (params.ref >= 1) { + dot_L1R1 = global_dpd_->file2_dot(&L1A, &R1A); + dot_L1R1 += global_dpd_->file2_dot(&L1B, &R1B); + } - /* dot_L2R2 = <0|Lmnef Rmnef|0> */ - if (params.ref == 0) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); - dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - } - else if (params.ref == 1) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); - dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2BB_lbl); - dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); - dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - } - else if (params.ref == 2) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); - dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 12, 17, 12, 17, 0, L2BB_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 12, 17, 12, 17, 0, R2BB_lbl); - dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 22, 28, 22, 28, 0, R2AB_lbl); - dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); - global_dpd_->buf4_close(&R2); - global_dpd_->buf4_close(&L2); - } + /* dot_L2R2 = <0|Lmnef Rmnef|0> */ + if (params.ref == 0) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); + dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 1) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); + dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2BB_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2BB_lbl); + dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 0, 5, 0, 5, 0, R2AB_lbl); + dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 2, 7, 2, 7, 0, L2AA_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 2, 7, 2, 7, 0, R2AA_lbl); + dot_L2R2 = global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 12, 17, 12, 17, 0, L2BB_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 12, 17, 12, 17, 0, R2BB_lbl); + dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->buf4_init(&R2, PSIF_CC_RAMPS, IRR, 22, 28, 22, 28, 0, R2AB_lbl); + dot_L2R2 += global_dpd_->buf4_dot(&L2, &R2); + global_dpd_->buf4_close(&R2); + global_dpd_->buf4_close(&L2); + } - /* dot_L2T1R1 = RNF (TME LMNEF) + Rnf (Tme Lmnef) */ - /* + RNF (Tme LNmFe) + Rnf (TME LMnEf) */ - if (params.ref == 0) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 = 2.0 * global_dpd_->file2_dot(&R1A, &I1); - global_dpd_->file2_close(&I1); - } - else if (params.ref == 1) { - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 = global_dpd_->file2_dot(&R1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2BB_lbl); - global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); - global_dpd_->dot24(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); - global_dpd_->file2_close(&I1); - } - else if (params.ref == 2) { - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 = global_dpd_->file2_dot(&R1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X2(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 10, 15, 12, 17, 0, L2BB_lbl); - global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); - global_dpd_->dot24(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1A, &I1); - global_dpd_->file2_close(&I1); - global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X2(n,f)"); - global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); - global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); - global_dpd_->buf4_close(&L2); - dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); - global_dpd_->file2_close(&I1); - } + /* dot_L2T1R1 = RNF (TME LMNEF) + Rnf (Tme Lmnef) */ + /* + RNF (Tme LNmFe) + Rnf (TME LMnEf) */ + if (params.ref == 0) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl2); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 = 2.0 * global_dpd_->file2_dot(&R1A, &I1); + global_dpd_->file2_close(&I1); + } else if (params.ref == 1) { + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 = global_dpd_->file2_dot(&R1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2BB_lbl); + global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); + global_dpd_->dot24(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 0, 5, 0, L2AB_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); + global_dpd_->file2_close(&I1); + } else if (params.ref == 2) { + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 0, 5, 2, 7, 0, L2AA_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 = global_dpd_->file2_dot(&R1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X2(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 10, 15, 12, 17, 0, L2BB_lbl); + global_dpd_->dot13(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 0, 1, "X2(N,F)"); + global_dpd_->dot24(&T1B, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1A, &I1); + global_dpd_->file2_close(&I1); + global_dpd_->file2_init(&I1, PSIF_CC_TMP, IRR, 2, 3, "X2(n,f)"); + global_dpd_->buf4_init(&L2, PSIF_CC_LAMPS, IRR, 22, 28, 22, 28, 0, L2AB_lbl); + global_dpd_->dot13(&T1A, &L2, &I1, 0, 0, 1.0, 0.0); + global_dpd_->buf4_close(&L2); + dot_L2T1R1 += global_dpd_->file2_dot(&R1B, &I1); + global_dpd_->file2_close(&I1); + } - /* close L1, R1 */ - if (params.ref == 0) { - global_dpd_->file2_close(&R1A); global_dpd_->file2_close(&L1A); - } - else if (params.ref >= 1) { - global_dpd_->file2_close(&R1A); global_dpd_->file2_close(&R1B); - global_dpd_->file2_close(&L1A); global_dpd_->file2_close(&L1B); - } + /* close L1, R1 */ + if (params.ref == 0) { + global_dpd_->file2_close(&R1A); + global_dpd_->file2_close(&L1A); + } else if (params.ref >= 1) { + global_dpd_->file2_close(&R1A); + global_dpd_->file2_close(&R1B); + global_dpd_->file2_close(&L1A); + global_dpd_->file2_close(&L1B); + } - projection_0 = R0 * (-dot_L1T1 - dot_L2T2 + 0.5*dot_L2T1T1); - projection_S = R0 * (+dot_L1T1 - dot_L2T1T1) + dot_L1R1 - dot_L2T1R1; - projection_D = R0 * (+dot_L2T2 + 0.5*dot_L2T1T1) + dot_L2T1R1 + dot_L2R2; - projection_tot = projection_0 + projection_S + projection_D; - ael = projection_S + 2.0 * projection_D; + projection_0 = R0 * (-dot_L1T1 - dot_L2T2 + 0.5 * dot_L2T1T1); + projection_S = R0 * (+dot_L1T1 - dot_L2T1T1) + dot_L1R1 - dot_L2T1R1; + projection_D = R0 * (+dot_L2T2 + 0.5 * dot_L2T1T1) + dot_L2T1R1 + dot_L2R2; + projection_tot = projection_0 + projection_S + projection_D; + ael = projection_S + 2.0 * projection_D; - outfile->Printf("\n\tProjections for excited state, irrep %s, root %d:\n", moinfo.labels[0].c_str(), root); - outfile->Printf("\t<0|Le^(-T)|0><0|Re^T|0> = %15.10lf\n", projection_0); - outfile->Printf("\t<0|Le^(-T)|S> = %15.10lf\n", projection_S); - outfile->Printf("\t<0|Le^(-T)|D> = %15.10lf\n", projection_D); - outfile->Printf("\tSum of above = %15.10lf\n", projection_tot); - outfile->Printf("\tApprox. excitation level = %15.10lf\n", ael); - } /* sum over states */ + outfile->Printf("\n\tProjections for excited state, irrep %s, root %d:\n", moinfo.labels[0].c_str(), root); + outfile->Printf("\t<0|Le^(-T)|0><0|Re^T|0> = %15.10lf\n", projection_0); + outfile->Printf("\t<0|Le^(-T)|S> = %15.10lf\n", projection_S); + outfile->Printf("\t<0|Le^(-T)|D> = %15.10lf\n", projection_D); + outfile->Printf("\tSum of above = %15.10lf\n", projection_tot); + outfile->Printf("\tApprox. excitation level = %15.10lf\n", ael); + } /* sum over states */ - /* close T1 */ - global_dpd_->file2_close(&T1A); - if (params.ref >= 1) - global_dpd_->file2_close(&T1B); + /* close T1 */ + global_dpd_->file2_close(&T1A); + if (params.ref >= 1) global_dpd_->file2_close(&T1B); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/pseudoenergy.cc b/psi4/src/psi4/cclambda/pseudoenergy.cc index 9f8a8b771b3..6e3b44aff43 100644 --- a/psi4/src/psi4/cclambda/pseudoenergy.cc +++ b/psi4/src/psi4/cclambda/pseudoenergy.cc @@ -38,150 +38,147 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -double pseudoenergy(struct L_Params L_params) -{ - double LIJAB_energy, Lijab_energy, LIjAb_energy; - double LIA_energy=0.0, Lia_energy=0.0, tval; - dpdbuf4 LIJAB, Lijab, LIjAb, D; - dpdfile2 Lia, LIA, Fme, FME; - int L_irr; - L_irr = L_params.irrep; - - if ( L_params.ground || ((L_params.irrep ==0)&&(std::fabs(L_params.R0)>1e-10)) ) { - if(params.ref == 0) { /** RHF **/ - - Lia_energy = 0.0; - global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - LIA_energy = global_dpd_->file2_dot(&FME,&LIA); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&FME); - - LIJAB_energy = 0.0; - Lijab_energy = 0.0; - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D 2 - "); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&D); +namespace psi { +namespace cclambda { + +double pseudoenergy(struct L_Params L_params) { + double LIJAB_energy, Lijab_energy, LIjAb_energy; + double LIA_energy = 0.0, Lia_energy = 0.0, tval; + dpdbuf4 LIJAB, Lijab, LIjAb, D; + dpdfile2 Lia, LIA, Fme, FME; + int L_irr; + L_irr = L_params.irrep; + + if (L_params.ground || ((L_params.irrep == 0) && (std::fabs(L_params.R0) > 1e-10))) { + if (params.ref == 0) { /** RHF **/ + + Lia_energy = 0.0; + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + LIA_energy = global_dpd_->file2_dot(&FME, &LIA); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&FME); + + LIJAB_energy = 0.0; + Lijab_energy = 0.0; + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D 2 - "); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&D); + } else if (params.ref == 1) { /** ROHF **/ + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + + LIA_energy = global_dpd_->file2_dot(&FME, &LIA); + Lia_energy = global_dpd_->file2_dot(&Fme, &Lia); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + LIJAB_energy = global_dpd_->buf4_dot(&D, &LIJAB); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + Lijab_energy = global_dpd_->buf4_dot(&D, &Lijab); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&D); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&D); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 2, 3, "Fme"); + global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + + LIA_energy = global_dpd_->file2_dot(&FME, &LIA); + Lia_energy = global_dpd_->file2_dot(&Fme, &Lia); + + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + global_dpd_->file2_close(&Fme); + global_dpd_->file2_close(&FME); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + LIJAB_energy = global_dpd_->buf4_dot(&D, &LIJAB); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_close(&D); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + Lijab_energy = global_dpd_->buf4_dot(&D, &Lijab); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_close(&D); + + global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); + global_dpd_->buf4_close(&LIjAb); + global_dpd_->buf4_close(&D); + } + /* + outfile->Printf( "One A Energy = %20.14f\n", LIA_energy); + outfile->Printf( "One B Energy = %20.14f\n", Lia_energy); + outfile->Printf( "Two AA Energy = %20.14f\n", LIJAB_energy); + outfile->Printf( "Two BB Energy = %20.14f\n", Lijab_energy); + outfile->Printf( "Two AB Energy = %20.14f\n", LIjAb_energy); + */ + return (LIJAB_energy + Lijab_energy + LIjAb_energy); + } else { /* since pseudoenergy is 0 lets compute norm instead */ + if (params.ref <= 1) { /* RHF or ROHF */ + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + LIA_energy = global_dpd_->file2_dot_self(&LIA); + Lia_energy = global_dpd_->file2_dot_self(&Lia); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + LIJAB_energy = global_dpd_->buf4_dot_self(&LIJAB); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); + Lijab_energy = global_dpd_->buf4_dot_self(&Lijab); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + LIjAb_energy = global_dpd_->buf4_dot_self(&LIjAb); + global_dpd_->buf4_close(&LIjAb); + tval = LIA_energy + Lia_energy + LIJAB_energy + Lijab_energy + LIjAb_energy; + tval = sqrt(tval); + return tval; + } else if (params.ref == 2) { /* UHF */ + global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); + global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); + LIA_energy = global_dpd_->file2_dot_self(&LIA); + Lia_energy = global_dpd_->file2_dot_self(&Lia); + global_dpd_->file2_close(&Lia); + global_dpd_->file2_close(&LIA); + global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); + LIJAB_energy = global_dpd_->buf4_dot_self(&LIJAB); + global_dpd_->buf4_close(&LIJAB); + global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); + Lijab_energy = global_dpd_->buf4_dot_self(&Lijab); + global_dpd_->buf4_close(&Lijab); + global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + LIjAb_energy = global_dpd_->buf4_dot_self(&LIjAb); + global_dpd_->buf4_close(&LIjAb); + tval = LIA_energy + Lia_energy + LIJAB_energy + Lijab_energy + LIjAb_energy; + tval = sqrt(tval); + return tval; + } } - else if(params.ref == 1) { /** ROHF **/ - global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 0, 1, "Fme"); - global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - LIA_energy = global_dpd_->file2_dot(&FME,&LIA); - Lia_energy = global_dpd_->file2_dot(&Fme,&Lia); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (i>j,a>b)"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - LIJAB_energy = global_dpd_->buf4_dot(&D, &LIJAB); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - Lijab_energy = global_dpd_->buf4_dot(&D, &Lijab); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 0, 5, 0, 5, 0, "D "); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&D); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->file2_init(&Fme, PSIF_CC_OEI, 0, 2, 3, "Fme"); - global_dpd_->file2_init(&FME, PSIF_CC_OEI, 0, 0, 1, "FME"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - - LIA_energy = global_dpd_->file2_dot(&FME,&LIA); - Lia_energy = global_dpd_->file2_dot(&Fme,&Lia); - - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - global_dpd_->file2_close(&Fme); - global_dpd_->file2_close(&FME); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 2, 7, 2, 7, 0, "D (I>J,A>B)"); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - LIJAB_energy = global_dpd_->buf4_dot(&D, &LIJAB); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 12, 17, 12, 17, 0, "D (i>j,a>b)"); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - Lijab_energy = global_dpd_->buf4_dot(&D, &Lijab); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_close(&D); - - global_dpd_->buf4_init(&D, PSIF_CC_DINTS, 0, 22, 28, 22, 28, 0, "D "); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - LIjAb_energy = global_dpd_->buf4_dot(&D, &LIjAb); - global_dpd_->buf4_close(&LIjAb); - global_dpd_->buf4_close(&D); - } - /* - outfile->Printf( "One A Energy = %20.14f\n", LIA_energy); - outfile->Printf( "One B Energy = %20.14f\n", Lia_energy); - outfile->Printf( "Two AA Energy = %20.14f\n", LIJAB_energy); - outfile->Printf( "Two BB Energy = %20.14f\n", Lijab_energy); - outfile->Printf( "Two AB Energy = %20.14f\n", LIjAb_energy); - */ - return (LIJAB_energy + Lijab_energy + LIjAb_energy); - } - else { /* since pseudoenergy is 0 lets compute norm instead */ - if (params.ref <= 1) { /* RHF or ROHF */ - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 0, 1, "Lia"); - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - LIA_energy = global_dpd_->file2_dot_self(&LIA); - Lia_energy = global_dpd_->file2_dot_self(&Lia); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - LIJAB_energy = global_dpd_->buf4_dot_self(&LIJAB); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "Lijab"); - Lijab_energy = global_dpd_->buf4_dot_self(&Lijab); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - LIjAb_energy = global_dpd_->buf4_dot_self(&LIjAb); - global_dpd_->buf4_close(&LIjAb); - tval = LIA_energy + Lia_energy + LIJAB_energy + Lijab_energy + LIjAb_energy; - tval = sqrt(tval); - return tval; - } - else if (params.ref == 2) { /* UHF */ - global_dpd_->file2_init(&LIA, PSIF_CC_LAMBDA, L_irr, 0, 1, "LIA"); - global_dpd_->file2_init(&Lia, PSIF_CC_LAMBDA, L_irr, 2, 3, "Lia"); - LIA_energy = global_dpd_->file2_dot_self(&LIA); - Lia_energy = global_dpd_->file2_dot_self(&Lia); - global_dpd_->file2_close(&Lia); - global_dpd_->file2_close(&LIA); - global_dpd_->buf4_init(&LIJAB, PSIF_CC_LAMBDA, L_irr, 2, 7, 2, 7, 0, "LIJAB"); - LIJAB_energy = global_dpd_->buf4_dot_self(&LIJAB); - global_dpd_->buf4_close(&LIJAB); - global_dpd_->buf4_init(&Lijab, PSIF_CC_LAMBDA, L_irr, 12, 17, 12, 17, 0, "Lijab"); - Lijab_energy = global_dpd_->buf4_dot_self(&Lijab); - global_dpd_->buf4_close(&Lijab); - global_dpd_->buf4_init(&LIjAb, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - LIjAb_energy = global_dpd_->buf4_dot_self(&LIjAb); - global_dpd_->buf4_close(&LIjAb); - tval = LIA_energy + Lia_energy + LIJAB_energy + Lijab_energy + LIjAb_energy; - tval = sqrt(tval); - return tval; - } - } - return 0.0; + return 0.0; } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/sort_amps.cc b/psi4/src/psi4/cclambda/sort_amps.cc index 5d9d3bc0956..c1f02b114c3 100644 --- a/psi4/src/psi4/cclambda/sort_amps.cc +++ b/psi4/src/psi4/cclambda/sort_amps.cc @@ -38,94 +38,92 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { - -void CCLambdaWavefunction::sort_amps(int L_irr) -{ - dpdbuf4 L2; - - if(params.ref == 0) { - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_scmcopy(&L2, PSIF_CC_LAMBDA, "2 LIjAb - LIjBa", 2); - global_dpd_->buf4_sort_axpy(&L2, PSIF_CC_LAMBDA, pqsr, 0, 5, "2 LIjAb - LIjBa", -1); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAjb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psqr, 10, 10, "LIbjA"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); - global_dpd_->buf4_scmcopy(&L2, PSIF_CC_LAMBDA, "2 LIAjb - LIbjA", 2); - global_dpd_->buf4_sort_axpy(&L2, PSIF_CC_LAMBDA, psrq, 10, 10, "2 LIAjb - LIbjA", -1); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 0, 5, "LiJaB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LiaJB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 10, 10, "LjAIb"); - global_dpd_->buf4_close(&L2); - } - - if(params.ref == 1) { /** ROHF **/ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAjb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psqr, 10, 10, "LIbjA"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 0, 5, "LiJaB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LiaJB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 10, 10, "LjAIb"); - global_dpd_->buf4_close(&L2); - - /* Build L2IAJB List */ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAJB"); - global_dpd_->buf4_close(&L2); - /* Build L2iajb List */ - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "Lijab"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "Liajb"); - global_dpd_->buf4_close(&L2); - } - else if(params.ref == 2) { /** UHF **/ - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 23, 29, "LiJaB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 20, 20, "LIAJB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 15, 12, 17, 0, "Lijab"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 30, 30, "Liajb"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 20, 30, "LIAjb"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 30, 20, "LiaJB"); - global_dpd_->buf4_close(&L2); - - global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psrq, 24, 27, "LIbjA"); - global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 27, 24, "LjAIb"); - global_dpd_->buf4_close(&L2); - } - +namespace psi { +namespace cclambda { + +void CCLambdaWavefunction::sort_amps(int L_irr) { + dpdbuf4 L2; + + if (params.ref == 0) { + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_scmcopy(&L2, PSIF_CC_LAMBDA, "2 LIjAb - LIjBa", 2); + global_dpd_->buf4_sort_axpy(&L2, PSIF_CC_LAMBDA, pqsr, 0, 5, "2 LIjAb - LIjBa", -1); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAjb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psqr, 10, 10, "LIbjA"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); + global_dpd_->buf4_scmcopy(&L2, PSIF_CC_LAMBDA, "2 LIAjb - LIbjA", 2); + global_dpd_->buf4_sort_axpy(&L2, PSIF_CC_LAMBDA, psrq, 10, 10, "2 LIAjb - LIbjA", -1); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 0, 5, "LiJaB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LiaJB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 10, 10, "LjAIb"); + global_dpd_->buf4_close(&L2); + } + + if (params.ref == 1) { /** ROHF **/ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LIjAb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAjb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psqr, 10, 10, "LIbjA"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 0, 5, "LiJaB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 0, 5, 0, "LiJaB"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LiaJB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 10, 10, 10, 0, "LIAjb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 10, 10, "LjAIb"); + global_dpd_->buf4_close(&L2); + + /* Build L2IAJB List */ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "LIAJB"); + global_dpd_->buf4_close(&L2); + /* Build L2iajb List */ + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "Lijab"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 10, 10, "Liajb"); + global_dpd_->buf4_close(&L2); + } else if (params.ref == 2) { /** UHF **/ + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, qpsr, 23, 29, "LiJaB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 0, 5, 2, 7, 0, "LIJAB"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 20, 20, "LIAJB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 10, 15, 12, 17, 0, "Lijab"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 30, 30, "Liajb"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 22, 28, 22, 28, 0, "LIjAb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 20, 30, "LIAjb"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 23, 29, 23, 29, 0, "LiJaB"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, prqs, 30, 20, "LiaJB"); + global_dpd_->buf4_close(&L2); + + global_dpd_->buf4_init(&L2, PSIF_CC_LAMBDA, L_irr, 20, 30, 20, 30, 0, "LIAjb"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, psrq, 24, 27, "LIbjA"); + global_dpd_->buf4_sort(&L2, PSIF_CC_LAMBDA, rqps, 27, 24, "LjAIb"); + global_dpd_->buf4_close(&L2); + } } - -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/spinad_amps.cc b/psi4/src/psi4/cclambda/spinad_amps.cc index ece59f03945..27ade5e5b0a 100644 --- a/psi4/src/psi4/cclambda/spinad_amps.cc +++ b/psi4/src/psi4/cclambda/spinad_amps.cc @@ -38,7 +38,8 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { /* spinad_amps(): For RHF references, build the T2 AA and BB amplitudes from ** the existing T2 AB amplitudes and copy the existing T1 A amplitudes @@ -50,23 +51,22 @@ namespace psi { namespace cclambda { ** */ -void spinad_amps(void) -{ - dpdfile2 T1; - dpdbuf4 T2; +void spinad_amps(void) { + dpdfile2 T1; + dpdbuf4 T2; - if(params.ref == 0) { /** RHF **/ + if (params.ref == 0) { /** RHF **/ - global_dpd_->file2_init(&T1, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); - global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); - global_dpd_->file2_close(&T1); + global_dpd_->file2_init(&T1, PSIF_CC_LAMBDA, 0, 0, 1, "LIA"); + global_dpd_->file2_copy(&T1, PSIF_CC_LAMBDA, "Lia"); + global_dpd_->file2_close(&T1); - global_dpd_->buf4_init(&T2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "LIjAb"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); - global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); - global_dpd_->buf4_close(&T2); - - } + global_dpd_->buf4_init(&T2, PSIF_CC_LAMBDA, 0, 2, 7, 0, 5, 1, "LIjAb"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "LIJAB"); + global_dpd_->buf4_copy(&T2, PSIF_CC_LAMBDA, "Lijab"); + global_dpd_->buf4_close(&T2); + } } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/status.cc b/psi4/src/psi4/cclambda/status.cc index 9089892f60b..a129eb9f315 100644 --- a/psi4/src/psi4/cclambda/status.cc +++ b/psi4/src/psi4/cclambda/status.cc @@ -35,14 +35,13 @@ #include "psi4/libpsi4util/PsiOutStream.h" #include "psi4/cclambda/cclambda.h" -namespace psi { namespace cclambda { - -void CCLambdaWavefunction::status(const char *s, std::string out) -{ - std::shared_ptr printer=(out=="outfile"?outfile: - std::make_shared(out)); - printer->Printf( " %-15s...complete\n", s); +namespace psi { +namespace cclambda { +void CCLambdaWavefunction::status(const char *s, std::string out) { + std::shared_ptr printer = (out == "outfile" ? outfile : std::make_shared(out)); + printer->Printf(" %-15s...complete\n", s); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi diff --git a/psi4/src/psi4/cclambda/update.cc b/psi4/src/psi4/cclambda/update.cc index 122492cc29d..fcbfa88bbc0 100644 --- a/psi4/src/psi4/cclambda/update.cc +++ b/psi4/src/psi4/cclambda/update.cc @@ -28,7 +28,7 @@ /*! \file \ingroup CCLAMBDA - \brief Enter brief description of file here + \brief Enter brief description of file here */ #include #include "MOInfo.h" @@ -37,13 +37,12 @@ #define EXTERN #include "globals.h" -namespace psi { namespace cclambda { +namespace psi { +namespace cclambda { -void CCLambdaWavefunction::update(void) -{ - outfile->Printf("\t%4d %20.15f %4.3e\n",moinfo.iter,moinfo.lcc, - moinfo.conv); - +void CCLambdaWavefunction::update(void) { + outfile->Printf("\t%4d %20.15f %4.3e\n", moinfo.iter, moinfo.lcc, moinfo.conv); } -}} // namespace psi::cclambda +} // namespace cclambda +} // namespace psi