/*! \file
    \ingroup DPD
    \brief Enter brief description of file here 
*/
#include <cstdio>
#include <cstdlib>
#include <cstring>
#include <cmath>
#include <libciomr/libciomr.h>
#include <libqt/qt.h>
#include <libdpd/dpd.h>
#include <ccfiles.h>

extern "C" {

/*
  This function computes contributions to singles and doubles of
  matrix elements of triples:
    SIA   <-- <S|(Dints)           <T|(Wmbij,Wabei) CMNEF |0> |T> / (w-wt)
    SIjAb <-- <D|(FME,WAmEf,WMnIe) <T|(Wmbij,Wabei) CMNEF |0> |T> / (w-wt)
  These are used to make X3 quantity in T3_RHF:
    CIjAb, WAbEi, WMbIj, fIJ, fAB, omega
*/

void cc3_sigma_UHF_AAA(dpdbuf4 *CMNEF, dpdbuf4 *WABEI, dpdbuf4 *WMBIJ,
    int do_singles, dpdbuf4 *Dints_anti, dpdfile2 *SIA, int do_doubles, dpdfile2 *FME,
    dpdbuf4 *WMAFE, dpdbuf4 *WMNIE, dpdbuf4 *SIJAB, int *aoccpi, int *aocc_off,
    int *avirtpi, int *avir_off, double omega, FILE *outfile)
{
  int h, nirreps;
  int *occ_off, *occpi, *vir_off, *virtpi;
  int Gi, Gj, Gk, Gijk, Ga, Gb, Gc;
  int i, j, k, I, J, K;
  int a, b, c, A, B, C;
  int Gij, ij, Gab, ab, Gjk, jk;
  double ***W1, **Z;
  dpdfile2 fIJ, fAB;
  int nrows, ncols, nlinks;
  int Gd, d, cd, dc, Gid, id, DD;
  int Gm, m, Gmi, mi, im, mc, M;
  int GS, GH, GU, GC, GX3;

  GC = CMNEF->file.my_irrep;

  GU = WMBIJ->file.my_irrep;

  if (do_singles)
    GH = Dints_anti->file.my_irrep;
  else if (do_doubles)
    GH = WMAFE->file.my_irrep;

  GS = SIJAB->file.my_irrep;

  GX3 = GU^GC;

  nirreps = CMNEF->params->nirreps;
  occpi = aoccpi;
  occ_off = aocc_off;
  virtpi = avirtpi;
  vir_off = avir_off;

  dpd_file2_init(&fIJ, CC_OEI, 0, 0, 0, "fIJ");
  dpd_file2_init(&fAB, CC_OEI, 0, 1, 1, "fAB");

  if (do_singles) {
    dpd_file2_mat_init(SIA);
    dpd_file2_mat_rd(SIA);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(Dints_anti, h);
      dpd_buf4_mat_irrep_rd(Dints_anti, h);
    }
  }

  if (do_doubles) {
    dpd_file2_mat_init(FME);
    dpd_file2_mat_rd(FME);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(SIJAB, h);
      dpd_buf4_mat_irrep_rd(SIJAB, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(WMNIE, h);
      dpd_buf4_mat_irrep_rd(WMNIE, h);
    }
  }

  /* 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++) {
	  /* changed */
	  Gc = Gab ^ Gijk ^ GX3;
	  W1[Gab] = dpd_block_matrix(WABEI->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;

	      T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, CMNEF, WABEI, WMBIJ, &fIJ, &fAB, 
		     occpi, occ_off, virtpi, vir_off, omega);

          if (do_singles) {
	      /* t_KC <-- 1/4 t_IJKABC <IJ||AB> */

	      Gc = Gk ^ GS;  /* changed */
	      Gab = Gij ^ GH ;  /* changed */

	      ij = Dints_anti->params->rowidx[I][J];

	      nrows = Dints_anti->params->coltot[Gij^GH]; /* changed */
	      ncols = virtpi[Gc];

	      if(nrows && ncols)
		C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, Dints_anti->matrix[Gij][ij], 1,
			1.0, SIA->matrix[Gk][k], 1);
          }

          if (do_doubles) {
	      /* t_IJAB <-- t_IJKABC F_KC */
	      Gc = Gk ^ GH;    
	      Gab = Gij ^ GS; 

	      nrows = SIJAB->params->coltot[Gij^GS];
	      ncols = virtpi[Gc];
	      ij = SIJAB->params->rowidx[I][J];

	      if(nrows && ncols)
		C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][0], ncols, FME->matrix[Gk][k], 1,
			1.0, SIJAB->matrix[Gij][ij], 1);

	      /* t_JKDC <-- +1/2 t_IJKABC W_IDAB */
	      /* t_JKCD <-- -1/2 t_IJKABC W_IDAB */
	      jk = SIJAB->params->rowidx[J][K];
	      for(Gd=0; Gd < nirreps; Gd++) {
		Gid = Gi ^ Gd;  
		Gab = Gid ^ GH;
		Gc = Gab ^ Gijk ^ GX3; 

		id = WMAFE->row_offset[Gid][I];

		Z = block_matrix(virtpi[Gc],virtpi[Gd]);
		WMAFE->matrix[Gid] = dpd_block_matrix(virtpi[Gd], WMAFE->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(WMAFE, Gid, id, virtpi[Gd]);

		nrows = virtpi[Gc];
		ncols = virtpi[Gd];
		nlinks = WMAFE->params->coltot[Gid^GH];

		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 = SIJAB->params->colidx[C][DD];
		    dc = SIJAB->params->colidx[DD][C];
		    SIJAB->matrix[Gjk][jk][dc] += Z[c][d];
		    SIJAB->matrix[Gjk][jk][cd] += -Z[c][d];
		  }
		}
		dpd_free_block(WMAFE->matrix[Gid], virtpi[Gd], WMAFE->params->coltot[Gid^GH]);
		free_block(Z);
	      }


	      /* S_MIAB <-- +1/2 t_IJKABC W_JKMC */
	      /* S_IMAB <-- -1/2 t_IJKABC W_JKMC */
	      jk = WMNIE->params->rowidx[J][K];
	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmi = Gm ^ Gi;
		Gab = Gmi ^ GS;
		Gc = Gab ^ Gijk ^ GX3;   

		mc = WMNIE->col_offset[Gjk][Gm];

		nrows = WABEI->params->coltot[Gab];
		ncols = occpi[Gm];
		nlinks = virtpi[Gc];

		Z = 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 = SIJAB->params->rowidx[M][I];
		  im = SIJAB->params->rowidx[I][M];
		  for(ab=0; ab < nrows; ab++) {
		    SIJAB->matrix[Gmi][mi][ab] += Z[ab][m];
		    SIJAB->matrix[Gmi][im][ab] -= Z[ab][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }
            } /* end do_doubles */

	    } /* k */
	  } /* j */
	} /* i */

	for(Gab=0; Gab < nirreps; Gab++) {
	  /* This will need to change for non-totally-symmetric cases */
	  Gc = Gab ^ Gijk;
	  dpd_free_block(W1[Gab], WABEI->params->coltot[Gab], virtpi[Gc]);
	}

      } /* Gk */
    } /* Gj */
  } /* Gi */

  free(W1);

  dpd_file2_close(&fIJ);
  dpd_file2_close(&fAB);

  if (do_singles) {

    dpd_file2_mat_wrt(SIA);
    dpd_file2_mat_close(SIA);

    for(h=0; h < nirreps; h++)
      dpd_buf4_mat_irrep_close(Dints_anti, h);
  }

  if (do_doubles) {

    dpd_file2_mat_close(FME);

    for(h=0; h < nirreps; h++)
      dpd_buf4_mat_irrep_close(WMNIE, h);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(SIJAB, h);
      dpd_buf4_mat_irrep_close(SIJAB, h);
    }
  }
}

void cc3_sigma_UHF_BBB(dpdbuf4 *Cmnef, dpdbuf4 *Wabei, dpdbuf4 *Wmbij,
     int do_singles, dpdbuf4 *Dijab_anti, dpdfile2 *Sia, int do_doubles,
     dpdfile2 *Fme, dpdbuf4 *Wmafe, dpdbuf4 *Wmnie, dpdbuf4 *Sijab,
     int *boccpi, int *bocc_off, int *bvirtpi, int *bvir_off,
     double omega, FILE *outfile)
{
  int h, nirreps;
  int *occ_off, *occpi, *vir_off, *virtpi;
  int Gi, Gj, Gk, Gijk, Ga, Gb, Gc;
  int i, j, k, I, J, K;
  int a, b, c, A, B, C;
  int Gij, ij, Gab, ab, Gjk, jk;
  double ***W1, **Z;
  dpdfile2 fIJ, fAB;
  int nrows, ncols, nlinks;
  int Gd, d, cd, dc, Gid, id, DD;
  int Gm, m, Gmi, mi, im, mc, M;
  int GS, GH, GU, GC, GX3;
  
  GC = Cmnef->file.my_irrep;
  GU = Wmbij->file.my_irrep; 

  if (do_singles)
    GH = Dijab_anti->file.my_irrep;
  else if (do_doubles)
    GH = Wmafe->file.my_irrep;

  GS = Sijab->file.my_irrep;
  GX3 = GU^GC;

  nirreps = Cmnef->params->nirreps;
  occpi = boccpi;
  occ_off = bocc_off;
  virtpi = bvirtpi;
  vir_off = bvir_off;

  dpd_file2_init(&fIJ, CC_OEI, 0, 2, 2, "fij");
  dpd_file2_init(&fAB, CC_OEI, 0, 3, 3, "fab");

  if (do_singles) {

    dpd_file2_mat_init(Sia);
    dpd_file2_mat_rd(Sia);
  
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(Dijab_anti, h);
      dpd_buf4_mat_irrep_rd(Dijab_anti, h);
    }
  }

  if (do_doubles) {

    dpd_file2_mat_init(Fme);
    dpd_file2_mat_rd(Fme);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(Sijab, h);
      dpd_buf4_mat_irrep_rd(Sijab, h);
    }

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(Wmnie, h);
      dpd_buf4_mat_irrep_rd(Wmnie, h);
    }
  }

  /* 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 ^ GX3;
	  W1[Gab] = dpd_block_matrix(Wabei->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;

	      T3_AAA(W1, nirreps, I, Gi, J, Gj, K, Gk, Cmnef, Wabei, Wmbij, &fIJ, &fAB, 
		     occpi, occ_off, virtpi, vir_off, omega);

          if (do_singles) {

	      /* S_kc <-- 1/4 t_ijkabc <ij||ab> */
	      Gc = Gk ^ GS;   
	      Gab = Gij ^ GH;

	      ij = Dijab_anti->params->rowidx[I][J];

	      nrows = Dijab_anti->params->coltot[Gij^GH];
	      ncols = virtpi[Gc];

	      if(nrows && ncols)
		C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, Dijab_anti->matrix[Gij][ij], 1,
			1.0, Sia->matrix[Gk][k], 1);
          }

          if (do_doubles) {

	      /* S_ijab <-- t_ijkabc F_kc */
	      Gc = Gk ^ GH;   
	      Gab = Gij ^ GS;

	      nrows = Sijab->params->coltot[Gij^GS];
	      ncols = virtpi[Gc];
	      ij = Sijab->params->rowidx[I][J];

	      if(nrows && ncols)
		C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][0], ncols, Fme->matrix[Gk][k], 1,
			1.0, Sijab->matrix[Gij][ij], 1);

	      /* S_jkdc <-- 1/2 t_ijkabc W_idab */
	      /* S_jkcd <-- -1/2 t_ijkabc W_idab */
	      jk = Sijab->params->rowidx[J][K];
	      for(Gd=0; Gd < nirreps; Gd++) {

		Gid = Gi ^ Gd; 
		Gab = Gid ^ GH; 
		Gc = Gab ^ Gijk ^ GX3; 

		id = Wmafe->row_offset[Gid][I];

		Z = block_matrix(virtpi[Gc],virtpi[Gd]);
		Wmafe->matrix[Gid] = dpd_block_matrix(virtpi[Gd], Wmafe->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(Wmafe, Gid, id, virtpi[Gd]);

		nrows = virtpi[Gc];
		ncols = virtpi[Gd];
		nlinks = Wmafe->params->coltot[Gid^GH];

		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 = Sijab->params->colidx[C][DD];
		    dc = Sijab->params->colidx[DD][C];
		    Sijab->matrix[Gjk][jk][dc] += Z[c][d];
		    Sijab->matrix[Gjk][jk][cd] += -Z[c][d];
		  }
		}
		dpd_free_block(Wmafe->matrix[Gid], virtpi[Gd], Wmafe->params->coltot[Gid^GH]);
		free_block(Z);
	      }

	      /* S_miab <-- +1/2 t_ijkabc W_jkmc */
	      /* S_imab <-- -1/2 t_ijkabc W_jkmc */
	      jk = Wmnie->params->rowidx[J][K];
	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmi = Gm ^ Gi; 
		Gab = Gmi ^ GS; 
		Gc = Gab ^ Gijk ^ GX3;    

		mc = Wmnie->col_offset[Gjk][Gm];

		nrows = Wabei->params->coltot[Gab];
		ncols = occpi[Gm];
		nlinks = virtpi[Gc];

		Z = 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 = Sijab->params->rowidx[M][I];
		  im = Sijab->params->rowidx[I][M];
		  for(ab=0; ab < nrows; ab++) {
		    Sijab->matrix[Gmi][mi][ab] += Z[ab][m];
		    Sijab->matrix[Gmi][im][ab] -= Z[ab][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }
          } /* end do_doubles */

	    } /* k */
	  } /* j */
	} /* i */

	for(Gab=0; Gab < nirreps; Gab++) {
	  /* This will need to change for non-totally-symmetric cases */
	  Gc = Gab ^ Gijk;
	  dpd_free_block(W1[Gab], Wabei->params->coltot[Gab], virtpi[Gc]);
	}

      } /* Gk */
    } /* Gj */
  } /* Gi */

  free(W1);

  dpd_file2_close(&fIJ);
  dpd_file2_close(&fAB);

  if (do_singles) {

    dpd_file2_mat_wrt(Sia);
    dpd_file2_mat_close(Sia);

    for(h=0; h < nirreps; h++)
      dpd_buf4_mat_irrep_close(Dijab_anti, h);
  }

  if (do_doubles) {

    dpd_file2_mat_close(Fme);

    for(h=0; h < nirreps; h++)
      dpd_buf4_mat_irrep_close(Wmnie, h);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(Sijab, h);
      dpd_buf4_mat_irrep_close(Sijab, h);
    }
  }
}

void cc3_sigma_UHF_AAB(dpdbuf4 *C2AA, dpdbuf4 *C2AB, dpdbuf4 *C2BA,
    dpdbuf4 *FAA, dpdbuf4 *FAB, dpdbuf4 *FBA,
    dpdbuf4 *EAA, dpdbuf4 *EAB, dpdbuf4 *EBA, 
    int do_singles, dpdbuf4 *DAA, dpdbuf4 *DAB, dpdfile2 *SIA, dpdfile2 *Sia,
    int do_doubles, dpdfile2 *FME, dpdfile2 *Fme,
    dpdbuf4 *WMAFE, dpdbuf4 *WMaFe, dpdbuf4 *WmAfE,
    dpdbuf4 *WMNIE, dpdbuf4 *WMnIe, dpdbuf4 *WmNiE,
    dpdbuf4 *SIJAB, dpdbuf4 *SIjAb, int *aoccpi, int *aocc_off, int *boccpi,
    int *bocc_off, int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off,
    double omega, FILE *outfile)
{
  int h, nirreps;
  int Gi, Gj, Gk, Gijk;
  int Ga, Gb, Gc, Gab;
  int Gij, ij, ji, Gjk, jk, Gbc, bc, Gcb, cb;
  int Gd, Gkd, kd, d, DD, ad, da, dc, Gid, id, Gac, ac, bd;
  int i, j, k, I, J, K;
  int a, b, c, A, B, C;
  int ab;
  double ***W1, ***W2, ***W3;
  dpdfile2 fIJ, fAB, fij, fab;
  int nrows, ncols, nlinks;
  int **W_offset, offset;
  double **Z;
  int Gm, m, Gmi, mi, im, mc, M;
  int Gmk, mk, ma, kj, Gim;
  int GS, GH, GU, GC, GX3;

  GC = C2AA->file.my_irrep;
  GU = EAA->file.my_irrep;

  if (do_singles)
    GH = DAA->file.my_irrep;
  else if (do_doubles)
    GH = WMAFE->file.my_irrep;

  GS = SIJAB->file.my_irrep;
  GX3 = GU^GC;

  nirreps = C2AA->params->nirreps;

  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 += avirtpi[Ga] * avirtpi[Gb];
    }
  }

  if (do_singles) {
    dpd_file2_mat_init(SIA);
    dpd_file2_mat_rd(SIA);
    dpd_file2_mat_init(Sia);
    dpd_file2_mat_rd(Sia);
 
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(DAA, h);
      dpd_buf4_mat_irrep_rd(DAA, h);
      dpd_buf4_mat_irrep_init(DAB, h);
      dpd_buf4_mat_irrep_rd(DAB, h);
    }
  }

  if (do_doubles) {
    dpd_file2_mat_init(FME);
    dpd_file2_mat_rd(FME);
    dpd_file2_mat_init(Fme);
    dpd_file2_mat_rd(Fme);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(WMnIe, h);
      dpd_buf4_mat_irrep_rd(WMnIe, h);

      dpd_buf4_mat_irrep_init(WMNIE, h);
      dpd_buf4_mat_irrep_rd(WMNIE, h);

      dpd_buf4_mat_irrep_init(WmNiE, h);
      dpd_buf4_mat_irrep_rd(WmNiE, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(SIJAB, h);
      dpd_buf4_mat_irrep_rd(SIJAB, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(SIjAb, h);
      dpd_buf4_mat_irrep_rd(SIjAb, h);
    }
  }

  dpd_file2_init(&fIJ, CC_OEI, 0, 0, 0, "fIJ");
  dpd_file2_init(&fAB, CC_OEI, 0, 1, 1, "fAB");
  dpd_file2_init(&fij, CC_OEI, 0, 2, 2, "fij");
  dpd_file2_init(&fab, CC_OEI, 0, 3, 3, "fab");

  /* target T3 amplitudes go in here */
  W1 = (double ***) malloc(nirreps * sizeof(double **));
  W2 = (double ***) malloc(nirreps * sizeof(double **));
  W3 = (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 ^ GX3;
	  W1[Gab] = dpd_block_matrix(FAA->params->coltot[Gab], bvirtpi[Gc]);
	}
	for(Ga=0; Ga < nirreps; Ga++) {
	  Gcb = Ga ^ Gijk ^ GX3;
	  W2[Ga] = dpd_block_matrix(avirtpi[Ga], WmAfE->params->coltot[Gcb]);  /* alpha-beta-alpha */
	}
	for(Gb=0; Gb < nirreps; Gb++) {
	  Gac = Gb ^ Gijk ^ GX3;
	  W3[Gb] = dpd_block_matrix(avirtpi[Gb], WMaFe->params->coltot[Gac]);  /* alpha-alpha-beta */
	}

	for(i=0; i < aoccpi[Gi]; i++) {
	  I = aocc_off[Gi] + i;
	  for(j=0; j < aoccpi[Gj]; j++) {
	    J = aocc_off[Gj] + j;
	    for(k=0; k < boccpi[Gk]; k++) {
	      K = bocc_off[Gk] + k;

	      T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, C2AA, C2AB, C2BA, 
		     FAA, FAB, FBA, EAA, EAB, EBA, &fIJ, &fij, &fAB, &fab,
		     aoccpi, aocc_off, boccpi, bocc_off, avirtpi, avir_off, bvirtpi, bvir_off, omega);

          if (do_singles) {

	      /* S_kc <-- 1/4 t_IJkABc <IJ||AB> */

	      Gc = Gk ^ GS;  
	      Gab = Gij ^ GH;

	      ij = DAA->params->rowidx[I][J];

	      nrows = DAA->params->coltot[Gij^GH];
	      ncols = bvirtpi[Gc];

	      if(nrows && ncols)
		C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, DAA->matrix[Gij][ij], 1,
			1.0, Sia->matrix[Gk][k], 1);

	      /* S_IA <-- t_IJkABc <Jk|Bc> */

	      Ga = Gi ^ GS;   
	      Gbc = Gjk ^ GH;

	      jk = DAB->params->rowidx[J][K];

	      for(Gab=0; Gab < nirreps; Gab++) {
		Gb = Ga ^ Gab;
		Gc = Gb ^ Gbc;

		ab = W_offset[Gab][Ga];
		bc = DAB->col_offset[Gjk][Gb];

		nrows = avirtpi[Ga];
		ncols = avirtpi[Gb] * bvirtpi[Gc];

		if(nrows && ncols)
		  C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][ab], ncols, &(DAB->matrix[Gjk][jk][bc]), 1,
			  1.0, SIA->matrix[Gi][i], 1);
	      }
          }

          if (do_doubles) {
	      /* S_IJAB <-- t_IJkABc F_kc */
	      Gc = Gk ^ GH;   
	      Gab = Gij ^ GS;

	      nrows = SIJAB->params->coltot[Gij^GS];
	      ncols = bvirtpi[Gc];
	      ij = SIJAB->params->rowidx[I][J];
 
	      if(nrows && ncols)
		C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][0], ncols, Fme->matrix[Gk][k], 1,
			1.0, SIJAB->matrix[Gij][ij], 1);

	      /* S_JkBc <-- t_IJkABc F_IA */
	      Ga = Gi ^ GH;   
	      Gbc = Gjk ^ GS;

	      jk = C2AB->params->rowidx[J][K];

	      for(Gab=0; Gab < nirreps; Gab++) {
		Gb = Ga ^ Gab;
		Gc = Gb ^ Gbc;

		ab = W_offset[Gab][Ga];
		bc = SIjAb->col_offset[Gjk][Gb];

		nrows = avirtpi[Ga];
		ncols = avirtpi[Gb] * bvirtpi[Gc];

		if(nrows && ncols)
		  C_DGEMV('t', nrows, ncols, 1.0, W1[Gab][ab], ncols, FME->matrix[Gi][i], 1,
			  1.0, &(SIjAb->matrix[Gjk][jk][bc]), 1);
	      }

	      /* S_JIDA <-- t_IJkABc W_kDcB */
	      /* sort W1(AB,c) to W2(A,cB) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3;
		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 - avir_off[Ga];
		  for(c=0; c < bvirtpi[Gc]; c++) {
		    C = bvir_off[Gc] + c;
		    cb = WmAfE->params->colidx[C][B];
		    W2[Ga][a][cb] = W1[Gab][ab][c];
		  }
		}
	      }

	      ji = SIJAB->params->rowidx[J][I];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gkd = Gk ^ Gd; 
		Gcb = Gkd ^ GH; 
		Ga = Gd ^ Gij ^ GS;      

		kd = WmAfE->row_offset[Gkd][K];
		WmAfE->matrix[Gkd] = dpd_block_matrix(avirtpi[Gd], WmAfE->params->coltot[Gkd^GH]);
		dpd_buf4_mat_irrep_rd_block(WmAfE, Gkd, kd, avirtpi[Gd]);
		Z = block_matrix(avirtpi[Ga], avirtpi[Gd]);

		nrows = avirtpi[Ga];
		ncols = avirtpi[Gd];
		nlinks = WmAfE->params->coltot[Gkd^GH];

		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 < avirtpi[Ga]; a++) {
		  A = avir_off[Ga] + a;
		  for(d=0; d < avirtpi[Gd]; d++) {
		    DD = avir_off[Gd] + d;
		    ad = SIJAB->params->colidx[A][DD];
		    da = SIJAB->params->colidx[DD][A];
		    SIJAB->matrix[Gij][ji][ad] += -Z[a][d];
		    SIJAB->matrix[Gij][ji][da] += Z[a][d];
		  }
		}

		dpd_free_block(WmAfE->matrix[Gkd], avirtpi[Gd], WmAfE->params->coltot[Gkd^GH]);
		free_block(Z);
	      }

	      /* S_JkDc <-- 1/2 t_IJkABc W_IDAB */

	      jk = SIjAb->params->rowidx[J][K];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gid = Gi ^ Gd; 
		Gab = Gid ^ GH; 
		Gc = Gab ^ Gijk ^ GX3;    

		id = WMAFE->row_offset[Gid][I];
		WMAFE->matrix[Gid] = dpd_block_matrix(avirtpi[Gd], WMAFE->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(WMAFE, Gid, id, avirtpi[Gd]);
		Z = block_matrix(bvirtpi[Gc], avirtpi[Gd]);

		nrows = bvirtpi[Gc];
		ncols = avirtpi[Gd];
		nlinks = WMAFE->params->coltot[Gid^GH];

		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 < bvirtpi[Gc]; c++) {
		  C = bvir_off[Gc] + c;
		  for(d=0; d < avirtpi[Gd]; d++) {
		    DD = avir_off[Gd] + d;
		    dc = SIjAb->params->colidx[DD][C];
		    SIjAb->matrix[Gjk][jk][dc] += Z[c][d];
		  }
		}

		free_block(Z);
		dpd_free_block(WMAFE->matrix[Gid], avirtpi[Gd], WMAFE->params->coltot[Gid^GH]);
	      }

	      /* t_JkBd <-- t_IJkABc W_IdAc */
	      /* sort W1(AB,c) to W3(B,Ac) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3;
		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 - avir_off[Gb];
		  for(c=0; c < bvirtpi[Gc]; c++) {
		    C = bvir_off[Gc] + c;
		    ac = WMaFe->params->colidx[A][C];
		    W3[Gb][b][ac] = W1[Gab][ab][c];
		  }
		}
	      }

	      jk = SIjAb->params->rowidx[J][K];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gid = Gi ^ Gd; 
		Gac = Gid ^ GH; 
		Gb = Gac ^ Gijk ^ GX3;    

		id = WMaFe->row_offset[Gid][I]; 
		WMaFe->matrix[Gid] = dpd_block_matrix(bvirtpi[Gd], WMaFe->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(WMaFe, Gid, id, bvirtpi[Gd]);
		Z = block_matrix(avirtpi[Gb], bvirtpi[Gd]);

		nrows = avirtpi[Gb];
		ncols = bvirtpi[Gd];
		nlinks = WMaFe->params->coltot[Gid^GH];

		if(nrows && ncols && nlinks)
		  C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W3[Gb][0], nlinks,
			  WMaFe->matrix[Gid][0], nlinks, 0.0, Z[0], ncols);

		for(b=0; b < avirtpi[Gb]; b++) {
		  B = avir_off[Gb] + b;
		  for(d=0; d < bvirtpi[Gd]; d++) {
		    DD = bvir_off[Gd] + d;
		    bd = SIjAb->params->colidx[B][DD];
		    SIjAb->matrix[Gjk][jk][bd] += Z[b][d];
		  }
		}

		dpd_free_block(WMaFe->matrix[Gid], bvirtpi[Gd], WMaFe->params->coltot[Gid^GH]);
		free_block(Z);
	      }

	      /* S_MIAB <--- +t_IJkABc W_JkMc */
	      /* S_IMAB <--- -t_IJkABc W_JkMc */

	      jk = WMnIe->params->rowidx[J][K];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmi = Gm ^ Gi;  
		Gab = Gmi ^ GS;  
		Gc = Gab ^ Gijk ^ GX3;     

		mc = WMnIe->col_offset[Gjk][Gm];

		nrows = FAA->params->coltot[Gab];
		ncols = aoccpi[Gm];
		nlinks = bvirtpi[Gc];

		Z = 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 = aocc_off[Gm] + m;
		  mi = SIJAB->params->rowidx[M][I];
		  im = SIJAB->params->rowidx[I][M];
		  for(ab=0; ab < nrows; ab++) {
		    SIJAB->matrix[Gmi][mi][ab] += Z[ab][m];
		    SIJAB->matrix[Gmi][im][ab] -= Z[ab][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }

	      /* 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 ^ GX3;  
		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 - avir_off[Ga];
		  for(c=0; c < bvirtpi[Gc]; c++) {
		    C = bvir_off[Gc] + c;
		    bc = SIjAb->params->colidx[B][C];
		    W3[Ga][a][bc] = W1[Gab][ab][c];
		  }
		}
	      }

	      ij = WMNIE->params->rowidx[I][J];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmk = Gm ^ Gk; 
		Gbc = Gmk ^ GS; 
		Ga = Gbc ^ Gijk ^ GX3;    

		ma = WMNIE->col_offset[Gij][Gm];

		nrows = SIjAb->params->coltot[Gmk^GS];
		ncols = aoccpi[Gm];
		nlinks = avirtpi[Ga];

		Z = dpd_block_matrix(nrows, ncols);

		if(nrows && ncols && nlinks)
		  C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W3[Ga][0], nrows,
			  &(WMNIE->matrix[Gij][ij][ma]), nlinks, 0.0, Z[0], ncols);

		for(m=0; m < aoccpi[Gm]; m++) {
		  M = aocc_off[Gm] + m;
		  mk = SIjAb->params->rowidx[M][K];
		  for(bc=0; bc < nrows; bc++) {
		    SIjAb->matrix[Gmk][mk][bc] += Z[bc][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }

	      /* S_ImBc <-- t_IJkABc W_kJmA */
	      /* sort W(AB,c) to W(A,Bc) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3;  /* 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 - avir_off[Ga];
		  for(c=0; c < bvirtpi[Gc]; c++) {
		    C = bvir_off[Gc] + c;
		    bc = SIjAb->params->colidx[B][C];
		    W3[Ga][a][bc] = W1[Gab][ab][c];
		  }
		}
	      }

	      kj = WmNiE->params->rowidx[K][J];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gim = Gi ^ Gm; 
		Gbc = Gim ^ GS; 
		Ga = Gbc ^ Gijk ^ GX3;    

		ma = WmNiE->col_offset[Gjk][Gm];

		nrows = SIjAb->params->coltot[Gim^GS];
		ncols = boccpi[Gm];
		nlinks = avirtpi[Ga];

		Z = dpd_block_matrix(nrows, ncols);

		if(nrows && ncols && nlinks)
		  C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, W3[Ga][0], nrows,
			  &(WmNiE->matrix[Gjk][kj][ma]), nlinks, 0.0, Z[0], ncols);

		for(m=0; m < boccpi[Gm]; m++) {
		  M = bocc_off[Gm] + m;
		  im = SIjAb->params->rowidx[I][M];
		  for(bc=0; bc < nrows; bc++) {
		    SIjAb->matrix[Gim][im][bc] += Z[bc][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }
          }

	    } /* k */
	  } /* j */
	} /* i */

	for(Gab=0; Gab < nirreps; Gab++) {
	  /* This will need to change for non-totally-symmetric cases */
	  Gc = Gab ^ Gijk ^ GX3;
	  dpd_free_block(W1[Gab], FAA->params->coltot[Gab], bvirtpi[Gc]);
	}
	for(Ga=0; Ga < nirreps; Ga++) {
	  Gcb = Ga ^ Gijk ^ GX3; /* assumes totally symmetric */
	  dpd_free_block(W2[Ga], avirtpi[Ga], WmAfE->params->coltot[Gcb]);
	}
	for(Gb=0; Gb < nirreps; Gb++) {
	  Gac = Gb ^ Gijk ^ GX3; /* assumes totally symmetric */
	  dpd_free_block(W3[Gb], avirtpi[Gb], WMaFe->params->coltot[Gac]);
	}

      } /* Gk */
    } /* Gj */
  } /* Gi */

  free(W1);
  free(W2);
  free(W3);
  free_int_matrix(W_offset);

  dpd_file2_close(&fIJ);
  dpd_file2_close(&fAB);
  dpd_file2_close(&fij);
  dpd_file2_close(&fab);

  if (do_singles) {

    dpd_file2_mat_wrt(SIA);
    dpd_file2_mat_close(SIA);
    dpd_file2_mat_wrt(Sia);
    dpd_file2_mat_close(Sia);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_close(DAA, h);
      dpd_buf4_mat_irrep_close(DAB, h);
    }
  }

  if (do_doubles) {

    dpd_file2_mat_close(FME);
    dpd_file2_mat_close(Fme);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_close(WMNIE, h);
      dpd_buf4_mat_irrep_close(WMnIe, h);
      dpd_buf4_mat_irrep_close(WmNiE, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(SIJAB, h);
      dpd_buf4_mat_irrep_close(SIJAB, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(SIjAb, h);
      dpd_buf4_mat_irrep_close(SIjAb, h);
    }
  }
}

void cc3_sigma_UHF_BBA(dpdbuf4 *C2BB, dpdbuf4 *C2AB, dpdbuf4 *C2BA,
    dpdbuf4 *FBB, dpdbuf4 *FAB, dpdbuf4 *FBA,  
    dpdbuf4 *EBB, dpdbuf4 *EAB, dpdbuf4 *EBA,
    int do_singles, dpdbuf4 *DBB, dpdbuf4 *DBA, dpdfile2 *SIA, dpdfile2 *Sia,
    int do_doubles, dpdfile2 *FME, dpdfile2 *Fme,
    dpdbuf4 *Wmafe, dpdbuf4 *WMaFe, dpdbuf4 *WmAfE,
    dpdbuf4 *Wmnie, dpdbuf4 *WMnIe, dpdbuf4 *WmNiE,
    dpdbuf4 *Sijab, dpdbuf4 *SIjAb, int *aoccpi, int *aocc_off, int *boccpi,
    int *bocc_off, int *avirtpi, int *avir_off, int *bvirtpi, int *bvir_off,
    double omega, FILE *outfile)
{
  int h, nirreps, S_irr;
  int Gi, Gj, Gk, Gijk;
  int Ga, Gb, Gc, Gab;
  int Gij, ij, ji, Gjk, jk, Gbc, bc, Gcb, cb;
  int Gd, Gkd, kd, d, DD, ad, da, dc, Gid, id, Gac, ac, bd;
  int i, j, k, I, J, K;
  int a, b, c, A, B, C;
  int ab;
  double ***W1, ***W2, ***W3;
  dpdfile2 fIJ, fAB, fij, fab;
  int nrows, ncols, nlinks;
  int **W_offset, offset;
  dpdbuf4 SiJaB;
  double **Z;
  int Gm, m, Gmi, mi, im, mc, M;
  int Gmk, mk, ma, kj, Gim;
  int GS, GH, GU, GC, GX3;
    
  GC = C2BB->file.my_irrep;
  GU = EBB->file.my_irrep;
    
  if (do_singles)
    GH = DBB->file.my_irrep;
  else if (do_doubles)
    GH = Wmafe->file.my_irrep;
  
  GS = Sijab->file.my_irrep;
  GX3 = GU^GC;

  nirreps = C2BB->params->nirreps;

  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 += bvirtpi[Ga] * bvirtpi[Gb];
    }
  }

  if (do_singles) {

    dpd_file2_mat_init(SIA);
    dpd_file2_mat_rd(SIA);
    dpd_file2_mat_init(Sia);
    dpd_file2_mat_rd(Sia);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(DBB, h);
      dpd_buf4_mat_irrep_rd(DBB, h);
      dpd_buf4_mat_irrep_init(DBA, h);
      dpd_buf4_mat_irrep_rd(DBA, h);
    }
  }

  if (do_doubles) {

    dpd_file2_mat_init(FME);
    dpd_file2_mat_rd(FME);
    dpd_file2_mat_init(Fme);
    dpd_file2_mat_rd(Fme);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(WmNiE, h);
      dpd_buf4_mat_irrep_rd(WmNiE, h);
  
      dpd_buf4_mat_irrep_init(Wmnie, h);
      dpd_buf4_mat_irrep_rd(Wmnie, h);
  
      dpd_buf4_mat_irrep_init(WMnIe, h);
      dpd_buf4_mat_irrep_rd(WMnIe, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(Sijab, h);
      dpd_buf4_mat_irrep_rd(Sijab, h);
    }

    /* put result here until end of function */
    S_irr = SIjAb->file.my_irrep;
    dpd_buf4_init(&SiJaB, CC_TMP0, S_irr, 23, 29, 23, 29, 0, "CC3 SiJaB");
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_init(&SiJaB, h);
    }
  }

  dpd_file2_init(&fIJ, CC_OEI, 0, 0, 0, "fIJ");
  dpd_file2_init(&fAB, CC_OEI, 0, 1, 1, "fAB");
  dpd_file2_init(&fij, CC_OEI, 0, 2, 2, "fij");
  dpd_file2_init(&fab, CC_OEI, 0, 3, 3, "fab");

  /* target T3 amplitudes go in here */
  W1 = (double ***) malloc(nirreps * sizeof(double **));
  W2 = (double ***) malloc(nirreps * sizeof(double **));
  W3 = (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 ^ GX3;
	  W1[Gab] = dpd_block_matrix(FBB->params->coltot[Gab], avirtpi[Gc]);
	}
	for(Ga=0; Ga < nirreps; Ga++) {
	  Gcb = Ga ^ Gijk ^ GX3;
	  W2[Ga] = dpd_block_matrix(bvirtpi[Ga], WMaFe->params->coltot[Gcb]);
	}
	for(Gb=0; Gb < nirreps; Gb++) {
	  Gac = Gb ^ Gijk ^ GX3; 
	  W3[Gb] = dpd_block_matrix(bvirtpi[Gb], WmAfE->params->coltot[Gac]);
	}

	for(i=0; i < boccpi[Gi]; i++) {
	  I = bocc_off[Gi] + i;
	  for(j=0; j < boccpi[Gj]; j++) {
	    J = bocc_off[Gj] + j;
	    for(k=0; k < aoccpi[Gk]; k++) {
	      K = aocc_off[Gk] + k;

	      T3_AAB(W1, nirreps, I, Gi, J, Gj, K, Gk, C2BB, C2BA, C2AB, 
		     FBB, FBA, FAB, EBB, EBA, EAB, &fij, &fIJ, &fab, &fAB,
		     boccpi, bocc_off, aoccpi, aocc_off, bvirtpi, bvir_off, avirtpi, avir_off, omega);

          if (do_singles) {
	      /* S_KC <-- 1/4 t_ijKabC <ij||ab> */

	      Gc = Gk ^ GS; 
	      Gab = Gij ^ GH;

	      ij = DBB->params->rowidx[I][J];

	      nrows = DBB->params->coltot[Gij^GH];
	      ncols = avirtpi[Gc];

	      if(nrows && ncols)
		C_DGEMV('t', nrows, ncols, 0.25, W1[Gab][0], ncols, DBB->matrix[Gij][ij], 1,
			1.0, SIA->matrix[Gk][k], 1);

	      /* S_ia <-- t_ijKabC <jK|bC> */

	      Ga = Gi ^ GS;  
	      Gbc = Gjk ^ GH;

	      jk = DBA->params->rowidx[J][K];

	      for(Gab=0; Gab < nirreps; Gab++) {
		Gb = Ga ^ Gab;
		Gc = Gb ^ Gbc;

		ab = W_offset[Gab][Ga];
		bc = DBA->col_offset[Gjk][Gb];

		nrows = bvirtpi[Ga];
		ncols = bvirtpi[Gb] * avirtpi[Gc];

		if(nrows && ncols)
		  C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][ab], ncols, &(DBA->matrix[Gjk][jk][bc]), 1,
			  1.0, Sia->matrix[Gi][i], 1);
	      }
          } /* end do_singles */

          if (do_doubles ) {
	      /* S_ijab <-- t_ijKabC F_KC */
	      Gc = Gk ^ GH;  
	      Gab = Gij ^ GS;

	      nrows = Sijab->params->coltot[Gij^GS];
	      ncols = avirtpi[Gc];
	      ij = Sijab->params->rowidx[I][J];
 
	      if(nrows && ncols)
		C_DGEMV('n', nrows, ncols, 1.0, W1[Gab][0], ncols, FME->matrix[Gk][k], 1,
			1.0, Sijab->matrix[Gij][ij], 1);

	      /* S_jKbC <-- t_ijKabC F_ia */
	      Ga = Gi ^ GH;
	      Gbc = Gjk ^ GS;

	      jk = C2BA->params->rowidx[J][K];

	      for(Gab=0; Gab < nirreps; Gab++) {
		Gb = Ga ^ Gab;
		Gc = Gb ^ Gbc;

		ab = W_offset[Gab][Ga];
		bc = SiJaB.col_offset[Gjk][Gb];

		nrows = bvirtpi[Ga];
		ncols = bvirtpi[Gb] * avirtpi[Gc];

		if(nrows && ncols)
		  C_DGEMV('t', nrows, ncols, 1.0, W1[Gab][ab], ncols, Fme->matrix[Gi][i], 1,
			  1.0, &(SiJaB.matrix[Gjk][jk][bc]), 1);
	      }

	      /* S_jida <-- t_ijKabC W_KdCb */
	      /* sort W1(ab,C) to W2(a,Cb) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3;
		for(ab=0; ab < FBB->params->coltot[Gab]; ab++) {
		  A = FBB->params->colorb[Gab][ab][0];
		  B = FBB->params->colorb[Gab][ab][1];
		  Ga = FBB->params->rsym[A];
		  a = A - bvir_off[Ga];
		  for(c=0; c < avirtpi[Gc]; c++) {
		    C = avir_off[Gc] + c;
		    cb = WMaFe->params->colidx[C][B];
		    W2[Ga][a][cb] = W1[Gab][ab][c];
		  }
		}
	      }

	      ji = Sijab->params->rowidx[J][I];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gkd = Gk ^ Gd; 
		Gcb = Gkd ^ GH; 
		Ga = Gd ^ Gij ^ GS;      

		kd = WMaFe->row_offset[Gkd][K];
		WMaFe->matrix[Gkd] = dpd_block_matrix(bvirtpi[Gd], WMaFe->params->coltot[Gkd^GH]);
		dpd_buf4_mat_irrep_rd_block(WMaFe, Gkd, kd, bvirtpi[Gd]);
		Z = block_matrix(bvirtpi[Ga], bvirtpi[Gd]);

		nrows = bvirtpi[Ga];
		ncols = bvirtpi[Gd];
		nlinks = WMaFe->params->coltot[Gkd^GH];

		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 < bvirtpi[Ga]; a++) {
		  A = bvir_off[Ga] + a;
		  for(d=0; d < bvirtpi[Gd]; d++) {
		    DD = bvir_off[Gd] + d;
		    ad = Sijab->params->colidx[A][DD];
		    da = Sijab->params->colidx[DD][A];
		    Sijab->matrix[Gij][ji][ad] += -Z[a][d];
		    Sijab->matrix[Gij][ji][da] += Z[a][d];
		  }
		}

		dpd_free_block(WMaFe->matrix[Gkd], bvirtpi[Gd], WMaFe->params->coltot[Gkd^GH]);
		free_block(Z);
	      }

	      /* t_jKcD <-- 1/2 t_ijKabC W_idab */

	      jk = SiJaB.params->rowidx[J][K];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gid = Gi ^ Gd;
		Gab = Gid ^ GH;
		Gc = Gab ^ Gijk ^ GX3;   

		id = Wmafe->row_offset[Gid][I];
		Wmafe->matrix[Gid] = dpd_block_matrix(bvirtpi[Gd], Wmafe->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(Wmafe, Gid, id, bvirtpi[Gd]);
		Z = block_matrix(avirtpi[Gc], bvirtpi[Gd]);

		nrows = avirtpi[Gc];
		ncols = bvirtpi[Gd];
		nlinks = Wmafe->params->coltot[Gid^GH];

		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 < avirtpi[Gc]; c++) {
		  C = avir_off[Gc] + c;
		  for(d=0; d < bvirtpi[Gd]; d++) {
		    DD = bvir_off[Gd] + d;
		    dc = SiJaB.params->colidx[DD][C];
		    SiJaB.matrix[Gjk][jk][dc] += Z[c][d];
		  }
		}

		free_block(Z);
		dpd_free_block(Wmafe->matrix[Gid], bvirtpi[Gd], Wmafe->params->coltot[Gid^GH]);
	      }

	      /* t_jKbD <-- t_ijKabC W_iDaC */
	      /* sort W1(ab,C) to W3(b,aC) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3;
		for(ab=0; ab < FBB->params->coltot[Gab]; ab++) {
		  A = FBB->params->colorb[Gab][ab][0];
		  B = FBB->params->colorb[Gab][ab][1];
		  Gb = FBB->params->ssym[B];
		  b = B - bvir_off[Gb];
		  for(c=0; c < avirtpi[Gc]; c++) {
		    C = avir_off[Gc] + c;
		    ac = WmAfE->params->colidx[A][C];
		    W3[Gb][b][ac] = W1[Gab][ab][c];
		  }
		}
	      }

	      jk = SiJaB.params->rowidx[J][K];

	      for(Gd=0; Gd < nirreps; Gd++) {
		Gid = Gi ^ Gd;
		Gac = Gid ^ GH;
		Gb = Gac ^ Gijk ^ GX3;   

		id = WmAfE->row_offset[Gid][I]; 
		WmAfE->matrix[Gid] = dpd_block_matrix(avirtpi[Gd], WmAfE->params->coltot[Gid^GH]);
		dpd_buf4_mat_irrep_rd_block(WmAfE, Gid, id, avirtpi[Gd]);
		Z = block_matrix(bvirtpi[Gb], avirtpi[Gd]);

		nrows = bvirtpi[Gb];
		ncols = avirtpi[Gd];
		nlinks = WmAfE->params->coltot[Gid^GH];

		if(nrows && ncols && nlinks)
		  C_DGEMM('n', 't', nrows, ncols, nlinks, 1.0, W3[Gb][0], nlinks,
			  WmAfE->matrix[Gid][0], nlinks, 0.0, Z[0], ncols);

		for(b=0; b < bvirtpi[Gb]; b++) {
		  B = bvir_off[Gb] + b;
		  for(d=0; d < avirtpi[Gd]; d++) {
		    DD = avir_off[Gd] + d;
		    bd = SiJaB.params->colidx[B][DD];
		    SiJaB.matrix[Gjk][jk][bd] += Z[b][d];
		  }
		}

		dpd_free_block(WmAfE->matrix[Gid], avirtpi[Gd], WmAfE->params->coltot[Gid^GH]);
		free_block(Z);
	      }

	      /* S_miab <--- +t_ijKabC W_jKmC */
	      /* S_imab <--- -t_ijKabC W_jKmC */

	      jk = WmNiE->params->rowidx[J][K];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmi = Gm ^ Gi; 
		Gab = Gmi ^ GS; 
		Gc = Gab ^ Gijk ^ GX3;    

		mc = WmNiE->col_offset[Gjk][Gm];

		nrows = Sijab->params->coltot[Gab];
		ncols = boccpi[Gm];
		nlinks = avirtpi[Gc];

		Z = 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 = bocc_off[Gm] + m;
		  mi = Sijab->params->rowidx[M][I];
		  im = Sijab->params->rowidx[I][M];
		  for(ab=0; ab < nrows; ab++) {
		    Sijab->matrix[Gmi][mi][ab] += Z[ab][m];
		    Sijab->matrix[Gmi][im][ab] -= Z[ab][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }

	      /* 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 ^ GX3; 
		for(ab=0; ab < FBB->params->coltot[Gab]; ab++ ){
		  A = FBB->params->colorb[Gab][ab][0];
		  B = FBB->params->colorb[Gab][ab][1];
		  Ga = FBB->params->rsym[A];
		  a = A - bvir_off[Ga];
		  for(c=0; c < avirtpi[Gc]; c++) {
		    C = avir_off[Gc] + c;
		    bc = SiJaB.params->colidx[B][C];
		    W3[Ga][a][bc] = W1[Gab][ab][c];
		  }
		}
	      }

	      ij = Wmnie->params->rowidx[I][J];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gmk = Gm ^ Gk;
		Gbc = Gmk ^ GS;
		Ga = Gbc ^ Gijk ^ GX3;   

		ma = Wmnie->col_offset[Gij][Gm];

		nrows = SiJaB.params->coltot[Gmk^GS];
		ncols = boccpi[Gm];
		nlinks = bvirtpi[Ga];

		Z = dpd_block_matrix(nrows, ncols);

		if(nrows && ncols && nlinks)
		  C_DGEMM('t', 't', nrows, ncols, nlinks, 0.5, W3[Ga][0], nrows,
			  &(Wmnie->matrix[Gij][ij][ma]), nlinks, 0.0, Z[0], ncols);

		for(m=0; m < boccpi[Gm]; m++) {
		  M = bocc_off[Gm] + m;
		  mk = SiJaB.params->rowidx[M][K];
		  for(bc=0; bc < nrows; bc++) {
		    SiJaB.matrix[Gmk][mk][bc] += Z[bc][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }

	      /* S_iMbC <-- t_ijKabC W_KjMa */
	      /* sort W(ab,C) to W(a,bC) */
	      for(Gab=0; Gab < nirreps; Gab++) {
		Gc = Gab ^ Gijk ^ GX3; 
		for(ab=0; ab < FBB->params->coltot[Gab]; ab++ ){
		  A = FBB->params->colorb[Gab][ab][0];
		  B = FBB->params->colorb[Gab][ab][1];
		  Ga = FBB->params->rsym[A];
		  a = A - bvir_off[Ga];
		  for(c=0; c < avirtpi[Gc]; c++) {
		    C = avir_off[Gc] + c;
		    bc = SiJaB.params->colidx[B][C];
		    W3[Ga][a][bc] = W1[Gab][ab][c];
		  }
		}
	      }

	      kj = WMnIe->params->rowidx[K][J];

	      for(Gm=0; Gm < nirreps; Gm++) {
		Gim = Gi ^ Gm; 
		Gbc = Gim ^ GS; 
		Ga = Gbc ^ Gijk ^ GX3;    

		ma = WMnIe->col_offset[Gjk][Gm];

		nrows = SiJaB.params->coltot[Gim^GS];
		ncols = aoccpi[Gm];
		nlinks = bvirtpi[Ga];

		Z = dpd_block_matrix(nrows, ncols);

		if(nrows && ncols && nlinks)
		  C_DGEMM('t', 't', nrows, ncols, nlinks, 1.0, W3[Ga][0], nrows,
			  &(WMnIe->matrix[Gjk][kj][ma]), nlinks, 0.0, Z[0], ncols);

		for(m=0; m < aoccpi[Gm]; m++) {
		  M = aocc_off[Gm] + m;
		  im = SiJaB.params->rowidx[I][M];
		  for(bc=0; bc < nrows; bc++) {
		    SiJaB.matrix[Gim][im][bc] += Z[bc][m];
		  }
		}

		dpd_free_block(Z, nrows, ncols);
	      }
          } /* end do_doubles */

	    } /* k */
	  } /* j */
	} /* i */

	for(Gab=0; Gab < nirreps; Gab++) {
	  Gc = Gab ^ Gijk ^ GX3;
	  dpd_free_block(W1[Gab], FBB->params->coltot[Gab], avirtpi[Gc]);
	}
	for(Ga=0; Ga < nirreps; Ga++) {
	  Gcb = Ga ^ Gijk ^ GX3; 
	  dpd_free_block(W2[Ga], bvirtpi[Ga], WMaFe->params->coltot[Gcb]);
	}
	for(Gb=0; Gb < nirreps; Gb++) {
	  Gac = Gb ^ Gijk ^ GX3;
	  dpd_free_block(W3[Gb], bvirtpi[Gb], WmAfE->params->coltot[Gac]);
	}
      } /* Gk */
    } /* Gj */
  } /* Gi */

  free(W1);
  free(W2);
  free(W3);
  free_int_matrix(W_offset);

  dpd_file2_close(&fIJ);
  dpd_file2_close(&fAB);
  dpd_file2_close(&fij);
  dpd_file2_close(&fab);

  if (do_singles) {

    dpd_file2_mat_wrt(SIA);
    dpd_file2_mat_close(SIA);
    dpd_file2_mat_wrt(Sia);
    dpd_file2_mat_close(Sia);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_close(DBB, h);
      dpd_buf4_mat_irrep_close(DBA, h);
    }
  }

  if (do_doubles) {

    dpd_file2_mat_close(FME);
    dpd_file2_mat_close(Fme);

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_close(WmNiE, h);
      dpd_buf4_mat_irrep_close(Wmnie, h);
      dpd_buf4_mat_irrep_close(WMnIe, h);
    }

    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(Sijab, h);
      dpd_buf4_mat_irrep_close(Sijab, h);
    }
    for(h=0; h < nirreps; h++) {
      dpd_buf4_mat_irrep_wrt(&SiJaB, h);
      dpd_buf4_mat_irrep_close(&SiJaB, h);
    }
    dpd_buf4_sort(&SiJaB, CC_TMP0, qpsr, 22, 28, "CC3 SIjAb");
    dpd_buf4_close(&SiJaB);
    dpd_buf4_init(&SiJaB, CC_TMP0, S_irr, 22, 28, 22, 28, 0, "CC3 SIjAb");
    dpd_buf4_axpy(&SiJaB, SIjAb, 1.0);
    dpd_buf4_close(&SiJaB);
  }

}

} /* extern "C" */
