#include <stdio.h>
#include <libqt/qt.h>
#include "dpd.h"

/* dpd_trace42_13(): Take a "trace" of the specified indices of a buf4 and put the
** result into a file2.
** 
** In this version of the trace42 functions, the summation indices are 1 and 3:
**
**         B(q,s) = alpha * \Sum_{p==r} A(pq,rs) + beta * B(q,s)
** 
** Arguments:
**   dpdbuf4 *A: Pointer to the input four-index buffer.
**   dpdfile2 *B: Pointer to the target two-index file.
**   int transb: Boolean to indicate whether B should be transposed to match the 
**               target index ordering of A.
**   double alpha: Prefactor for A.
**   double beta: Prefactor for B.
*/

int dpd_trace42_13(dpdbuf4 *A, dpdfile2 *B, int transb, double alpha, double beta)
{
  int h, Gp, Gq, Gr, Gs;
  int p, q, r, s;
  int P, Q, R, S;
  int pq, rs;
  int nirreps;

  nirreps = A->params->nirreps;

  dpd_file2_scm(B, beta);
  dpd_file2_mat_init(B);
  dpd_file2_mat_rd(B);

#ifdef DPD_TIMER
  timer_on("trace42");
#endif

  /* Read all of A into core */
  for(h=0; h < nirreps; h++) {
    dpd_buf4_mat_irrep_init(A, h);
    dpd_buf4_mat_irrep_rd(A, h);
  }

  for(h=0; h < nirreps; h++) {

    for(Gp=0; Gp < nirreps; Gp++) {
      Gq = Gp ^ h;
      Gr = Gp;
      Gs = Gq;

      /* Loop over target indices */
      for(q=0; q < A->params->qpi[Gq]; q++) {
	Q = A->params->qoff[Gq] + q;

	for(s=0; s < A->params->spi[Gs]; s++) {
	  S = A->params->soff[Gs] + s;

	  /* Loop over elements for which P==R */
	  for(p=0; p < A->params->ppi[Gp]; p++) {
	    P = A->params->poff[Gp] + p;
	    R = P;

	    pq = A->params->rowidx[P][Q];
	    rs = A->params->colidx[R][S];

	    if(!transb)  B->matrix[Gq][q][s] += alpha * A->matrix[h][pq][rs];
	    else  B->matrix[Gq][s][q] += alpha * A->matrix[h][pq][rs];

	  }
	}
      }

    }

  }

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

#ifdef DPD_TIMER
  timer_off("trace42");
#endif

  /* Close the two-index quantities */
  dpd_file2_mat_wrt(B);
  dpd_file2_mat_close(B);

  return 0;
}
