/*********************** check_unitarity.c ***************************/
/* MIMD version 6 */
/* Claude Bernard, original version */
/* Modified 7/96 DT to quit after finding violation */
/* 9/4/96 DT added Urs' row orthogonality checks, if STRONG defined */
/* 11/2/98 CD fixed return value of max deviation */
/* 01/20/00 UMH combined with Schroedinger functional version */

#define STRONG			/* check row orthogonality as well as norms */

/* Check unitarity of link matrices, quit if not unitary */

#include "./include/includes.h"

#define TOLERANCE (0.0001)
/*#define UNIDEBUG */
double check_su3( su3_matrix * c );

double check_unitarity(  )
{
    register int i, dir;
    int ii, jj;
    register site *s;
    register su3_matrix *mat;
    double deviation, max_deviation;
    double av_deviation;
    union
    {
	double fval;
	int ival;
    } ifval;

    max_deviation = av_deviation = 0;
    FORALLSITES( i, s )
    {
#ifdef SCHROED_FUN
	for ( dir = XUP; dir <= TUP; dir++ )
	    if( dir == TUP || s->t > 0 )
	    {
#else
	for ( dir = XUP; dir <= TUP; dir++ )
	{
#endif
	    mat = ( su3_matrix * ) & ( gauge[4 * i + dir] );
	    deviation = check_su3( mat );
	    if( deviation > TOLERANCE )
	    {
		printf( "Unitarity problem on node %d, site %d, dir %d, deviation=%f\n", mynode_KE(  ), i, dir, deviation );
		printf( "SU3 matrix:\n" );
		for ( ii = 0; ii <= 2; ii++ )
		{
		    for ( jj = 0; jj <= 2; jj++ )
		    {
			printf( "%f ", ( *mat ).e[ii][jj].real );
			printf( "%f ", ( *mat ).e[ii][jj].imag );
		    }
		    printf( "\n" );
		}
		printf( "repeat in hex:\n" );
		for ( ii = 0; ii <= 2; ii++ )
		{
		    for ( jj = 0; jj <= 2; jj++ )
		    {
			ifval.fval = ( *mat ).e[ii][jj].real;
			printf( "%08x ", ifval.ival );
			ifval.fval = ( *mat ).e[ii][jj].imag;
			printf( "%08x ", ifval.ival );
		    }
		    printf( "\n" );
		}
		printf( "  \n \n" );
		fflush( stdout );
		terminate_KE( 1 );
	    }
	    if( max_deviation < deviation )
		max_deviation = deviation;
	    av_deviation += deviation * deviation;
	}
    }
    av_deviation = sqrt( av_deviation / ( 4 * i ) );
#ifdef UNIDEBUG
    printf( "Deviation from unitarity on node %d: max %g, avrg %g\n", mynode_KE(  ), max_deviation, av_deviation );
#endif
    if( max_deviation > TOLERANCE )
	printf( "Unitarity problem on node %d, maximum deviation=%f\n", mynode_KE(  ), max_deviation );
    return max_deviation;
}				/*check_unitarity() */

double check_su3( su3_matrix * c )
{
    register double ar, ai, ari, max;
    register int i;

    /* first normalize row */
    for ( i = 0, max = 0.; i < 3; ++i )
    {
	ar = ( *c ).ROWCOL( i, 0 ).real * ( *c ).ROWCOL( i, 0 ).real +	/* sum of squares of row */
	    ( *c ).ROWCOL( i, 0 ).imag * ( *c ).ROWCOL( i, 0 ).imag +
	    ( *c ).ROWCOL( i, 1 ).real * ( *c ).ROWCOL( i, 1 ).real +
	    ( *c ).ROWCOL( i, 1 ).imag * ( *c ).ROWCOL( i, 1 ).imag +
	    ( *c ).ROWCOL( i, 2 ).real * ( *c ).ROWCOL( i, 2 ).real + ( *c ).ROWCOL( i, 2 ).imag * ( *c ).ROWCOL( i, 2 ).imag;
	ar = fabs( sqrt( ( double ) ar ) - 1. );
	if( max < ar )
	    max = ar;
    }

#ifdef STRONG

    /* Test orthogonality of row 0 and row 1 */
    ar = ( *c ).ROWCOL( 0, 0 ).real * ( *c ).ROWCOL( 1, 0 ).real +	/* real part of 0 dot 1 */
	( *c ).ROWCOL( 0, 0 ).imag * ( *c ).ROWCOL( 1, 0 ).imag +
	( *c ).ROWCOL( 0, 1 ).real * ( *c ).ROWCOL( 1, 1 ).real +
	( *c ).ROWCOL( 0, 1 ).imag * ( *c ).ROWCOL( 1, 1 ).imag +
	( *c ).ROWCOL( 0, 2 ).real * ( *c ).ROWCOL( 1, 2 ).real + ( *c ).ROWCOL( 0, 2 ).imag * ( *c ).ROWCOL( 1, 2 ).imag;
    ai = ( *c ).ROWCOL( 0, 0 ).real * ( *c ).ROWCOL( 1, 0 ).imag -	/* imag part of 0 dot 1 */
	( *c ).ROWCOL( 0, 0 ).imag * ( *c ).ROWCOL( 1, 0 ).real +
	( *c ).ROWCOL( 0, 1 ).real * ( *c ).ROWCOL( 1, 1 ).imag -
	( *c ).ROWCOL( 0, 1 ).imag * ( *c ).ROWCOL( 1, 1 ).real +
	( *c ).ROWCOL( 0, 2 ).real * ( *c ).ROWCOL( 1, 2 ).imag - ( *c ).ROWCOL( 0, 2 ).imag * ( *c ).ROWCOL( 1, 2 ).real;

    ari = sqrt( ( double ) ( ar * ar + ai * ai ) );
    if( max < ari )
	max = ari;

    /* Test orthogonality of row 0 and row 2 */
    ar = ( *c ).ROWCOL( 0, 0 ).real * ( *c ).ROWCOL( 2, 0 ).real +	/* real part of 0 dot 1 */
	( *c ).ROWCOL( 0, 0 ).imag * ( *c ).ROWCOL( 2, 0 ).imag +
	( *c ).ROWCOL( 0, 1 ).real * ( *c ).ROWCOL( 2, 1 ).real +
	( *c ).ROWCOL( 0, 1 ).imag * ( *c ).ROWCOL( 2, 1 ).imag +
	( *c ).ROWCOL( 0, 2 ).real * ( *c ).ROWCOL( 2, 2 ).real + ( *c ).ROWCOL( 0, 2 ).imag * ( *c ).ROWCOL( 2, 2 ).imag;
    ai = ( *c ).ROWCOL( 0, 0 ).real * ( *c ).ROWCOL( 2, 0 ).imag -	/* imag part of 0 dot 1 */
	( *c ).ROWCOL( 0, 0 ).imag * ( *c ).ROWCOL( 2, 0 ).real +
	( *c ).ROWCOL( 0, 1 ).real * ( *c ).ROWCOL( 2, 1 ).imag -
	( *c ).ROWCOL( 0, 1 ).imag * ( *c ).ROWCOL( 2, 1 ).real +
	( *c ).ROWCOL( 0, 2 ).real * ( *c ).ROWCOL( 2, 2 ).imag - ( *c ).ROWCOL( 0, 2 ).imag * ( *c ).ROWCOL( 2, 2 ).real;

    ari = sqrt( ( double ) ( ar * ar + ai * ai ) );
    if( max < ari )
	max = ari;

    /* Test orthogonality of row 1 and row 2 */
    ar = ( *c ).ROWCOL( 1, 0 ).real * ( *c ).ROWCOL( 2, 0 ).real +	/* real part of 0 dot 1 */
	( *c ).ROWCOL( 1, 0 ).imag * ( *c ).ROWCOL( 2, 0 ).imag +
	( *c ).ROWCOL( 1, 1 ).real * ( *c ).ROWCOL( 2, 1 ).real +
	( *c ).ROWCOL( 1, 1 ).imag * ( *c ).ROWCOL( 2, 1 ).imag +
	( *c ).ROWCOL( 1, 2 ).real * ( *c ).ROWCOL( 2, 2 ).real + ( *c ).ROWCOL( 1, 2 ).imag * ( *c ).ROWCOL( 2, 2 ).imag;
    ai = ( *c ).ROWCOL( 1, 0 ).real * ( *c ).ROWCOL( 2, 0 ).imag -	/* imag part of 0 dot 1 */
	( *c ).ROWCOL( 1, 0 ).imag * ( *c ).ROWCOL( 2, 0 ).real +
	( *c ).ROWCOL( 1, 1 ).real * ( *c ).ROWCOL( 2, 1 ).imag -
	( *c ).ROWCOL( 1, 1 ).imag * ( *c ).ROWCOL( 2, 1 ).real +
	( *c ).ROWCOL( 1, 2 ).real * ( *c ).ROWCOL( 2, 2 ).imag - ( *c ).ROWCOL( 1, 2 ).imag * ( *c ).ROWCOL( 2, 2 ).real;

    ari = sqrt( ( double ) ( ar * ar + ai * ai ) );
    if( max < ari )
	max = ari;

#endif /*STRONG*/
	return ( max );

}				/* check_su3 */
