/****************************************************************
 * MIMD SU3 - adjoint Higgs                                     *
 *                                                              *
 *     Correlation routines                                     *
 *     Kari Rummukainen 1997                                    *
 *                                                              *
 *     Calculate the correlations using blocked operators       *
 *                                                              *
 ***************************************************************/

#include "lattice.h"    /* global variables for lattice fields */

/* #define check
 */

#define cdot(a,b)  ((a).real*(b).real + (a).imag*(b).imag)

void block_correlation(double *hz0[2][MAX_BOP],double_complex *hz1[2][MAX_BOP],
		       double *rz[2][MAX_BOP],double *pz[2][MAX_BOP]);
void getclover(su3_matrix *b_link[NDIM], su3_matrix *clover);
#define R2value(i,bh) adj_sqr(&bh[i])
double Pvalue(int i, double *ap, su3_matrix *clover, adjoint_matrix *b_higgs);
double R3value(int i, adjoint_matrix *b_higgs);
void Hvalues(int i, su3_matrix *clover, adjoint_matrix *b_higgs,
	     double *h10, double_complex *h11, double *h20, 
	     double_complex *h21);

void
hcorr()
{
  /*     X |-- UF -- UF -- UF -- > F
   *
   *     1/2 Tr(X UU F')
   */

  static int not_alloc = 1;
  int z,zd,i,d,blev,nz;
  double w,th,tk,tH,tK,tr2,tr3,tp,tap;
  static double_complex *hz1[2][MAX_BOP];
  static double *hz0[2][MAX_BOP],*rz[2][MAX_BOP], *pz[2][MAX_BOP], *fz_array;

  nz = lattice.size[ZUP];

  if (not_alloc) {
    /* first, allocate the needed arrays and set pointers */

    not_alloc = 0;
    fz_array = (double *)calloc(nz*n_bop*(1*2*3 + 2*2*1),sizeof(double));
    for (i=0; i<n_bop; i++) {
      rz[0][i]  = fz_array + i*nz;
      rz[1][i]  = fz_array + (i + n_bop)*nz;
      pz[0][i]  = fz_array + (i + 2*n_bop)*nz;
      pz[1][i]  = fz_array + (i + 3*n_bop)*nz;
      hz0[0][i] = fz_array + (i + 4*n_bop)*nz;
      hz0[1][i] = fz_array + (i + 5*n_bop)*nz;
      hz1[0][i] = (double_complex*)(fz_array + (2*i + 6*n_bop)*nz);
      hz1[1][i] = (double_complex*)(fz_array + (2*i + 8*n_bop)*nz);
    }
    if (this_node == 0) {
      c_array = (float *)calloc(n_corr*corrlen,sizeof(float));
      for (i=0; i<n_bop; i++) {
	cr2[i] = c_array + i*corrlen;
	cr3[i] = c_array + (i + n_bop)*corrlen;
	ch0[i] = c_array + (i + 2*n_bop)*corrlen;
	ch1[i] = c_array + (i + 3*n_bop)*corrlen;
	cH0[i] = c_array + (i + 4*n_bop)*corrlen;
	cH1[i] = c_array + (i + 5*n_bop)*corrlen;
	cp0[i] = c_array + (i + 6*n_bop)*corrlen;
	cp1[i] = c_array + (i + 7*n_bop)*corrlen;
      }
    }
  }

  /* nonblock and blocked ones */
  block_correlation(hz0,hz1,rz,pz);

  /* sum over nodes */
  g_vecdoublesum(fz_array, (3*2 + 2*2)*n_bop*nz, 0);

  /* now calculate the correlations */

  if (this_node == 0) {
    if (is_multicanonical ) {
      /* MUCA-weight function needed */
      w = multi_weight();
    } else w = 1;

    for (i=0; i<n_bop; i++) {
      for (d=blev=0; d<=i; blev++) if (b_level[blev]) d++;
      blev--;
      for (d=0; d<corrlen; d++) {
      
	tp = tap = tr2 = tr3 = th = tk = tH = tK = 0.0;
	for (z=0; z<nz; z++) {
	  zd = (z+d)%nz;
	  tr2 += rz[0][i][z]*rz[0][i][zd]*w;
	  tr3 += rz[1][i][z]*rz[1][i][zd]*w;

	  th  += hz0[0][i][z]*hz0[0][i][zd]*w;
	  tH  += hz0[1][i][z]*hz0[1][i][zd]*w;
	  tk  += cdot(hz1[0][i][z],hz1[0][i][zd])*w;
	  tK  += cdot(hz1[1][i][z],hz1[1][i][zd])*w;

	  tp  += pz[0][i][z]*pz[0][i][zd]*w;
	  tap += pz[1][i][z]*pz[1][i][zd]*w;
	}
	cr2[i][d] += tr2;
	cr3[i][d] += tr3;
	ch0[i][d] += th;
	cH0[i][d] += tH;
	ch1[i][d] += tk;
	cH1[i][d] += tK;
	cp0[i][d] += tp;
	cp1[i][d] += tap;
      }
    }
  }
}

/***********************************************************
 *                                                         *
 *     Block the correls                                   *
 *                                                         *
 **********************************************************/

void
block_correlation(hz0,hz1,rz,pz)
     double_complex *hz1[2][MAX_BOP];
     double *rz[2][MAX_BOP],*pz[2][MAX_BOP],*hz0[2][MAX_BOP];
{
  int bx,by,i,b_ind,z,iblock,nz;
  double_complex ct,ct2;
  double ht,ht2,pa;
  su3_matrix *b_link[NDIM];
  adjoint_matrix *b_higgs;
  

  bx = lattice.size[XUP]; by = lattice.size[YUP];
  nz = lattice.size[ZUP];

  b_ind = 0;
  for (iblock=0; iblock<n_blocking; iblock++) {
    
    if (iblock == 0) {
      /* just set the blocked fields as originals */
      b_higgs = ahiggs;
      foralldir(i) b_link[i] = U[i];

    } else {
      int bl[NDIM];
      int d[NDIM];

      bx /= 2; by /= 2; 
      bl[XUP] = bl[YUP] = iblock;
      bl[ZUP] = 0;

      d[XUP] = d[YUP] = 1;    /* smooth only along xy-plane */
      d[ZUP] = 0; 

      /* block the gauge and higgs variables - first higgs! */
      
      if (iblock == 1) {
	/* 1st blocking */
	foralldir(i) b_link[i] = copy_latfield( U[i], su3_matrix );
	b_higgs = copy_latfield( ahiggs, adjoint_matrix );
      }
      smooth_field_su3adjoint( b_link, b_higgs, d, b_const_a1, b_const_a2 );
      b_higgs = block_field_su3adjoint( b_higgs, bl, 1 );

      smooth_link_su3( b_link, d, d, b_const_g1, b_const_g2  );
      block_link_su3(b_link, b_link, bl, 1);

      set_blocking_level( bl );

    }


    if (b_level[iblock]) {
      su3_matrix * clover;

      clover = tmp_latfield( su3_matrix );
      
      /* calculate iblock-level operators */

      ct.real = ct.imag = 0;
      for (i=0; i<2; i++) for (z=0; z<nz; z++) { 
	hz1[i][b_ind][z] = ct;
	hz0[i][b_ind][z] = rz[i][b_ind][z] = pz[i][b_ind][z] = 0.0;
      }

      getclover(b_link,clover);

      forallsites(i) {
	z = zcoord(i);
	rz[0][b_ind][z]  += R2value(i,b_higgs);
	rz[1][b_ind][z]  += R3value(i,b_higgs);
	pz[0][b_ind][z]  += Pvalue(i, &pa, clover, b_higgs);
	pz[1][b_ind][z]  += pa;

	Hvalues(i, clover, b_higgs, &ht, &ct, &ht2, &ct2);
	hz0[0][b_ind][z] += ht;
	hz0[1][b_ind][z] += ht2;
	CSUM(hz1[0][b_ind][z], ct);
	CSUM(hz1[1][b_ind][z],ct2);
      }
      b_ind++;

      free_tmp( clover );
    }
  }

  if (n_blocking > 1) {
    free_latfield( b_higgs );
    foralldir(i) free_latfield( b_link[i] );
  }

  reset_blocking_level();
}

/****************************************************************
 *                                                              *
 *     Get the plaquette to ->staple                            *
 *     Symmetrize it to a clover form                           *
 *                                                              *
 ***************************************************************/

void
getclover(su3_matrix *b_link[NDIM], su3_matrix *clover)
{
  int i;
  msg_tag *tag0,*tag1;
  su3_matrix ta,tb,*tmpmat;

  /* gather up-links */

  tmpmat = tmp_latfield( su3_matrix );

  tag0 = start_get( b_link[YUP], XUP, EVENODD );
  tag1 = start_get( b_link[XUP], YUP, EVENODD );

  /* multiply up-up -plaq */
  forallsites_wait2(i,tag0,tag1) {
    mult_su3_nn( &b_link[XUP][i],&b_link[YUP][nb(XUP,i)], &ta);
    mult_su3_na( &ta, &b_link[XUP][nb(YUP,i)], &tb);
    mult_su3_na( &tb, &b_link[YUP][i], &clover[i] );
    /* shift it YUP too */
    mult_su3_an( &b_link[YUP][i], &tb, &tmpmat[i] );
  }

  /* move plaq YUP */
  tag0 = start_get( tmpmat, YDOWN, EVENODD );
  forallsites_wait(i,tag0) {
    add_su3_matrix( &clover[i], &tmpmat[nb(YDOWN,i)], &clover[i] );
  }

  /* this can not be merged with the one above! */
  /* prepare for XUP */
  forallsites(i) {
    mult_su3_an( &b_link[XUP][i], &clover[i], &ta );
    mult_su3_nn( &ta, &b_link[XUP][i], &tmpmat[i] );
  }

  /* move XUP */
  tag0 = start_get( tmpmat, XDOWN, EVENODD );
  forallsites_wait(i,tag0) {
    add_su3_matrix( &clover[i], &tmpmat[nb(XDOWN,i)], &clover[i] );
  }

  free_tmp( tmpmat );
}

/****************************************************************
 *                                                              *
 *     Calculate the blocked correlations                       *
 *                                                              *
 ***************************************************************/

void
Hvalues(int i, su3_matrix *clover, adjoint_matrix *b_higgs,
	double *h10, double_complex *h11, double *h20, 
	double_complex *h21)
{
  /* this now calculates H_i = i eps_ijk Tr A0 U_jk 
   * assumes that clover is in ->staple, and
   * adjoint higgs in b_higgs
   */

  su3_matrix u,a,a2;
  double td,tr;

  td = pi2*((double)xcoord(i))/lattice.size[XUP];

  /* calculate I (U - U') */
  su3_adjoint( &clover[i], &u);
  sub_su3_matrix( &clover[i], &u, &a);
  mult_su3_by_I( &a, &u );

  uncompress_adjmat( &b_higgs[i], &a);

  /* get A0 U_12, this is real */
  
  *h10 = tr = realtrace_su3( &a, &u);  /* a' *u */
  h11->real = cos(td) * tr;
  h11->imag = sin(td) * tr;

  /* and also A0^2 U_12, real */

  mult_su3_nn( &a, &a, &a2);
  *h20 = tr = realtrace_su3( &a2, &u); /* also a2' * u */
  h21->real = cos(td) * tr;
  h21->imag = sin(td) * tr;
}


/****************************************************************
 *                                                              *
 *      A0^3 from ->b_higgs                                     *
 *                                                              *
 ***************************************************************/

double
R3value(int i, adjoint_matrix *b_higgs)
{
  su3_matrix a,a2;
  
  uncompress_adjmat(&b_higgs[i], &a);
  mult_su3_nn(&a, &a, &a2);
  return((double)realtrace_su3( &a2, &a));  /* a2' a */
}


/****************************************************************
 *                                                              *
 *     calculate plaq. correlations                             *
 *     uses ->staple !                                          *
 *     and A0 in -> b_higgs                                     *
 *                                                              *
 ***************************************************************/

double
Pvalue(int i, double *ap, su3_matrix *clover, adjoint_matrix *b_higgs)
{
  int k;
  double p;
  su3_matrix a,p2;
  
  for (p=k=0; k<3; k++) p += clover[i].e[k][k].real;

  su3_adjoint(&clover[i], &a);
  add_su3_matrix(&clover[i], &a, &p2);
  uncompress_adjmat(&b_higgs[i], &a);
  
  *ap = (double)realtrace_su3( &p2, &a); /* p2' * a */
  return(p);
}

/*************************************************************/


