/*********************************************************
 * Generic gauge field blocking routine 
 * Kari Rummukainen 1998 - 2002
 */

void block_link_MATRIX( MATRIX *oldl[NDIM], MATRIX *newl[NDIM], 
		        int newlev[NDIM], int free_old )
{
  /*     Just multiply the straight links U(x) U(x+1) -> U(x)
   */

  int i,j,dir;
  int x[NDIM],step[NDIM],oldlev[NDIM];
  int *nf[NDIM];
  MATRIX *tmpl[NDIM];
  msg_tag *tag[NDIM];
  node_struct oldnode;

  /* first, start XYZ-direction: move the link to ->staple */

  foralldir(dir) {
    oldlev[dir] = current_blocking_level[dir];
    step[dir] = newlev[dir] - oldlev[dir];
    if (step[dir] == 1) {
      tag[dir] = start_get( oldl[dir], dir, EVENODD );
    } else if (0 != step[dir]) halt(" Gauge blocking error" );
  }

  foralldir(dir) {
    /* wait the gathers, this clears the buffers */
    if (step[dir]) wait_get(tag[dir]);
    /* grab the old neighbour arrays */
    nf[dir] = neighb[dir];
  }

  /* copy the node, needed */
  oldnode = node;

  /* block the system */
  set_blocking_level( newlev );

  foralldir(dir) tmpl[dir] = new_latfield( MATRIX );

  /* and loop over */
  forallsites(i) {
    foralldir(dir) x[dir] = (coordinate(i,dir)) << step[dir];
    /* index to the corresponding site */
    j = node_index( x, &oldnode );
    
    /* and mult */
    foralldir(dir) {
      if (step[dir]) {
	mult_MATRIX_nn( oldl[dir][j], oldl[dir][nf[dir][j]], tmpl[dir][i] );
      } else {
	tmpl[dir][i] = oldl[dir][j];
      }
    }
  }

  /* restore old level */
  set_blocking_level( oldlev );

  if (free_old) foralldir(dir) free_latfield( oldl[dir] );
  /* set the pointer last - this makes it possible to use same
     link in and out, if the old is freed first */
  foralldir(dir) newl[dir] = tmpl[dir];
  
}
