コード例 #1
0
ファイル: d_plaq2.c プロジェクト: andypea/MILC
void d_plaquette(double *ss_plaq,double *st_plaq) {
register int i,dir1,dir2;
register site *s;
register su3_matrix *m1,*m4;
double ss_sum,st_sum;
msg_tag *mtag0,*mtag1;
    ss_sum = st_sum = 0.0;
    for(dir1=YUP;dir1<=TUP;dir1++){
	for(dir2=XUP;dir2<dir1;dir2++){

	    mtag0 = start_gather_site( F_OFFSET(link[dir2]), sizeof(su3_matrix),
		dir1, EVENANDODD, gen_pt[0] );
	    mtag1 = start_gather_site( F_OFFSET(link[dir1]), sizeof(su3_matrix),
		dir2, EVENANDODD, gen_pt[1] );

	    FORALLSITES(i,s){
		m1 = &(s->link[dir1]);
		m4 = &(s->link[dir2]);
		mult_su3_an(m4,m1,&(s->tempmat1));
	    }

	    wait_gather(mtag0);
	    FORALLSITES(i,s){
#ifdef SCHROED_FUN
		if(dir1==TUP ){
		    if(s->t==(nt-1)){
			mult_su3_nn( &(s->tempmat1),
			    &(s->boundary[dir2]), &(s->staple));
		    }
		    else{
			mult_su3_nn( &(s->tempmat1),
			    (su3_matrix *)(gen_pt[0][i]), &(s->staple));
		    }
		}
		else if(s->t > 0){
		    mult_su3_nn( &(s->tempmat1), (su3_matrix *)(gen_pt[0][i]),
			 &(s->staple));
		}
#else
		mult_su3_nn( &(s->tempmat1),(su3_matrix *)(gen_pt[0][i]),
		    &(s->staple) );
#endif
	    }

	    wait_gather(mtag1);
	    FORALLSITES(i,s){
		if(dir1==TUP )st_sum += (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&(s->staple) );
#ifdef SCHROED_FUN
		else if(s->t > 0) ss_sum += (double)
#else
		else              ss_sum += (double)
#endif
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&(s->staple) );
	    }

	    cleanup_gather(mtag0);
	    cleanup_gather(mtag1);
	}
    }
コード例 #2
0
ファイル: f_mu_nu1.c プロジェクト: erinaldi/milc_qcd
    FORALLSITES(i,s){
        mult_su3_na( (su3_matrix *)(gen_pt[0][i]),
	    (su3_matrix *)(gen_pt[1][i]), ((su3_matrix *)F_PT(s,f_mn)) );
        mult_su3_nn( &(s->tempmat1), ((su3_matrix *)F_PT(s,f_mn)),
	    &(s->tempmat2) );
	mult_su3_nn( ((su3_matrix *)F_PT(s,f_mn)), &(s->tempmat1),
	    &(s->staple) );
    }
コード例 #3
0
ファイル: update_h.c プロジェクト: erinaldi/milc_qcd
/* update the momenta with the gauge force */
void gauge_force(Real eps) {
register int i,dir1,dir2;
register site *st;
msg_tag *tag0,*tag1,*tag2;
int start;
su3_matrix tmat1,tmat2;
register Real eb3;

/**double dtime,dclock();
dtime = -dclock();**/

    eb3 = eps*beta/3.0;
    /* Loop over directions, update mom[dir1] */
    for(dir1=XUP; dir1<=TUP; dir1++){
	/* Loop over other directions, computing force from plaquettes in
	   the dir1,dir2 plane */
	start=1; /* indicates staple sum not initialized */
	for(dir2=XUP;dir2<=TUP;dir2++)if(dir2 != dir1){

	    /* get link[dir2] from direction dir1 */
	    tag0 = start_gather_site( F_OFFSET(link[dir2]), sizeof(su3_matrix),
		dir1, EVENANDODD, gen_pt[0] );

	    /* Start gather for the "upper staple" */
	    tag2 = start_gather_site( F_OFFSET(link[dir1]), sizeof(su3_matrix),
		dir2, EVENANDODD, gen_pt[2] );

	    /* begin the computation "at the dir2DOWN point", we will
		later gather the intermediate result "to the home point" */

	    wait_gather(tag0);
	    FORALLSITES(i,st){
	        mult_su3_an( &(st->link[dir2]), &(st->link[dir1]), &tmat1 );
	        mult_su3_nn( &tmat1, (su3_matrix *)gen_pt[0][i],
		    &(st->tempmat1) );
	    }

	    /* Gather this partial result "up to home site" */
	    tag1 = start_gather_site( F_OFFSET(tempmat1), sizeof(su3_matrix),
		OPP_DIR(dir2), EVENANDODD, gen_pt[1] );

	    /* begin the computation of the "upper" staple.  Note that
		one of the links has already been gathered, since it
		was used in computing the "lower" staple of the site
		above us (in dir2) */
	    wait_gather(tag2);
	    if(start){	/* this is the first contribution to staple */
	        FORALLSITES(i,st){
		    mult_su3_nn( &(st->link[dir2]), (su3_matrix *)gen_pt[2][i],
		        &tmat1);
		    mult_su3_na( &tmat1, (su3_matrix *)gen_pt[0][i],
			&(st->staple) );
		}
		start=0;
	    }
コード例 #4
0
ファイル: block_nhyp.c プロジェクト: erinaldi/milc_qcd
void block_nhyp3()
{
    register int dir, dir2, i;
    register site *st;
    Real f[3];   /* related code is specific to SU(3) */
    Real ftmp1,ftmp2;
    su3_matrix tmat, Omega, eQ,  Q, Q2;

    ftmp1=alpha_smear[0]/(6.*(1.-alpha_smear[0]));
    ftmp2=1.-alpha_smear[0];

    for(dir=XUP;dir<=TUP;dir++){

	/* compute the staple */
	FORALLDYNLINKS(i,st,dir)  clear_su3mat(&Staple3[dir][i]);
	for(dir2=XUP;dir2<=TUP;dir2++) if(dir2!=dir){
#if (SMEAR_LEVEL>1)
	    staple_nhyp(dir,dir2,hyplink2[dir2][dir],
		        hyplink2[dir][dir2],Staple3[dir]);
#else /* one-level only */
	    staple_nhyp(dir,dir2,gauge_field_thin[dir],
                        gauge_field_thin[dir2],Staple3[dir]);
#endif
	}

	FORALLDYNLINKS(i,st,dir){
	    /* make Omega  */
	    scalar_mult_add_su3_matrix(gauge_field_thin[dir]+i,
                                         Staple3[dir]+i,ftmp1 ,&Q);
	    scalar_mult_su3_matrix(&Q,ftmp2,&Omega);
	    Staple3[dir][i]=Omega;
	    mult_su3_an(&Omega,&Omega,&Q);
            /* IR regulator, see clover_xxx/defines.h               */
            scalar_add_diag_su3(&Q,IR_STAB);
#ifndef NHYP_DEBUG
	    compute_fhb(&Q,f,NULL, 0);
#else
            compute_fhb(&Omega,&Q,f,NULL, 0);
#endif

	    /* make Q**2 */
	    mult_su3_nn(&Q,&Q,&Q2);

	    /* compute Q^(-1/2) via Eq. 19  */
	    scalar_mult_su3_matrix(&Q,f[1],&tmat);
	    scalar_mult_add_su3_matrix(&tmat,&Q2,f[2],&eQ);
	    scalar_add_diag_su3(&eQ,f[0]);

	    /* multiply Omega by eQ = (Omega^\dagger Omega)^(-1/2)  */
	    mult_su3_nn(&Omega,&eQ,gauge_field[dir]+i);
	}

    } /* dir */
コード例 #5
0
ファイル: update_u.c プロジェクト: lattice/milc
void update_u_cpu( Real eps ){

  register int i,dir;
  register site *s;
  su3_matrix *link,temp1,temp2,htemp;
  register Real t2,t3,t4,t5,t6,t7,t8;
  /**TEMP**
    Real gf_x,gf_av,gf_max;
    int gf_i,gf_j;
   **END TEMP **/

  /**double dtime,dtime2,dclock();**/
  /**dtime = -dclock();**/

  /* Take divisions out of site loop (can't be done by compiler) */
  t2 = eps/2.0;
  t3 = eps/3.0;
  t4 = eps/4.0;
  t5 = eps/5.0;
  t6 = eps/6.0;
  t7 = eps/7.0;
  t8 = eps/8.0;

  /** TEMP **
    gf_av=gf_max=0.0;
   **END TEMP**/
#ifdef FN
  invalidate_fermion_links(fn_links);
  //  free_fn_links(&fn_links);
  //  free_fn_links(&fn_links_dmdu0);
#endif

  FORALLSITES(i,s){
    for(dir=XUP; dir <=TUP; dir++){
      uncompress_anti_hermitian( &(s->mom[dir]) , &htemp );
      link = &(s->link[dir]);
      mult_su3_nn(&htemp,link,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t8,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t7,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t6,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t5,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t4,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t3,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,t2,&temp2);
      mult_su3_nn(&htemp,&temp2,&temp1);
      scalar_mult_add_su3_matrix(link,&temp1,eps    ,&temp2); 
      su3mat_copy(&temp2,link);
    }
  }
  /**dtime += dclock();
    node0_printf("LINK_UPDATE: time = %e  mflops = %e\n",
    dtime, (double)(5616.0*volume/(1.0e6*dtime*numnodes())) );**/
} /* update_u */
コード例 #6
0
ファイル: stout_smear_utilities.c プロジェクト: andypea/MILC
static void 
exp_iQ( su3_matrix *T, su3_matrix *Q )
{

  complex f[3];
  su3_matrix QQ;
  complex b1[3], b2[3];
  int do_bs = 0;

  mult_su3_nn( Q, Q, &QQ );
  get_fs_and_bs_from_Qs( f, b1, b2, Q, &QQ, do_bs);

#if 0
  {
    printf("f = (%.10f, %.10f) (%.10f, %.10f) (%.10f, %.10f)\n",
	   f[0].real,f[0].imag,f[1].real,f[1].imag,f[2].real,f[2].imag);
    get_fs_and_bs_from_Qs ( f, b1, b2, Q, &QQ, 1);
    printf("f = (%.10f, %.10f) (%.10f, %.10f) (%.10f, %.10f)\n",
	   f[0].real,f[0].imag,f[1].real,f[1].imag,f[2].real,f[2].imag);
    printf("b1 = (%.10f, %.10f) (%.10f, %.10f) (%.10f, %.10f)\n",
	   b1[0].real,b1[0].imag,b1[1].real,b1[1].imag,b1[2].real,b1[2].imag);
    printf("b2 = (%.10f, %.10f) (%.10f, %.10f) (%.10f, %.10f)\n",
	   b2[0].real,b2[0].imag,b2[1].real,b2[1].imag,b2[2].real,b2[2].imag);
  }
#endif

  quadr_comb( T, Q, &QQ, f);

}
コード例 #7
0
ファイル: staple.c プロジェクト: aacarosso/aacmilc
// -----------------------------------------------------------------
void directional_staple(int dir1, int dir2, field_offset lnk1,
                        field_offset lnk2, su3_matrix *stp) {

  register int i;
  register site *s;
  msg_tag *tag0, *tag1, *tag2;
  su3_matrix tmat1, tmat2;

  // Get blocked_link[dir2] from direction dir1
  tag0 = start_gather_site(lnk2, sizeof(su3_matrix), dir1,
                      EVENANDODD, gen_pt[0]);

  // Get blocked_link[dir1] from direction dir2
  tag1 = start_gather_site(lnk1, sizeof(su3_matrix), dir2,
                      EVENANDODD, gen_pt[1]);

  // Start working on the lower staple while we wait for the gathers
  // The lower staple is prepared at x-dir2 and stored in tempmat1,
  // then gathered to x
  FORALLSITES(i, s)
    mult_su3_an((su3_matrix*)F_PT(s,lnk2), (su3_matrix*)F_PT(s,lnk1),
                tempmat1 + i);

   wait_gather(tag0);
   wait_gather(tag1);

  // Finish lower staple
  FORALLSITES(i, s) {
    mult_su3_nn(tempmat1 + i, (su3_matrix *)gen_pt[0][i], &tmat1);
    su3mat_copy(&tmat1, tempmat1 + i);
  }
コード例 #8
0
ファイル: field_strength.c プロジェクト: andypea/MILC
    FORALLSITES(i,s){
      mult_su3_nn( &LINK(dir1), (su3_matrix *)(gen_pt[1][i]), &tmat1 );
      su3_adjoint( &tmat1, &tmat2 );
      add_su3_matrix( &FIELD_STRENGTH(component), &tmat1,
		      &FIELD_STRENGTH(component) );
      sub_su3_matrix( &FIELD_STRENGTH(component), &tmat2,
		      &FIELD_STRENGTH(component) );
    }
コード例 #9
0
ファイル: density_half.c プロジェクト: erinaldi/milc_qcd
/* do measurements: load density, ploop, etc. and phases onto lattice */
void measure() {
   register int i,j,k, c, is_even;
   register site *s;
   int dx,dy,dz;	/* separation for correlated observables */
   int dir;		/* direction of separation */
   msg_tag *tag;
   register complex cc,dd;	/*scratch*/
   complex ztr, zcof, znum, zdet, TC, zd, density, zphase;
   complex p[4]; /* probabilities of n quarks at a site */
   complex np[4]; /* probabilities at neighbor site */
   complex pp[4][4]; /* joint probabilities of n here and m there */
   complex zplp, plp_even, plp_odd;
   Real locphase, phase;


   /* First make T (= timelike P-loop) from s->ploop_t 
      T stored in s->tempmat1
   */
   ploop_less_slice(nt-1,EVEN);
   ploop_less_slice(nt-1,ODD);

   phase = 0.;
   density = plp_even = plp_odd = cmplx(0.0, 0.0);
   for(j=0;j<4;j++){
	p[j]=cmplx(0.0,0.0);
	for(k=0;k<4;k++)pp[j][k]=cmplx(0.0,0.0);
   }
   FORALLSITES(i,s) {
      if(s->t != nt-1) continue;
      if( ((s->x+s->y+s->z)&0x1)==0 ) is_even=1; else is_even=0;
      mult_su3_nn(&(s->link[TUP]), &(s->ploop_t), &(s->tempmat1));

      zplp = trace_su3(&(s->tempmat1));
      if( is_even){CSUM(plp_even, zplp)}
      else        {CSUM(plp_odd, zplp)}

      ztr = trace_su3(&(s->tempmat1));
      CONJG(ztr, zcof);

      if(is_even){
        for(c=0; c<3; ++c) s->tempmat1.e[c][c].real += C;
        zdet = det_su3(&(s->tempmat1));
        znum = numer(C, ztr, zcof);
        CDIV(znum, zdet, zd);
        CSUM(density, zd);

        /* store n_quark probabilities at this site in lattice variable
	  qprob[], accumulate sum over lattice in p[] */
        cc= cmplx(C*C*C,0.0); CDIV(cc,zdet,s->qprob[0]); CSUM(p[0],s->qprob[0]);
        CMULREAL(ztr,C*C,cc); CDIV(cc,zdet,s->qprob[1]); CSUM(p[1],s->qprob[1]);
        CMULREAL(zcof,C,cc); CDIV(cc,zdet,s->qprob[2]); CSUM(p[2],s->qprob[2]);
        cc = cmplx(1.0,0.0); CDIV(cc,zdet,s->qprob[3]); CSUM(p[3],s->qprob[3]);
  
        locphase = carg(&zdet);
        phase += locphase;
      }

   }
コード例 #10
0
ファイル: stout_smear.c プロジェクト: erinaldi/milc_qcd
void stout_smear(su3_matrix *W, su3_matrix *V, su3_matrix *U)
{

  su3_matrix Q, T;

  get_Q_from_VUadj( &Q, V, U);

  /* T = exp(iQ) */
  exp_iQ( &T, &Q );

  /* W = exp(iQ) U */
  mult_su3_nn( &T, U, W);
}
コード例 #11
0
void update_u( double eps ){

register int i,dir;
register site *s;
su3_matrix *link,temp1,temp2,htemp;
register double t2,t3,t4,t5,t6;
/**TEMP**
double gf_x,gf_av,gf_max;
int gf_i,gf_j;
**END TEMP **/

/**double dtime,dtime2,dclock();**/
/**dtime = -dclock();**/

/* Temporary by-hand optimization until pgcc compiler bug is fixed */
t2 = eps/2.0;
t3 = eps/3.0;
t4 = eps/4.0;
t5 = eps/5.0;
t6 = eps/6.0;

/** TEMP **
gf_av=gf_max=0.0;
**END TEMP**/
    FORALLSITES(i,s){
	for(dir=XUP; dir <=TUP; dir++){
	    uncompress_anti_hermitian( &(s->mom[dir]) , &htemp );
	    link = &(s->link[dir]);
	    mult_su3_nn(&htemp,link,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/6.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t6,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/5.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t5,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/4.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t4,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    /**scalar_mult_add_su3_matrix(link,&temp1,eps/3.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t3,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    /**scalar_mult_add_su3_matrix(link,&temp1,eps/2.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t2,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    scalar_mult_add_su3_matrix(link,&temp1,eps    ,&temp2); 
	    su3mat_copy(&temp2,link);
	}
    }
#ifdef FN
    valid_longlinks=0;
    valid_fatlinks=0;
#endif
/**dtime += dclock();
node0_printf("LINK_UPDATE: time = %e  mflops = %e\n",
dtime, (double)(5616.0*volume/(1.0e6*dtime*numnodes())) );**/
} /* update_u */
コード例 #12
0
ファイル: static_prop.c プロジェクト: erinaldi/milc_qcd
void static_prop() 
{
  register int i;
  register site *st;
  msg_tag *tag;
  int tloop ;
  int nthalf = nt/2 ;
  /*************---------**********-------------************/


  /* Initialise the gauge part of the  propagator  ***/
  setup_static_prop() ;

  /*
   *   Calculate the static propagator for positive time
   *
   *   W(t+1) = W(t) U_4(t)
   */

  for(tloop=1 ; tloop <= nthalf ; ++tloop)
  {

    /* The smear_w_line[0] object is used as work space ***/
    FORALLSITES(i,st)
    {
	mult_su3_nn(&(st->w_line),  &(st->link[TUP]), &(st->smear_w_line[0]));
    }

    /* Pull the w(t)*u(t)  from the previous time slice ***/
    tag=start_gather_site( F_OFFSET(smear_w_line[0]), sizeof(su3_matrix),
		     TDOWN, EVENANDODD, gen_pt[0] );
    wait_gather(tag);

    FORALLSITES(i,st)
    {
     if( st-> t == tloop )  
	su3mat_copy((su3_matrix *) gen_pt[0][i], &(st->w_line));
    }
    cleanup_gather(tag);


		     
  } /* end the loop over time slice ***/
コード例 #13
0
ファイル: stout_smear.c プロジェクト: erinaldi/milc_qcd
void exp_iQ( su3_matrix *T, su3_matrix *Q )
{

  complex f[3];
  su3_matrix QQ;

  mult_su3_nn( Q, Q, &QQ );
  get_fs_from_Qs( f, Q, &QQ );

  /*   f[0] + f[1]*Q + f[2]*QQ */

  clear_su3mat( T );
  T->e[0][0] = f[0];
  T->e[1][1] = f[0];
  T->e[2][2] = f[0];

  c_scalar_mult_add_su3mat( T, Q, &f[1], T );
  c_scalar_mult_add_su3mat( T, &QQ, &f[2], T );
}
コード例 #14
0
ファイル: rand_gauge.c プロジェクト: andypea/MILC
void gauge_trans(field_offset G)
{
  register int i,mu;
  site *s;
  su3_matrix tmp;
  msg_tag *tag[4];

  FORALLUPDIR(mu) 
    tag[mu] = start_gather_site(G,sizeof(su3_matrix),mu,EVENANDODD,
		       gen_pt[mu]);

  FORALLUPDIR(mu) {
    wait_gather(tag[mu]);
    FORALLSITES(i,s) {

       mult_su3_an((su3_matrix *)F_PT(s,G), &(s->link[mu]), &tmp);
       mult_su3_nn(&tmp, (su3_matrix *)gen_pt[mu][i],
		       &(s->link[mu]));

    }
    cleanup_gather(tag[mu]);
  }
コード例 #15
0
ファイル: update_u.c プロジェクト: erinaldi/milc_qcd
void update_u(Real eps) {

register int i,dir;
register site *s;
su3_matrix *link,temp1,temp2,htemp;
register Real t2,t3,t4,t5,t6;

/* Temporary by-hand optimization until pgcc compiler bug is fixed */
t2 = eps/2.0;
t3 = eps/3.0;
t4 = eps/4.0;
t5 = eps/5.0;
t6 = eps/6.0;

 invalidate_fermion_links(fn_links);
    FORALLSITES(i,s){
	for(dir=XUP; dir <=TUP; dir++) if(dir==TUP || s->t>0){
	    uncompress_anti_hermitian( &(s->mom[dir]) , &htemp );
	    link = &(s->link[dir]);
	    mult_su3_nn(&htemp,link,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/6.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t6,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/5.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t5,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
            /**scalar_mult_add_su3_matrix(link,&temp1,eps/4.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t4,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    /**scalar_mult_add_su3_matrix(link,&temp1,eps/3.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t3,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    /**scalar_mult_add_su3_matrix(link,&temp1,eps/2.0,&temp2);**/
scalar_mult_add_su3_matrix(link,&temp1,t2,&temp2);
	    mult_su3_nn(&htemp,&temp2,&temp1);
	    scalar_mult_add_su3_matrix(link,&temp1,eps    ,&temp2); 
	    su3mat_copy(&temp2,link);
	}
    }
} /* update_u */
コード例 #16
0
ファイル: f_mu_nu1.c プロジェクト: erinaldi/milc_qcd
    FORALLSITES(i,s){
	mult_su3_an( (su3_matrix *)(gen_pt[1][i]), &(s->tempmat1),
	    &tmat4 );
	mult_su3_nn( &tmat4, (su3_matrix *)(gen_pt[0][i]),
	    &(s->tempmat2) );
    }
コード例 #17
0
ファイル: staple.c プロジェクト: aacarosso/aacmilc
 // Calculate upper staple, add it
 FORALLSITES(i, s) {
   mult_su3_nn((su3_matrix*)F_PT(s,lnk2), (su3_matrix *)gen_pt[1][i], &tmat1);
   mult_su3_na(&tmat1, (su3_matrix *)gen_pt[0][i], &tmat2);
   add_su3_matrix(stp + i, &tmat2, stp + i);
 }
コード例 #18
0
void d_plaquette_minmax(double *ss_plaq,double *st_plaq,
       double *ss_plaq_min, double *st_plaq_min,
       double *ss_plaq_max, double *st_plaq_max) {
/* su3mat is scratch space of size su3_matrix */
su3_matrix *su3mat;
register int i,dir1,dir2;
register site *s;
register int first_pass_s,first_pass_t;
register su3_matrix *m1,*m4;
su3_matrix mtmp;
double ss_sum,st_sum;
double rtrace_s, rtrace_t, ss_min, st_min, ss_max, st_max;
msg_tag *mtag0,*mtag1;
    ss_sum = st_sum = 0.0;
    first_pass_s=1;
    first_pass_t=1;

    su3mat = (su3_matrix *)malloc(sizeof(su3_matrix)*sites_on_node);
    if(su3mat == NULL)
      {
	printf("plaquette: can't malloc su3mat\n");
	fflush(stdout); terminate(1);
      }

    for(dir1=YUP;dir1<=TUP;dir1++){
	for(dir2=XUP;dir2<dir1;dir2++){

	    mtag0 = start_gather_site( F_OFFSET(link[dir2]), sizeof(su3_matrix),
		dir1, EVENANDODD, gen_pt[0] );
	    mtag1 = start_gather_site( F_OFFSET(link[dir1]), sizeof(su3_matrix),
		dir2, EVENANDODD, gen_pt[1] );

	    FORALLSITES(i,s){
		m1 = &(s->link[dir1]);
		m4 = &(s->link[dir2]);
		mult_su3_an(m4,m1,&su3mat[i]);
	    }

	    wait_gather(mtag0);
	    wait_gather(mtag1);

	    FORALLSITES(i,s){
#ifdef SCHROED_FUN
		if(dir1==TUP ){
		    if(s->t==(nt-1)){
			mult_su3_nn( &su3mat[i],
			    &(s->boundary[dir2]), &mtmp);
		    }
		    else{
			mult_su3_nn( &su3mat[i],
			    (su3_matrix *)(gen_pt[0][i]), &mtmp);
		    }
		    rtrace_t =
			realtrace_su3((su3_matrix *)(gen_pt[1][i]), &mtmp);
		    st_sum += rtrace_t;
		}
		else if(s->t > 0){
		    mult_su3_nn( &su3mat[i], (su3_matrix *)(gen_pt[0][i]),
			&mtmp);
		    rtrace_s =
			realtrace_su3((su3_matrix *)(gen_pt[1][i]), &mtmp);
		    ss_sum += rtrace_s;
		}
#else
		mult_su3_nn( &su3mat[i], (su3_matrix *)(gen_pt[0][i]),
		    &mtmp);

		if(dir1==TUP ) {
                  rtrace_t = (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
                  st_sum += rtrace_t;
                }
		else {
                  rtrace_s = (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
                  ss_sum += rtrace_s;
                }
#endif
//                printf("Plaq i=%d, dir1=%d, dir2=%d: %f %f\n",
//                  i,dir1,dir2,rtrace_s,rtrace_t);
                /* set min and max values on the first pass */
                if( dir1==TUP ) {
                  if( 1==first_pass_t ) {
                    st_min = rtrace_t;
                    st_max = rtrace_t;
                    first_pass_t = 0;
                  }
                  else {
                    if( rtrace_t < st_min ) st_min = rtrace_t;
                    if( rtrace_t > st_max ) st_max = rtrace_t;
                  }
                }
                else {
                  if( 1==first_pass_s ) {
                    ss_min = rtrace_s;
                    ss_max = rtrace_s;
                    first_pass_s = 0;
                  }
                  else {
                    if( rtrace_s < ss_min ) ss_min = rtrace_s;
                    if( rtrace_s > ss_max ) ss_max = rtrace_s;
                  }
                }
	    }

	    cleanup_gather(mtag0);
	    cleanup_gather(mtag1);
	}
    }
コード例 #19
0
ファイル: d_plaq4.c プロジェクト: andypea/MILC
void d_plaquette(double *ss_plaq,double *st_plaq) {
/* su3mat is scratch space of size su3_matrix */
su3_matrix *su3mat;
register int i,dir1,dir2;
register site *s;
register su3_matrix *m1,*m4;
su3_matrix mtmp;
double ss_sum,st_sum;
msg_tag *mtag0,*mtag1;
    ss_sum = st_sum = 0.0;

    su3mat = (su3_matrix *)malloc(sizeof(su3_matrix)*sites_on_node);
    if(su3mat == NULL)
      {
	printf("plaquette: can't malloc su3mat\n");
	fflush(stdout); terminate(1);
      }

    for(dir1=YUP;dir1<=TUP;dir1++){
	for(dir2=XUP;dir2<dir1;dir2++){

	    mtag0 = start_gather_site( F_OFFSET(link[dir2]), sizeof(su3_matrix),
		dir1, EVENANDODD, gen_pt[0] );
	    mtag1 = start_gather_site( F_OFFSET(link[dir1]), sizeof(su3_matrix),
		dir2, EVENANDODD, gen_pt[1] );

	    FORALLSITES(i,s){
		m1 = &(s->link[dir1]);
		m4 = &(s->link[dir2]);
		mult_su3_an(m4,m1,&su3mat[i]);
	    }

	    wait_gather(mtag0);
	    wait_gather(mtag1);

	    FORALLSITES(i,s){
#ifdef SCHROED_FUN
		if(dir1==TUP ){
		    if(s->t==(nt-1)){
			mult_su3_nn( &su3mat[i],
			    &(s->boundary[dir2]), &mtmp);
		    }
		    else{
			mult_su3_nn( &su3mat[i],
			    (su3_matrix *)(gen_pt[0][i]), &mtmp);
		    }
		    st_sum +=
			realtrace_su3((su3_matrix *)(gen_pt[1][i]), &mtmp);
		}
		else if(s->t > 0){
		    mult_su3_nn( &su3mat[i], (su3_matrix *)(gen_pt[0][i]),
			&mtmp);
		    ss_sum +=
			realtrace_su3((su3_matrix *)(gen_pt[1][i]), &mtmp);
		}
#else
		mult_su3_nn( &su3mat[i], (su3_matrix *)(gen_pt[0][i]),
		    &mtmp);

		if(dir1==TUP )st_sum += (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
		else          ss_sum += (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
#endif
	    }

	    cleanup_gather(mtag0);
	    cleanup_gather(mtag1);
	}
    }
コード例 #20
0
ファイル: density.c プロジェクト: erinaldi/milc_qcd
/* do measurements: load density, ploop, etc. and phases onto lattice */
void measure() {
   register int i,j,k, c;
   register site *s;
   int dx,dy,dz;	/* separation for correlated observables */
   int dir;		/* direction of separation */
   msg_tag *tag;
   register complex cc,dd;	/*scratch*/
   complex ztr, zcof, znum, zdet, TC, zd, density, zphase;
   complex p[4]; /* probabilities of n quarks at a site */
   complex np[4]; /* probabilities at neighbor site */
   complex pp[4][4]; /* joint probabilities of n here and m there */
   complex zplp, plp;
   Real locphase, phase;


   /* First make T (= timelike P-loop) from s->ploop_t 
      T stored in s->tempmat1
   */
   ploop_less_slice(nt-1,EVEN);
   ploop_less_slice(nt-1,ODD);

   phase = 0.;
   density = plp = cmplx(0.0, 0.0);
   for(j=0;j<4;j++){
	p[j]=cmplx(0.0,0.0);
	for(k=0;k<4;k++)pp[j][k]=cmplx(0.0,0.0);
   }
   FORALLSITES(i,s) {
      if(s->t != nt-1) continue;
      mult_su3_nn(&(s->link[TUP]), &(s->ploop_t), &(s->tempmat1));

      zplp = trace_su3(&(s->tempmat1));
      CSUM(plp, zplp);

      ztr = trace_su3(&(s->tempmat1));
      CONJG(ztr, zcof);

      for(c=0; c<3; ++c) s->tempmat1.e[c][c].real += C;
      zdet = det_su3(&(s->tempmat1));
      znum = numer(C, ztr, zcof);
      CDIV(znum, zdet, zd);
      CSUM(density, zd);

      /* store n_quark probabilities at this site in lattice variable
	qprob[], accumulate sum over lattice in p[] */
      cc = cmplx(C*C*C,0.0); CDIV(cc,zdet,s->qprob[0]); CSUM(p[0],s->qprob[0]);
      CMULREAL(ztr,C*C,cc); CDIV(cc,zdet,s->qprob[1]); CSUM(p[1],s->qprob[1]);
      CMULREAL(zcof,C,cc); CDIV(cc,zdet,s->qprob[2]); CSUM(p[2],s->qprob[2]);
      cc = cmplx(1.0,0.0); CDIV(cc,zdet,s->qprob[3]); CSUM(p[3],s->qprob[3]);

      locphase = carg(&zdet);
      phase += locphase;

   }
   g_floatsum( &phase );
   g_complexsum( &density );
   g_complexsum( &p[0] );
   g_complexsum( &p[1] );
   g_complexsum( &p[2] );
   g_complexsum( &p[3] );
   g_complexsum( &plp );
   CDIVREAL(density,(Real)(nx*ny*nz),density);
   CDIVREAL(p[0],(Real)(nx*ny*nz),p[0]);
   CDIVREAL(p[1],(Real)(nx*ny*nz),p[1]);
   CDIVREAL(p[2],(Real)(nx*ny*nz),p[2]);
   CDIVREAL(p[3],(Real)(nx*ny*nz),p[3]);
   CDIVREAL(plp,(Real)(nx*ny*nz),plp);

   zphase = ce_itheta(phase);
   if(this_node == 0) {
      printf("ZMES\t%e\t%e\t%e\t%e\t%e\t%e\n", zphase.real, zphase.imag, 
	                               density.real, density.imag,
	                               plp.real, plp.imag);
      printf("PMES\t%e\t%e\t%e\t%e\t%e\t%e\t%e\t%e\n",
				p[0].real, p[0].imag, p[1].real, p[1].imag,
				p[2].real, p[2].imag, p[3].real, p[3].imag );
   }

#ifdef PPCORR
   dx=1; dy=0; dz=0;	/* Temporary - right now we just do nearest neighbor */
   for(dir=XUP;dir<=ZUP;dir++){
      tag = start_gather_site( F_OFFSET(qprob[0]), 4*sizeof(complex), dir,
	   EVENANDODD, gen_pt[0] );
      wait_gather(tag);
      FORALLSITES(i,s)if(s->t==nt-1){
        for(j=0;j<4;j++)for(k=0;k<4;k++){
	   CMUL( (s->qprob)[j],((complex *)gen_pt[0][i])[k],cc);
           CSUM(pp[j][k],cc);
        }
      }
      cleanup_gather(tag);
   }

   /* density correlation format:
	PP dx dy dz n1 n2 real imag */
   for(j=0;j<4;j++)for(k=0;k<4;k++){
     g_complexsum( &pp[j][k] );
     CDIVREAL(pp[j][k],(Real)(3*nx*ny*nz),pp[j][k]);
     if(this_node==0)
       printf("PP %d %d %d   %d %d   %e   %e\n",dx,dy,dz,j,k,
	  pp[j][k].real,pp[j][k].imag);
   }
#endif /*PPCORR*/
}
コード例 #21
0
ファイル: stout_smear.c プロジェクト: erinaldi/milc_qcd
/* Get the coefficients f of the expansion of exp(iQ)                   */
static void 
get_fs_from_Qs( complex f[3], su3_matrix *Q, su3_matrix *QQ){

  su3_matrix QQQ;
  Real trQQQ, trQQ, c0, c1;
  Real c0abs, c0max, theta;
  Real eps, sqtwo = sqrt(2.);
  Real u, w, u_sq, w_sq, xi0;
  Real cosu, sinu, cosw, sin2u, cos2u, ucosu, usinu, ucos2u, usin2u;
  Real denom, subexp1, subexp2, subexp3, subexp;

  mult_su3_nn ( Q, QQ, &QQQ );

  trQQ  = (trace_su3( QQ )).real;
  trQQQ = (trace_su3( &QQQ )).real;

  c0 = 1./3. * trQQQ;
  c1 = 1./2. * trQQ;

  if( c1 < 4.0e-3  )
    { // RGE: set to 4.0e-3 (CM uses this value). I ran into nans with 1.0e-4
      // =======================================================================
      //
      // Corner Case 1: if c1 < 1.0e-4 this implies c0max ~ 3x10^-7
      //    and in this case the division c0/c0max in arccos c0/c0max can be undefined
      //    and produce NaN's

      // In this case what we can do is get the f-s a different way. We go back to basics:
      //
      // We solve (using maple) the matrix equations using the eigenvalues
      //
      //  [ 1, q_1, q_1^2 ] [ f_0 ]       [ exp( iq_1 ) ]
      //  [ 1, q_2, q_2^2 ] [ f_1 ]   =   [ exp( iq_2 ) ]
      //  [ 1, q_3, q_3^2 ] [ f_2 ]       [ exp( iq_3 ) ]
      //
      // with q_1 = 2 u w, q_2 = -u + w, q_3 = - u - w
      //
      // with u and w defined as  u = sqrt( c_1/ 3 ) cos (theta/3)
      //                     and  w = sqrt( c_1 ) sin (theta/3)
      //                          theta = arccos ( c0 / c0max )
      // leaving c0max as a symbol.
      //
      //  we then expand the resulting f_i as a series around c0 = 0 and c1 = 0
      //  and then substitute in c0max = 2 ( c_1/ 3)^(3/2)
      //
      //  we then convert the results to polynomials and take the real and imaginary parts:
      //  we get at the end of the day (to low order)

      //                  1    2
      //   f0[re] := 1 - --- c0  + h.o.t
      //                 720     
      //
      //               1       1           1        2
      //   f0[im] := - - c0 + --- c0 c1 - ---- c0 c1   + h.o.t
      //               6      120         5040       
      //
      //
      //             1        1            1        2
      //   f1[re] := -- c0 - --- c0 c1 + ----- c0 c1  +  h.o.t
      //             24      360         13440        f
      //
      //                 1       1    2    1     3    1     2
      //   f1[im] := 1 - - c1 + --- c1  - ---- c1  - ---- c0   + h.o.t
      //                 6      120       5040       5040
      //
      //               1   1        1    2     1     3     1     2
      //   f2[re] := - - + -- c1 - --- c1  + ----- c1  + ----- c0  + h.o.t
      //               2   24      720       40320       40320   
      //
      //              1        1              1        2
      //   f2[im] := --- c0 - ---- c0 c1 + ------ c0 c1  + h.o.t
      //             120      2520         120960

      //  We then express these using Horner's rule for more stable evaluation.
      //
      //  =====================================================================

      f[0].real = 1. - c0*c0/720.;
      f[0].imag = -(c0/6.)*(1. - (c1/20.)*(1. - (c1/42.))) ;

      f[1].real =  c0/24.*(1. - c1/15.*(1. - 3.*c1/112.)) ;
      f[1].imag =  1.-c1/6.*(1. - c1/20.*(1. - c1/42.)) - c0*c0/5040. ;

      f[2].real = 0.5*(-1. + c1/12.*(1. - c1/30.*(1. - c1/56.)) + c0*c0/20160.);
      f[2].imag = 0.5*(c0/60.*(1. - c1/21.*(1. - c1/48.)));

    }
  else
    {
      // =======================================================================
      // Normal case: Do as per Morningstar-Peardon paper
      // =======================================================================

      c0abs = fabs( c0 );
      c0max = 2*pow( c1/3., 1.5);

      // =======================================================================
      // Now work out theta. In the paper the case where c0 -> c0max even when c1 is reasonable
      // Has never been considered, even though it can arise and can cause the arccos function
      // to fail
      // Here we handle it with series expansion
      // =======================================================================
      eps = (c0max - c0abs)/c0max;

      if( eps < 0 ) {
        // =====================================================================
        // Corner Case 2: Handle case when c0abs is bigger than c0max.
        // This can happen only when there is a rounding error in the ratio, and that the
        // ratio is really 1. This implies theta = 0 which we'll just set.
        // =====================================================================
        theta = 0;
      }
      else if ( eps < 1.0e-3 ) {
        // =====================================================================
        // Corner Case 3: c0->c0max even though c1 may be actually quite reasonable.
        // The ratio |c0|/c0max -> 1 but is still less than one, so that a
        // series expansion is possible.
        // SERIES of acos(1-epsilon): Good to O(eps^6) or with this cutoff to O(10^{-18}) Computed with Maple.
        //  BTW: 1-epsilon = 1 - (c0max-c0abs)/c0max = 1-(1 - c0abs/c0max) = +c0abs/c0max
        //
        // ======================================================================
        theta = sqtwo*sqrt(eps)*( 1 + ( (1./12.) + ( (3./160.) + ( (5./896.) + ( (35./18432.) + (63./90112.)*eps ) *eps) *eps) *eps) *eps);
      }
      else {
        theta = acos( c0abs/c0max );
      }

      u = sqrt(c1/3.)*cos(theta/3.);
      w = sqrt(c1)*sin(theta/3.);

      u_sq = u*u;
      w_sq = w*w;

      if( fabs(w) < 0.05 ) {
        xi0 = 1. - (1./6.)*w_sq*( 1. - (1./20.)*w_sq*( 1. - (1./42.)*w_sq ) );
      }
      else {
        xi0 = sin(w)/w;
      }

      cosu = cos(u);
      sinu = sin(u);
      cosw = cos(w);
      sin2u = sin(2*u);
      cos2u = cos(2*u);
      ucosu = u*cosu;
      usinu = u*sinu;
      ucos2u = u*cos2u;
      usin2u = u*sin2u;

      denom = 9.*u_sq - w_sq;

      subexp1 = u_sq - w_sq;
      subexp2 = 8*u_sq*cosw;
      subexp3 = (3*u_sq + w_sq)*xi0;

      f[0].real = ( (subexp1)*cos2u + cosu*subexp2 + 2*usinu*subexp3 ) / denom ;
      f[0].imag = ( (subexp1)*sin2u - sinu*subexp2 + 2*ucosu*subexp3 ) / denom ;

      subexp = (3*u_sq -w_sq)*xi0;

      f[1].real = (2*(ucos2u - ucosu*cosw)+subexp*sinu)/denom;
      f[1].imag = (2*(usin2u + usinu*cosw)+subexp*cosu)/denom;

      subexp=3*xi0;

      f[2].real = (cos2u - cosu*cosw -usinu*subexp) /denom ;
      f[2].imag = (sin2u + sinu*cosw -ucosu*subexp) /denom ;

      if( c0 < 0 ) {

        // f[0] = conj(f[0]);
        f[0].imag *= -1;
       
        //f[1] = -conj(f[1]);
        f[1].real *= -1;
       
        //f[2] = conj(f[2]);
        f[2].imag *= -1;

      }
    } // End of if( corner_caseP ) else {}
}
コード例 #22
0
ファイル: d_plaq4_field_hist.c プロジェクト: andypea/MILC
void d_plaquette_field_hist(su3_matrix **U_field,
                      int Npowers, int *Nhist, double **hist,
                      double **hist_bounds,
                      double *ss_plaq, double *st_plaq) {
/* su3mat is scratch space of size su3_matrix */
su3_matrix *su3mat;
register int i,dir1,dir2;
register int ipower,ihist;
register site *s;
register su3_matrix *m1,*m4;
double *plaq_power, *step_hist;
su3_matrix mtmp;
double ss_sum,st_sum;
double rtrace, rtrace3;
msg_tag *mtag0,*mtag1;
    ss_sum = st_sum = 0.0;
#ifdef HISQ_DUMP_PLAQ_INTO_FILE
FILE *fp;
char plaq_file_name[300];
#endif /* HISQ_DUMP_PLAQ_INTO_FILE */

    su3mat = (su3_matrix *)malloc(sizeof(su3_matrix)*sites_on_node);
    if(su3mat == NULL)
      {
	printf("plaquette: can't malloc su3mat\n");
	fflush(stdout); terminate(1);
      }

    /* zero out the histogram */
    for(ipower=0;ipower<Npowers;ipower++) {
      for(ihist=0;ihist<Nhist[ipower];ihist++) {
        hist[ipower][ihist]=0.0;
      }
    }

    /* array with powers of (3-plaquette) */
    plaq_power=(double*)malloc(sizeof(double)*Npowers);

    /* array with step sizes */
    step_hist=(double*)malloc(sizeof(double)*Npowers);
    for(ipower=0;ipower<Npowers;ipower++) {
      step_hist[ipower]=
        (hist_bounds[ipower][1]-hist_bounds[ipower][0])/Nhist[ipower];
    }

#ifdef HISQ_DUMP_PLAQ_INTO_FILE
    sprintf( plaq_file_name, "plaq_W_node%04d.dat", this_node );
    fp = fopen( plaq_file_name, "wt" );
#endif /* HISQ_DUMP_PLAQ_INTO_FILE */


    for(dir1=YUP;dir1<=TUP;dir1++){
	for(dir2=XUP;dir2<dir1;dir2++){

	    mtag0 = start_gather_field( U_field[dir2], sizeof(su3_matrix),
		dir1, EVENANDODD, gen_pt[0] );
	    mtag1 = start_gather_field( U_field[dir1], sizeof(su3_matrix),
		dir2, EVENANDODD, gen_pt[1] );

	    FORALLSITES(i,s){
		m1 = &(U_field[dir1][i]);
		m4 = &(U_field[dir2][i]);
		mult_su3_an(m4,m1,&su3mat[i]);
	    }

	    wait_gather(mtag0);
	    wait_gather(mtag1);

	    FORALLSITES(i,s){
		mult_su3_nn( &su3mat[i], (su3_matrix *)(gen_pt[0][i]),
		    &mtmp);

		if(dir1==TUP ) {
                  rtrace = (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
                  st_sum += rtrace;
                }
		else {
                  rtrace = (double)
		    realtrace_su3((su3_matrix *)(gen_pt[1][i]),&mtmp);
                  ss_sum += rtrace;
                }
//                printf("Plaq i=%d, dir1=%d, dir2=%d: %f %f\n",
//                  i,dir1,dir2,rtrace_s,rtrace_t);
#ifdef HISQ_DUMP_PLAQ_INTO_FILE
                fprintf( fp, "%18.12g\n", rtrace );
#endif /* HISQ_DUMP_PLAQ_INTO_FILE */
                /* powers of (3-plaquette) */
                rtrace3=3.0-rtrace;
                plaq_power[0]=rtrace3;
                for(ipower=1;ipower<Npowers;ipower++) {
                  plaq_power[ipower]=plaq_power[ipower-1]*rtrace3;
                }
                /* find histogram entry */
                for(ipower=0;ipower<Npowers;ipower++) {
                  if( (plaq_power[ipower]>hist_bounds[ipower][0])
                   && (plaq_power[ipower]<hist_bounds[ipower][1]) ) {
                    ihist=(int)(
                      (plaq_power[ipower]-hist_bounds[ipower][0])/
                      step_hist[ipower] );
                    hist[ipower][ihist]+=1.0;
                  }
                }
            }

            cleanup_gather(mtag0);
	    cleanup_gather(mtag1);
	}
コード例 #23
0
ファイル: stout_smear_utilities.c プロジェクト: andypea/MILC
static void 
get_fs_and_bs_from_Qs( complex f[3], complex b1[3], complex b2[3], 
		       su3_matrix *Q, su3_matrix *QQ, int do_bs )
{

  su3_matrix QQQ;
  Real trQQQ, trQQ, c0, c1;
  Real c0abs, c0max, theta;
  Real eps, sqtwo = sqrt(2.);
  Real u, w, u_sq, w_sq, xi0, xi1;
  Real cosu, sinu, cosw, sinw, sin2u, cos2u, ucosu, usinu, ucos2u, usin2u;
  Real denom;

  Real r_1_re[3], r_1_im[3], r_2_re[3], r_2_im[3];
  Real b_denom;

  mult_su3_nn ( Q, QQ, &QQQ );

  trQQ  = (trace_su3( QQ )).real;
  trQQQ = (trace_su3( &QQQ )).real;

  c0 = 1./3. * trQQQ;
  c1 = 1./2. * trQQ;
  
  if( c1 < 4.0e-3  ) 
    { // RGE: set to 4.0e-3 (CM uses this value). I ran into nans with 1.0e-4
      // =======================================================================
      // 
      // Corner Case 1: if c1 < 1.0e-4 this implies c0max ~ 3x10^-7
      //    and in this case the division c0/c0max in arccos c0/c0max can be undefined
      //    and produce NaN's
      
      // In this case what we can do is get the f-s a different way. We go back to basics:
      //
      // We solve (using maple) the matrix equations using the eigenvalues 
      //
      //  [ 1, q_1, q_1^2 ] [ f_0 ]       [ exp( iq_1 ) ]
      //  [ 1, q_2, q_2^2 ] [ f_1 ]   =   [ exp( iq_2 ) ]
      //  [ 1, q_3, q_3^2 ] [ f_2 ]       [ exp( iq_3 ) ]
      //
      // with q_1 = 2 u w, q_2 = -u + w, q_3 = - u - w
      // 
      // with u and w defined as  u = sqrt( c_1/ 3 ) cos (theta/3)
      //                     and  w = sqrt( c_1 ) sin (theta/3)
      //                          theta = arccos ( c0 / c0max )
      // leaving c0max as a symbol.
      //
      //  we then expand the resulting f_i as a series around c0 = 0 and c1 = 0
      //  and then substitute in c0max = 2 ( c_1/ 3)^(3/2)
      //  
      //  we then convert the results to polynomials and take the real and imaginary parts:
      //  we get at the end of the day (to low order)
      
      //                  1    2 
      //   f0[re] := 1 - --- c0  + h.o.t
      //                 720     
      //
      //               1       1           1        2 
      //   f0[im] := - - c0 + --- c0 c1 - ---- c0 c1   + h.o.t
      //               6      120         5040        
      //
      //
      //              1        1            1        2 
      //   f1[re] := -- c0 - --- c0 c1 + ----- c0 c1  +  h.o.t
      //             24      360         13440        f
      //
      //                 1       1    2    1     3    1     2
      //   f1[im] := 1 - - c1 + --- c1  - ---- c1  - ---- c0   + h.o.t
      //                 6      120       5040       5040
      //
      //               1   1        1    2     1     3     1     2
      //   f2[re] := - - + -- c1 - --- c1  + ----- c1  + ----- c0  + h.o.t
      //               2   24      720       40320       40320    
      //
      //              1        1              1        2
      //   f2[im] := --- c0 - ---- c0 c1 + ------ c0 c1  + h.o.t
      //             120      2520         120960
      
      //  We then express these using Horner's rule for more stable evaluation.
      // 
      //  to get the b-s we use the fact that
      //                                      b2_i = d f_i / d c0
      //                                 and  b1_i = d f_i / d c1
      //
      //  where the derivatives are partial derivatives
      //
      //  And we just differentiate the polynomials above (keeping the same level
      //  of truncation) and reexpress that as Horner's rule
      // 
      //  This clearly also handles the case of a unit gauge as no c1, u etc appears in the 
      //  denominator and the arccos is never taken. In this case, we have the results in 
      //  the raw c0, c1 form and we don't need to flip signs and take complex conjugates.
      //
      //  (not CD) I checked the expressions below by taking the difference between the Horner forms
      //  below from the expanded forms (and their derivatives) above and checking for the
      //  differences to be zero. At this point in time maple seems happy.
      //  ==================================================================
          
      f[0].real = 1. - c0*c0/720.;
      f[0].imag = -(c0/6.)*(1. - (c1/20.)*(1. - (c1/42.))) ;
      
      f[1].real =  c0/24.*(1. - c1/15.*(1. - 3.*c1/112.)) ;
      f[1].imag =  1.-c1/6.*(1. - c1/20.*(1. - c1/42.)) - c0*c0/5040. ;
      
      f[2].real = 0.5*(-1. + c1/12.*(1. - c1/30.*(1. - c1/56.)) + c0*c0/20160.);
      f[2].imag = 0.5*(c0/60.*(1. - c1/21.*(1. - c1/48.)));
      
      if( do_bs ) {
	//  partial f0/ partial c0
	b2[0].real = -c0/360.;
	b2[0].imag =  -(1./6.)*(1.-(c1/20.)*(1.-c1/42.));
        
	// partial f0 / partial c1
	//
	b1[0].real = 0;
	b1[0].imag = (c0/120.)*(1.-c1/21.);
        
	// partial f1 / partial c0
	//
	b2[1].real = (1./24.)*(1.-c1/15.*(1.-3.*c1/112.));
	b2[1].imag = -c0/2520.;
	
        
	// partial f1 / partial c1
	b1[1].real = -c0/360.*(1. - 3.*c1/56. );
	b1[1].imag = -1./6.*(1.-c1/10.*(1.-c1/28.));
        
	// partial f2/ partial c0
	b2[2].real = 0.5*c0/10080.;
	b2[2].imag = 0.5*(  1./60.*(1.-c1/21.*(1.-c1/48.)) );
        
	// partial f2/ partial c1
	b1[2].real = 0.5*(  1./12.*(1.-(2.*c1/30.)*(1.-3.*c1/112.)) ); 
	b1[2].imag = 0.5*( -c0/1260.*(1.-c1/24.) );
        
      } // do_bs
    }
  else 
    { 
      // =======================================================================
      // Normal case: Do as per Morningstar-Peardon paper
      // =======================================================================

      c0abs = fabs( c0 );
      c0max = 2*pow( c1/3., 1.5);
      
      // =======================================================================
      // Now work out theta. In the paper the case where c0 -> c0max even when c1 is reasonable 
      // Has never been considered, even though it can arise and can cause the arccos function
      // to fail
      // Here we handle it with series expansion
      // =======================================================================
      eps = (c0max - c0abs)/c0max;
      
      if( eps < 0 ) {
	// =====================================================================
	// Corner Case 2: Handle case when c0abs is bigger than c0max. 
	// This can happen only when there is a rounding error in the ratio, and that the 
	// ratio is really 1. This implies theta = 0 which we'll just set.
	// =====================================================================
	theta = 0;
      }
      else if ( eps < 1.0e-3 ) {
	// =====================================================================
	// Corner Case 3: c0->c0max even though c1 may be actually quite reasonable.
	// The ratio |c0|/c0max -> 1 but is still less than one, so that a 
	// series expansion is possible.
	// SERIES of acos(1-epsilon): Good to O(eps^6) or with this cutoff to O(10^{-18}) Computed with Maple.
	//  BTW: 1-epsilon = 1 - (c0max-c0abs)/c0max = 1-(1 - c0abs/c0max) = +c0abs/c0max
	//
	// ======================================================================
	theta = sqtwo*sqrt(eps)*( 1 + ( (1./12.) + ( (3./160.) + ( (5./896.) + ( (35./18432.) + (63./90112.)*eps ) *eps) *eps) *eps) *eps);
      } 
      else {  
	// 
	theta = acos( c0abs/c0max );
      }
          
      u = sqrt(c1/3.)*cos(theta/3.);
      w = sqrt(c1)*sin(theta/3.);
      
      u_sq = u*u;
      w_sq = w*w;

      if( fabs(w) < 0.05 ) { 
	xi0 = 1. - (1./6.)*w_sq*( 1. - (1./20.)*w_sq*( 1. - (1./42.)*w_sq ) );
      }
      else {
	xi0 = sin(w)/w;
      }
      
      if( do_bs) {
	
	if( fabs(w) < 0.05 ) { 
	  xi1 = -( 1./3. - (1./30.)*w_sq*( 1. - (1./28.)*w_sq*( 1. - (1./54.)*w_sq ) ) );
	}
	else { 
	  xi1 = cos(w)/w_sq - sin(w)/(w_sq*w);
	}
      }

      cosu = cos(u);
      sinu = sin(u);
      cosw = cos(w);
      sinw = sin(w);
      sin2u = sin(2*u);
      cos2u = cos(2*u);
      ucosu = u*cosu;
      usinu = u*sinu;
      ucos2u = u*cos2u;
      usin2u = u*sin2u;
      
      denom = 9.*u_sq - w_sq;

      {
	Real subexp1, subexp2, subexp3;

	subexp1 = u_sq - w_sq;
	subexp2 = 8*u_sq*cosw;
	subexp3 = (3*u_sq + w_sq)*xi0;
	
	f[0].real = ( (subexp1)*cos2u + cosu*subexp2 + 2*usinu*subexp3 ) / denom ;
	f[0].imag = ( (subexp1)*sin2u - sinu*subexp2 + 2*ucosu*subexp3 ) / denom ;

      }
      {
	Real subexp;
	
	subexp = (3*u_sq -w_sq)*xi0;
	
	f[1].real = (2*(ucos2u - ucosu*cosw)+subexp*sinu)/denom;
	f[1].imag = (2*(usin2u + usinu*cosw)+subexp*cosu)/denom;
      }
      {
	Real subexp;

	subexp=3*xi0;
      
	f[2].real = (cos2u - cosu*cosw -usinu*subexp) /denom ;
	f[2].imag = (sin2u + sinu*cosw -ucosu*subexp) /denom ;
      }

      if( do_bs )
	{
	  {
	      Real subexp1, subexp2, subexp3;
	      //          r_1[0]=Double(2)*cmplx(u, u_sq-w_sq)*exp2iu
	      //          + 2.0*expmiu*( cmplx(8.0*u*cosw, -4.0*u_sq*cosw)
	      //              + cmplx(u*(3.0*u_sq+w_sq),9.0*u_sq+w_sq)*xi0 );
	      
	      subexp1 = u_sq - w_sq;
	      subexp2 = 8.*cosw + (3.*u_sq + w_sq)*xi0 ;
	      subexp3 = 4.*u_sq*cosw - (9.*u_sq + w_sq)*xi0 ;
	      
	      r_1_re[0] = 2.*(ucos2u - sin2u *(subexp1)+ucosu*( subexp2 )- sinu*( subexp3 ) );
	      r_1_im[0] = 2.*(usin2u + cos2u *(subexp1)-usinu*( subexp2 )- cosu*( subexp3 ) );
	      
	  }
	  {
	      Real subexp1, subexp2;

	      // r_1[1]=cmplx(2.0, 4.0*u)*exp2iu + expmiu*cmplx(-2.0*cosw-(w_sq-3.0*u_sq)*xi0,2.0*u*cosw+6.0*u*xi0);
	      
	      subexp1 = cosw+3.*xi0;
	      subexp2 = 2.*cosw + xi0*(w_sq - 3.*u_sq);
	      
	      r_1_re[1] = 2.*((cos2u - 2.*usin2u) + usinu*subexp1) - cosu*subexp2;
	      r_1_im[1] = 2.*((sin2u + 2.*ucos2u) + ucosu*subexp1) + sinu*subexp2;
          }
	  {
	    Real subexp;
	    // r_1[2]=2.0*timesI(exp2iu)  +expmiu*cmplx(-3.0*u*xi0, cosw-3*xi0);
	    
	    subexp = cosw - 3.*xi0;
	    r_1_re[2] = -2.*sin2u -3.*ucosu*xi0 + sinu*subexp;
	    r_1_im[2] = 2.*cos2u  +3.*usinu*xi0 + cosu*subexp;
	  }
          
	  {
	    Real subexp;
	    //r_2[0]=-2.0*exp2iu + 2*cmplx(0,u)*expmiu*cmplx(cosw+xi0+3*u_sq*xi1,
	    //                                                 4*u*xi0);
	    
	    subexp = cosw + xi0 + 3.*u_sq*xi1;
	    r_2_re[0] = -2.*(cos2u + u*( 4.*ucosu*xi0 - sinu*subexp) );
	    r_2_im[0] = -2.*(sin2u - u*( 4.*usinu*xi0 + cosu*subexp) );
	  }
	  {
	    Real subexp;
          
	    // r_2[1]= expmiu*cmplx(cosw+xi0-3.0*u_sq*xi1, 2.0*u*xi0);
	    // r_2[1] = timesMinusI(r_2[1]);
	    
	    subexp =  cosw + xi0 - 3.*u_sq*xi1;
	    r_2_re[1] =  2.*ucosu*xi0 - sinu*subexp;
	    r_2_im[1] = -2.*usinu*xi0 - cosu*subexp;
	    
	  }
	  {
	    Real subexp;
	    //r_2[2]=expmiu*cmplx(xi0, -3.0*u*xi1);
	    
	    subexp = 3.*xi1;
            
	    r_2_re[2] =    cosu*xi0 - usinu*subexp ;
	    r_2_im[2] = -( sinu*xi0 + ucosu*subexp ) ;
	  }
          
	  b_denom=2.*denom*denom;
          
	  {
	    Real subexp1, subexp2, subexp3;
	    int j;

	    subexp1 = 2.*u;
	    subexp2 = 3.*u_sq - w_sq;
	    subexp3 = 2.*(15.*u_sq + w_sq);
	    
	    for(j=0; j < 3; j++) { 
	      
	      b1[j].real=( subexp1*r_1_re[j] + subexp2*r_2_re[j] - subexp3*f[j].real )/b_denom;
	      b1[j].imag=( subexp1*r_1_im[j] + subexp2*r_2_im[j] - subexp3*f[j].imag )/b_denom;
	    }
	  }
	  {
	    Real subexp1, subexp2;
	    int j;
	    
	    subexp1 = 3.*u;
	    subexp2 = 24.*u;
	    
	    for(j=0; j < 3; j++) { 
	      b2[j].real=( r_1_re[j] - subexp1*r_2_re[j] - subexp2 * f[j].real )/b_denom;
	      b2[j].imag=( r_1_im[j] - subexp1*r_2_im[j] - subexp2 * f[j].imag )/b_denom;
	    }
	  }
	  
	  // Now flip the coefficients of the b-s
	  if( c0 < 0 ) 
	    {
	      //b1_site[0] = conj(b1_site[0]);
	      b1[0].imag *= -1;
	      
	      //b1_site[1] = -conj(b1_site[1]);
	      b1[1].real *= -1;
	      
	      //b1_site[2] = conj(b1_site[2]);
	      b1[2].imag *= -1;
	      
	      //b2_site[0] = -conj(b2_site[0]);
	      b2[0].real *= -1;
	      
	      //b2_site[1] = conj(b2_site[1]);
	      b2[1].imag *= -1;
	      
	      //b2_site[2] = -conj(b2_site[2]);
	      b2[2].real *= -1;
	    }
	} // end of if (do_bs)
      
      // Now when everything is done flip signs of the b-s (can't do this before
      // as the unflipped f-s are needed to find the b-s
      
      if( c0 < 0 ) {
	
	// f[0] = conj(f[0]);
	f[0].imag *= -1;
        
	//f[1] = -conj(f[1]);
	f[1].real *= -1;
        
	//f[2] = conj(f[2]);
	f[2].imag *= -1;
        
      }
    } // End of if( corner_caseP ) else {}
}
コード例 #24
0
ファイル: field_strength.c プロジェクト: andypea/MILC
 FORALLSITES(i,s){
   mult_su3_nn( (su3_matrix *)(gen_pt[0][i]), &LINK(dir1), &temp1[i] );
   mult_su3_nn( (su3_matrix *)(gen_pt[1][i]), &LINK(dir0), &temp2[i] );
 }
コード例 #25
0
ファイル: f_mu_nu1.c プロジェクト: erinaldi/milc_qcd
 /* Now make +mu +nu plaquette and put in f_mn */
 FORALLSITES(i,s){
     mult_su3_nn( &(s->link[mu]), ((su3_matrix *)F_PT(s,f_mn)), &tmat4 );
     mult_su3_na( &tmat4, &(s->link[nu]), ((su3_matrix *)F_PT(s,f_mn)) );
 }
コード例 #26
0
ファイル: field_strength.c プロジェクト: andypea/MILC
 FORALLSITES(i,s){
   mult_su3_an( &LINK(dir1), &LINK(dir0), &tmat1);
   mult_su3_nn( &tmat1, (su3_matrix *)(gen_pt[1][i]), &temp1[i] );
 }
コード例 #27
0
ファイル: fermion_links_hyp.c プロジェクト: erinaldi/milc_qcd
/* compute wiggly links in direction dir1 decorated in direction dir2 */
void hyp_block_stage1(register int dir1, register int dir2, int parity,
  su3_matrix *U_link, su3_matrix *Wiggly_link, int dir_exclude,
  hyp_coeffs_t *hc ) {

  register int i;
  register site *st;
  msg_tag *tag0,*tag1,*tag2,*tag3,*tag4;
  int start;
  register int count,nWiggly;
  su3_matrix tmat1,tmat2,fatq;
  su3_matrix *tempmat1;
  int disp[4];	/* displacement vector for general gather */

  /* create temporary storage, one matrix per site */
  tempmat1 = create_mn_special(1);

  start=1; /* indicates staple sum not initialized */

  // array size is fixed for 4D, in 3D not all entries are filled
  nWiggly = 12;

  count=3*dir1+dir2;
  if(dir2>dir1)count=count-1; 

  /* displacement vector for link 2 sites away */
  for(i=XUP;i<=TUP;i++)disp[i]=0;
  disp[dir1] = 1;
  disp[dir2] = -1;
  
  /* get U_link[dir2] from direction dir1 */
  tag0 = declare_strided_gather( U_link + dir2, 4*sizeof(su3_matrix),
           sizeof(su3_matrix), dir1, parity, gen_pt[0] );
  do_gather( tag0 );
  
  /* get U_link[dir1] from direction dir2 */
  tag1 = declare_strided_gather( U_link + dir1, 4*sizeof(su3_matrix),
           sizeof(su3_matrix), dir2, parity, gen_pt[1] );
  do_gather( tag1 );
  
  /* get U_link[dir2] from direction -dir2 */
  tag2 = declare_strided_gather( U_link + dir2, 4*sizeof(su3_matrix),
           sizeof(su3_matrix), OPP_DIR(dir2), parity, gen_pt[2] );
  do_gather( tag2 );
  
  /* get U_link[dir1] from direction -dir2 */
  tag3 = declare_strided_gather( U_link + dir1, 4*sizeof(su3_matrix),
           sizeof(su3_matrix), OPP_DIR(dir2), parity, gen_pt[3] );
  do_gather( tag3 );
  
  /* get U_link[dir2] from displacement +dir1-dir2 */
  tag4 = start_general_strided_gather( (char *)(U_link + dir2), 4*sizeof(su3_matrix),
           sizeof(su3_matrix), disp, parity, gen_pt[4] );

  /* Upper staple */
  wait_gather(tag0);
  wait_gather(tag1);
  if(start){  /* this is the first contribution to staple */
    FORSOMEPARITY(i,st,parity){
      mult_su3_nn( &(U_link[4*i+dir2]), (su3_matrix *)gen_pt[1][i], &tmat1 );
      mult_su3_na( &tmat1, (su3_matrix *)gen_pt[0][i], &(tempmat1[i]) );
      
    }
    start=0; 
  }
コード例 #28
0
ファイル: field_strength.c プロジェクト: andypea/MILC
void make_field_strength(
  field_offset link_src,       /* field offset for su3_matrix[4] type 
				  for the source link matrices */
  field_offset field_dest      /* field offset for su3_matrix[6] type
				  for the resulting field strength */
  )
{
  register int i,component,dir0=-99,dir1=-99;
  register site *s;
  int j;
  su3_matrix tmat1,tmat2;
  su3_matrix *temp1,*temp2;
  complex cc;
  msg_tag *mtag0,*mtag1;
  
  /* Allocate temporary space for two su3_matrix fields */
  temp1 = (su3_matrix *)malloc(sites_on_node*sizeof(su3_matrix));
  if(temp1 == NULL){
    printf("field_strength: No room for temp1\n");
    terminate(1);
  }
  
  temp2 = (su3_matrix *)malloc(sites_on_node*sizeof(su3_matrix));
  if(temp2 == NULL){
    printf("field_strength: No room for temp2\n");
    terminate(1);
  }
  
  for(component=FS_XY;component<=FS_ZT;component++){
    switch(component){
    case FS_XY: dir0=XUP; dir1=YUP; break;
    case FS_XZ: dir0=XUP; dir1=ZUP; break;
    case FS_YZ: dir0=YUP; dir1=ZUP; break;
    case FS_XT: dir0=XUP; dir1=TUP; break;
    case FS_YT: dir0=YUP; dir1=TUP; break;
    case FS_ZT: dir0=ZUP; dir1=TUP; break;
    }
    
    /* Plaquette in +dir0 +dir1 direction */
    mtag0 = start_gather_site( LINK_OFFSET(dir0), sizeof(su3_matrix),
			  dir1, EVENANDODD, gen_pt[0] );
    mtag1 = start_gather_site( LINK_OFFSET(dir1), sizeof(su3_matrix),
			  dir0, EVENANDODD, gen_pt[1] );
    
    wait_gather(mtag0);
    wait_gather(mtag1);
    FORALLSITES(i,s){
      mult_su3_nn( &LINK(dir0), 
		   (su3_matrix *)(gen_pt[1][i]), &tmat1 );
      mult_su3_na( &tmat1, (su3_matrix *)(gen_pt[0][i]), &tmat2 );
      mult_su3_na( &tmat2, &LINK(dir1), &tmat1 );
      su3_adjoint( &tmat1, &tmat2 );
      sub_su3_matrix(  &tmat1, &tmat2, &FIELD_STRENGTH(component) );
    }
    
    /**cleanup_gather(mtag0);   Use same gather in next plaquette**/
    cleanup_gather(mtag1);
    
    /* Plaquette in -dir0 +dir1 direction */
    /**mtag0 = start_gather_site( LINK_OFFSET(dir0), 
       sizeof(su3_matrix), dir1, EVENANDODD, gen_pt[0] );
       wait_gather(mtag0);  Already gathered above**/
    
    FORALLSITES(i,s){
      mult_su3_an( &LINK(dir1), 
		   &LINK(dir0), &tmat1 );
      mult_su3_an( (su3_matrix *)(gen_pt[0][i]), &tmat1, &temp1[i] );
    }
コード例 #29
0
ファイル: stout_smear_utilities.c プロジェクト: andypea/MILC
void stout_force_terms(su3_matrix *force_diag, su3_matrix *ILambda, 
		       su3_matrix *V, su3_matrix *U, su3_matrix *force_W)
{
  su3_matrix Q, QQ, USigp;
  su3_matrix Gamma;
  complex f[3], b1[3], b2[3];
  complex plusI = cmplx(0.,1.);
  int do_bs = 1;
  

  get_Q_from_VUadj( &Q, V, U);
  mult_su3_nn( &Q, &Q, &QQ );

  get_fs_and_bs_from_Qs( f, b1, b2, &Q, &QQ, do_bs);

  {
    int i, j;
    printf("Result Q\n");
    
    for(i = 0; i < 3; i++){
      for(j = 0; j < 3; j++)
	printf("%f + %f*I, ",Q.e[i][j].real, Q.e[i][j].imag);
      printf("\n");
    }
  }

  {
    su3_matrix tmp;

    /* tmp = exp(iQ) */
    quadr_comb( &tmp, &Q, &QQ, f);

    {
      int i, j;
      printf("Result exp(iQ)\n");
      
      for(i = 0; i < 3; i++){
	for(j = 0; j < 3; j++)
	  printf("%f + %f*I, ",tmp.e[i][j].real, tmp.e[i][j].imag);
	printf("\n");
      }
    }

    /* Note force_W is U' Sigma' = exp(iQ) U Sigma' in MP notation */
    /* force_diag = exp(-iQ) * force_W * exp(iQ) = first term in MP (75) */
    mult_su3_an( &tmp, force_W, &USigp );
    mult_su3_nn( &USigp, &tmp, force_diag );
  }

  /* Construction of Gamma from MP Eq (74) */

  {
    complex tr[3];
    su3_matrix B1, B2;

    /* B1 = b1[0] + b1[1]*Q + b1[2]*Q^2 */
    /* B2 = b2[0] + b2[1]*Q + b2[2]*Q^2 */
    quadr_comb( &B1, &Q, &QQ, b1 );
    quadr_comb( &B2, &Q, &QQ, b2 );

    /* Gamma = tr(U * Sigma' * B1) Q + tr(U * Sigma' * B2) Q^2 */
    tr[0] = cmplx(0,0);
    tr[1] = complextrace_su3_nn( &USigp, &B1);
    tr[2] = complextrace_su3_nn( &USigp, &B2);
    
    quadr_comb( &Gamma, &Q, &QQ, tr );
  }
  {
    su3_matrix tmp;

    /* Gamma += f_1 * U * Sigma' */
    c_scalar_mult_add_su3mat( &Gamma, &USigp, &f[1], &Gamma);
    
    /* Gamma += f_2 * Q * U * Sigma' */
    mult_su3_nn( &Q, &USigp, &tmp );
    c_scalar_mult_add_su3mat( &Gamma, &tmp, &f[2], &Gamma);
    
    /* Gamma += f_2 * U * Sigma' * Q */
    mult_su3_nn( &USigp, &Q, &tmp );
    c_scalar_mult_add_su3mat( &Gamma, &tmp, &f[2], &Gamma);
  }

  /* Lambda is the traceless-hermitian part of I*Gamma */

  traceless_hermitian_su3( ILambda, &Gamma);

  /* Multiply by I to make traceless antihermitian */

  c_scalar_mult_su3mat( ILambda, &plusI, ILambda );

} /* stout_force_terms */