/*

** Confining/Deconfining domain wall in Witten's confining gravity dual **

C implementation of algorithm in hep-th/0507xxx

Copyright Toby Wiseman July 2005



This code is designed to give solutions found in hep-th/0507xxx for 2
lattice resolutions. Changing the resolution will also require
altering the underrelaxation parameters. This is left up to the user!

WARNING!!  This code may take some time to run to completion -
especially for the higher resolution.

*/
  

/* Setup... */
  
#include <iostream>
#include <sstream>
#include "fstream.h"
#include "iomanip.h"
#include "stdlib.h"
#include "stdio.h"
#include "math.h"

#define PI 3.1415926535897932385


/* Parameters to fix:

DIM = d in the paper; total bulk is d+2 dimensions

NA  = number of lattice points in 'x' direction

NB  = number of lattice points in 'y' direction

************* IMPORTANT! ********************

This code works for;  NA = 161, NB = 41 and 
                      NA = 321, NB = 81

		      and DIM = 3 or 4

For other resolutions or dimensions the underrelaxation parameters
will have to be adjusted. This is left to the user!

*/

#define DIM 3

#define NA  161
#define NB  41

/*

Spacing in both x and y lattice directions

*/

double DX = 1./(NB-1) ;

/* 

Underrelaxation parameter; Higher resolution requires more underrelaxation

*/

double RELAX = 0.3 ;


/* 

Various arrays to store metric variables; A,B,C,Darr and T,U,S,Rarr

Also constraint equations alpha, beta and K = (Riemann)^2

Also temp is a template array used to store 'status' of lattice points (ie. are they in the coordinate domain of problem, are they x<=y etc...)

*/

int temp[NA][NB] ;

double harr[NA][NB] ;

double farr[NA][NB] ;

double Aarr[NA][NB], Barr[NA][NB], Carr[NA][NB], Darr[NA][NB] ;

double Tarr[NA][NB], Uarr[NA][NB], Sarr[NA][NB], Rarr[NA][NB] ;

double constA[NA][NB], constB[NA][NB], Kretch[NA][NB] ;


/*

Declare functions...

*/

void init(void), inith(void) ;

void inittemp(double,double) ;

double relax(int), relaxh(int) ;
void   relaxf(int) ;

void bch(void), bc(void), bcf(void) ;

void updatef(int) ;

void fillh(void), fill(void), fillf(void) ;

void patch(void) ; 

double coordx(int,int), coordy(int,int) ;

void updatept1(int,int), updatept2(int,int), updateptf(int,int), updatepth(int,int) ;

void write(void) ;



/* 

Program code; starts at 'main' routine

*/


int main(void)
{
  int disp ;
  long iter ;
  double err ;


  /* -------------------------------------
    
  Firstly relax 'h' function...

  --------------------------------------- */

  /* Initialize h */

  inith() ;
  
  /* Relax until maximum error small enough */

  for(iter=0;iter<100000;iter++) {
    
    disp = iter%10 ;
    
    if(disp==0) {
      cout << "Iter = " << iter   << endl ;
    }
    
    err = relaxh(disp) ;
    
    if(err<1e-10) iter=10000000 ;
    
  }

  /* -------------------------------------
    
  Now;  i) initialize metric functions
       ii) construct coordinate domain from h
             using inittemp( epsilon, h0 )

  --------------------------------------- */

  init() ;

  inittemp( + 0.05 , + 0.6 ) ;

  /* -------------------------------------
    
  Now solve bulk elliptic equations

  - for now keep f fixed ( = h)

  Just do this for a little while...

  --------------------------------------- */

  for(iter=0;iter<1000000;iter++) {
    
    disp = iter%10 ;
    
    if(disp==0) {
      cout << "Iter (f fixed) = " << iter << endl ;
    }
    
    err = relax(disp) ;

    if(err<1e-4) iter=10000000 ;

  }


  /* -------------------------------------
    
  Carry on solving bulk elliptic equations now updating f too

  Stop when error small enough.

  --------------------------------------- */

  cout << "*****************" << endl ;

  for(iter=0;iter<1000000;iter++) {
    
    disp = iter%10 ;
    
    if(disp==0) {
      cout << "Iter = " << iter << endl ;
    }
    
    err = relax(disp) ;

    relaxf(disp) ;

    updatef(disp) ;

    if(err<1e-9) iter=10000000 ;

  }


  
  /* -------------------------------------
    
  Done! Write results!

  --------------------------------------- */

  write() ;
 
  cout << "Done" << endl ;
  
  return(0) ;
  
}



/* 

Routines that actually do the work... 

*/



/* 

Setup the lattice template and set f = h in region where it is defined (h<h0)

Points outside region = 0 (y>x or h<epsilon)

At boundary of UV region = 4

In UV region = 1   epsilon < h < h0

At boundary of UR/IR = 3

In IR region = 2   h > h0


So will roughly look like this;

0000000000000000000000000000000000000000
0000000000400000000000000000000000000000
0000000002400000000000000000000000000000
0000000022244444400000000000000000000000
0000000222222222244444444444444444444444
0000003222222222222222222222222222222222
0000011322222222222222222222222222222222
0000111133322222222222222222222222222222
0001111111133333333333333333333333333333
0011111111111111111111111111111111111111
0111111111111111111111111111111111111111
1111111111111111111111111111111111111111


*/

void inittemp(double epsilon, double h0)
{
  int posx, posy ;
  double x, y ;


  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {

      /* Set f = h over all lattice */
    
      farr[posx][posy] = harr[posx][posy] ;

      /* 

      If h<epsilon or y>x then temp = 0   ie. outside  coordinate domain

      If h0 > h > epsilon then temp = 1   ie. near UV so use T,U,S,R 

      If h > h0 then temp = 1             ie. near IR so use A,B,C,D

      */

      temp[posx][posy] = 0 ;

      if( posy<=posx ) {

	if( harr[posx][posy]>epsilon ) { 
	  temp[posx][posy] = 1 ;
	} 

	if( harr[posx][posy]>h0 ) { 
	  temp[posx][posy] = 2 ;
	} 

      }

    }
  }


  /*

  Put temp=4 if a point in UV region '1' bordering UV cutoff and used
  by bulk elliptic equation.

  Put temp=3 if a point in IR region '2' bordering UV region '1' and
  is used by bulk elliptic equation in UV region.

  */


  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {

      if(posy>posx) continue ;

      if(temp[posx][posy]==1) {

	if(temp[posx][posy-1]==2) temp[posx][posy-1] = 3 ;
	if(posy<=posx-1 && temp[posx-1][posy]==2) temp[posx-1][posy] = 3 ;

	if(posy+1<=posx && temp[posx][posy+1]==0) temp[posx][posy+1] = 4 ;
	if(posx+1<NA && temp[posx+1][posy]==2) temp[posx+1][posy] = 4 ;

      }

    }
  }


  /* 

  If outside coordinate domain set f to some flag number - not used,
  but just to emphasize f only definited in region epsilon < h < h0

  */


  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {
      
      if(temp[posx][posy]==0) {
	farr[posx][posy] = -10. ;
      } 

      if(temp[posx][posy]==2) {
	farr[posx][posy] = -10. ;
      } 

    }
  }

}







/*

Initialize h function using sensible guess

*/

void inith(void)
{
  int posx, posy ;
  double x,y ;

  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {
    
      x = coordx(posx,posy) ;
      y = coordy(posy,posy) ;

      harr[posx][posy] = ( 1-1.6*y ) ;

    }
  }

}



/*

Initialize metric functions using function h. Set f = h.

*/

void init(void)
{
  int posx, posy ;
  double x, y, h, dhx, dhy ; 


  /* Now initialize metric functions with a sensible guess using 'h' */

  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {
    
      x = coordx(posx,posy) ;
      y = coordy(posy,posy) ;

      h = harr[posx][posy] ;

      dhx = (harr[posx+1][posy] - harr[posx-1][posy])/(2.*DX) ;
      dhy = (harr[posx][posy+1] - harr[posx][posy-1])/(2.*DX) ;

      farr[posx][posy] = h ;

      Aarr[posx][posy] = tanh(2*y)/h ; 
      Barr[posx][posy] = 1./h ; 
      Carr[posx][posy] = -log(h) ; 
      Darr[posx][posy] = -log(h)+0.5*log(dhx*dhx+dhy*dhy) ; 

      Tarr[posx][posy] = tanh(2*y) ; 
      Uarr[posx][posy] = 1. ; 
      Sarr[posx][posy] = 0. ; 
      Rarr[posx][posy] = 0. ; 

    }
  }

}





/*

Routine to relax h function

*/

double relaxh(int disp) 
{
  int posy,posx ;
  double maxchange, hold ;

  /* Update h in region y>x using y<=x region */

  fillh() ; 

  /* Update boundary conditions for h at large x - ie. normal bc */

  bch() ; 

  /* 

  Loop over all lattice points with y<=x 
  
  At each lattice site use Gauss-Seidel relaxation

  Compute maximum error (ie. max update) in lattice 

  */

  maxchange = 0. ;

  for(posx=1;posx<NA-1;posx++) {
    for(posy=1;posy<NB-1;posy++) {

      if(posy>posx) continue ;

      hold = harr[posx][posy] ;

      updatepth(posx,posy) ;
      
      if(fabs(harr[posx][posy]-hold)>fabs(maxchange)) {

	maxchange = fabs(harr[posx][posy]-hold) ;

      }

    }
  }

  /* Nice for user to see error */

  if(disp==0) {

    cout << " -> " << maxchange << endl ;

  }

  /* return the maximum error/update */

  return( fabs(maxchange) ) ;

}



/*

Routine to relax metric functions

Use A,B,C,D in region h<h0

Use T,U,S,R in region h>=h0

*/

double relax(int disp) 
{
  int posy,posx ;
  double maxchange1, maxchange2, aold, told ;

  /* fill in y>x points for metric functions */

  fill() ; 

  /* impose IR, UV and large x boundary conditions for metric functions */

  bc() ; 

  /* Update A,B,C,D and T,U,S,R functions at boundary h=h0 */

  patch() ; 

  /* redo y>x update just for paranoia's sake */

  fill() ;


  /* Loop over lattice points */

  maxchange2 = 0. ;

  for(posx=1;posx<NA-1;posx++) {
    for(posy=1;posy<NB-1;posy++) {

      /* Use template array to determine what to do with point */

      switch(temp[posx][posy]) {
	
	/* h<h0 region, and x<=y so update A-D functions using Gauss-Seidel */
	
      case(2) : case(3) :
	
	aold = Aarr[posx][posy] ;

	updatept1(posx,posy) ;

	if(fabs(Aarr[posx][posy]-aold)>fabs(maxchange1)) {
	  
	  maxchange1 = fabs(Aarr[posx][posy]-aold) ;
	  
	}
      
	break ;

	/* h>h0 region, and x<=y so update T,U,S,R functions using
	   Gauss-Seidel */

      case(1) :

	told = Tarr[posx][posy] ;

	updatept2(posx,posy) ;
      
	if(fabs(Tarr[posx][posy]-told)>fabs(maxchange2)) {
	  
	  maxchange2 = fabs(Tarr[posx][posy]-told) ;
	  
	}

	break ;	

	/* outside coordinate domain - so temp[posx][posy]==0 */

      default :

	continue ;

      }

    }
  }

  if(disp==0) {

    cout << " -> " << maxchange1 << " " << maxchange2 << endl ;

  }

  /* return maximum error/update */

  return( fabs(maxchange1) + fabs(maxchange2) ) ;

}


/* 

Routine to relax f - similar to above

*/

void relaxf(int disp) 
{
  int posy,posx ;

  fillf() ; bcf() ; fillf() ;

  for(posx=1;posx<NA-1;posx++) {
    for(posy=1;posy<NB-1;posy++) {

      if(temp[posx][posy]==1) {

	updateptf(posx,posy) ;

      }

    }
  }

}



/* 

Routines to fill y>x points using y<=x points

*/

void fillh(void)
{
  int posy,posx ;

  for(posx=0;posx<NB;posx++) {
    for(posy=posx+1;posy<NB;posy++) {

      harr[posx][posy] = harr[posy][posx] ;
      
    }
  }
 
}

void fillf(void)
{
  int posy,posx ;

  for(posx=0;posx<NB;posx++) {
    for(posy=posx+1;posy<NB;posy++) {

      farr[posx][posy] = farr[posy][posx] ;
      
    }
  }
 
}

void fill(void)
{
  int posy,posx ;

  for(posx=0;posx<NB;posx++) {
    for(posy=posx+1;posy<NB;posy++) {

      farr[posx][posy] = farr[posy][posx] ;

      Aarr[posx][posy] = Barr[posy][posx] ;
      Barr[posx][posy] = Aarr[posy][posx] ;
      Carr[posx][posy] = Carr[posy][posx] ;
      Darr[posx][posy] = Darr[posy][posx] ;

      Tarr[posx][posy] = Uarr[posy][posx] ;
      Uarr[posx][posy] = Tarr[posy][posx] ;
      Sarr[posx][posy] = Sarr[posy][posx] ;
      Rarr[posx][posy] = Rarr[posy][posx] ;
      
    }
  }
 
}



/* 

Large x boundary condition for h

*/

void bch(void)
{
  int posx, posy ;
  
  posx = NA-1 ;
  
  for(posy=0;posy<NB;posy++) {

    harr[posx][posy] = harr[posx-1][posy] ;
        
  }

}


/* 

Large x boundary condition for f

*/

void bcf(void)
{
  int posx, posy ;
  
  posx = NA-1 ;
  
  for(posy=0;posy<NB;posy++) {

    farr[posx][posy] = farr[posx-1][posy] ;
        
  }

}


/* 

Boundary conditions for metric functions (doesn't include y=x 'boundary' done by 'fill'

*/

void bc(void)
{
  int posx, posy ;

  double f, phi ;


  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {

      /*

      At UV boundary points (temp==4) impose UV asymptotic bc's for T,U,S,R

      */

      if(temp[posx][posy]==4) {

	f = farr[posx][posy] ;

	Tarr[posx][posy] = 1. ;
	Uarr[posx][posy] = 1. ;
	Sarr[posx][posy] = 0. ; 

	switch(DIM) {
	  
	  /* 

	  Note the numbers 0.3 and 0.35 are just chosen for
	  convenience - could choose anything (relatively close to
	  these so everything converges smoothly)

	  */

	case(4) : 
	  
	  Rarr[posx][posy] = 0.3*pow(f,5) ;
	  break ;
	  
	case(3) : 
	  
	  Rarr[posx][posy] = 0.35*pow(f,4) ;
	  break ;
	  
	default : 
	  
	  cout << "Case not covered!" << endl ;
	  exit(1) ;
	  
	}

      }

    }
  }


  /* Impose large x boundary conditions of vanishing normal gradient */


  posx = NA-1 ;
  
  for(posy=0;posy<NB;posy++) {

    farr[posx][posy] = farr[posx-1][posy] ;

    Aarr[posx][posy] = Aarr[posx-1][posy] ;
    Barr[posx][posy] = Barr[posx-1][posy] ;
    Carr[posx][posy] = Carr[posx-1][posy] ;
    Darr[posx][posy] = Darr[posx-1][posy] ;

    Tarr[posx][posy] = Tarr[posx-1][posy] ;
    Uarr[posx][posy] = Uarr[posx-1][posy] ;
    Sarr[posx][posy] = Sarr[posx-1][posy] ;
    Rarr[posx][posy] = Rarr[posx-1][posy] ;

  }


  /* 

  IR boundary conditions - B,C,D Neumann and A Dirichlet 

  Note: IR boundary actually set at -DX/2

  */

  posy = 0 ;
  
  for(posx=0;posx<NA;posx++) {

    Aarr[posx][posy] = - Aarr[posx][posy+1] ;
    Barr[posx][posy] = + Barr[posx][posy+1] ; 
    Carr[posx][posy] = + Carr[posx][posy+1] ; 
    Darr[posx][posy] = + Darr[posx][posy+1] ; 

  }

}


/*

Implements boundary condition for f;

Sets f^(d+1) = k r_{d+1} at lower edge of UV region (ie. on points temp==3).

Recall f only relaxed - and defined - in UV region.

Really must ensure h_0 is as small as possible as boundary condition
should in principle be imposed at UV boundary. h0 = 0.6 works well,
and smaller values become rather unstable and appear to lose accuracy
in UV because of the tricky UV behaviour of the equations. Must ensure
h_0^{d+1) << 1.

This routine employs huge underrelaxation to stabilize method. This is
because we must take R/f^{d+1} to compute new value of f and clearly
only if the UV behaviour is accurate will this give a good
result. Thus f must be updated very slowly to ensure the elliptic
equations can then adjust the solution and ensure that R~f^{d+1}
accurately at all times in relaxation. This is why these elliptic
equations must be solved for some time before we can start updating f
- see 'main' routine.

We find that 0.0000025 works well for the resolutions in the
paper. However, going to higher resolution one will likely need to
further increase this underrelaxation parameter for stability.

Prints out the maximum and minimum values of R/f^{d+1} in the solution
at the lower UV boundary. This should go to zero to solve the
\tilde{alpha} constraint in the UV.

*/

void updatef(int disp)
{
  int posx, posy ;
  
  double da, expd, k, maxk, mink, val ;

  posy = 0 ;
  
  switch(DIM) {

  case(4) :

    k = 0.30 ;
    break ;

  case(3) :

    k = 0.35 ;    
    break ;
    
  default :
    cout << "Can't handle this dimension" << endl ;
    exit(1) ;

  }

  maxk = 0. ; mink = 1000. ;

  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {

      if(temp[posx][posy]==3) {

	val = Rarr[posx][posy]/pow(farr[posx][posy],DIM+1)/k ;

	if( val < mink ) mink = val ;
	
	if( val > maxk ) maxk = val ;
	
	farr[posx][posy] += 0.0000025*(val-1.) ;

      }

    }
  }


  if(disp==0) {

    cout << "     max/min k = " << maxk << " " << mink << " -> " << fabs(maxk-mink) << endl ;

  }

}



/*

Fills in values of T,U,S,R using A,B,C,D for points at upper boundary
of IR region (temp==3)

Fills in values of A,B,C,D using T,U,S,R for points in UV region (temp==1)

- code then can use T,U,S,R variables in UV and A,B,C,D in IR so that
  very large gradients do not occur (as they would in UV using A,B,C,D
  and reduce accuracy)

*/

void patch(void)
{
  int posy,posx ;
  double f, dfx, dfy ;

  for(posx=0;posx<NA-1;posx++) {
    for(posy=0;posy<NB;posy++) {

      f = farr[posx][posy] ;

      dfx = (farr[posx+1][posy] - farr[posx][posy])/(DX) ;
      dfy = (farr[posx][posy+1] - farr[posx][posy])/(DX) ;

      if(temp[posx][posy]==3) {
	
	Tarr[posx][posy] = f*Aarr[posx][posy] ;
	Uarr[posx][posy] = f*Barr[posx][posy] ;
	Sarr[posx][posy] = log(f)+Carr[posx][posy] ;
	Rarr[posx][posy] = log(f)-0.5*log(dfx*dfx+dfy*dfy)+Darr[posx][posy] ;
	
      }
      
      if(temp[posx][posy]==1) {
	
	Aarr[posx][posy] = (1./f)*Tarr[posx][posy] ;
	Barr[posx][posy] = (1./f)*Uarr[posx][posy] ;
	Carr[posx][posy] = -log(f)+Sarr[posx][posy] ;
	Darr[posx][posy] = -log(f)+0.5*log(dfx*dfx+dfy*dfy)+Rarr[posx][posy] ;
	
      }

    }
  }
 
}




/* 

Housekeeping functions for lattice

*/


double coordx(int posx, int posy)
{
  return( (DX)*(posx-0.5) ) ;
} 

double coordy(int posx, int posy)
{
  return( (DX)*(posy-0.5) ) ;
} 


/* 

Update h function at lattice site using Gauss-Seidel. 

*/

void updatepth(int posx, int posy)
{
  int i, j ;
  double newh, h[3][3] ;

  for(i=0;i<=2;i++) {
    for(j=0;j<=2;j++) {
 
      h[i][j] = harr[posx+i-1][posy+j-1] ;

    }
  }
  
  newh = 1./4.*( h[2][1]+h[0][1]+h[1][2]+h[1][0] ) ;

  harr[posx][posy] = newh ;

}



/* 

Update f function at lattice site using Gauss-Seidel. 

*/

void updateptf(int posx, int posy)
{
  int i, j ;
  double newf, f[3][3] ;

  for(i=0;i<=2;i++) {
    for(j=0;j<=2;j++) {
 
      f[i][j] = farr[posx+i-1][posy+j-1] ;

    }
  }
  
  newf = 1./4.*( f[2][1]+f[0][1]+f[1][2]+f[1][0] ) ;

  farr[posx][posy] = newf ;

}



/* 

Gauss-Seidel update for metric functions A,B,C,D using elliptic equations 

Note; second order finite differencing done using mathematica notebook - difference.nb

*/

void updatept1(int posx, int posy)
{
  int i, j ;
  double p, srcA, srcB, srcC, srcD, newA, newB, newC, newD ;
  double a[3][3], b[3][3], c[3][3], d[3][3] ;

  double DX2 = DX*DX; 

  p = DIM ;

  for(i=0;i<=2;i++) {
    for(j=0;j<=2;j++) {
 
      a[i][j] = Aarr[posx+i-1][posy+j-1] ;
      b[i][j] = Barr[posx+i-1][posy+j-1] ;
      c[i][j] = Carr[posx+i-1][posy+j-1] ;
      d[i][j] = Darr[posx+i-1][posy+j-1] ;

    }
  }

  /* Source terms for elliptic equations - differenced in mathematica
     notebook 'finitediff.nb' */
  
  srcA = (4*(1 + p)*a[1][1]*exp(2*d[1][1]) - (-2 + p)*(a[1][0] - a[1][2])*(c[1][0] - c[1][2])*pow(DX,-2) - (-2 + p)*(a[0][1] - a[2][1])*(c[0][1] - c[2][1])*pow(DX,-2) - 
     (a[1][0] - a[1][2])*(b[1][0] - b[1][2])*pow(DX,-2)*pow(b[1][1],-1) - (a[0][1] - a[2][1])*(b[0][1] - b[2][1])*pow(DX,-2)*pow(b[1][1],-1))/4. ;

  srcB = (4*(1 + p)*b[1][1]*exp(2*d[1][1]) + (-((a[1][0] - a[1][2])*(b[1][0] - b[1][2])) + a[2][1]*(b[0][1] - b[2][1]) + a[0][1]*(-b[0][1] + b[2][1]) + 
        (-2 + p)*a[1][1]*(-((b[1][0] - b[1][2])*(c[1][0] - c[1][2])) - (b[0][1] - b[2][1])*(c[0][1] - c[2][1])))*pow(DX,-2)*pow(a[1][1],-1))/4. ;

  srcC = (4*(1 + p)*exp(2*d[1][1]) - (a[1][0] - a[1][2])*(c[1][0] - c[1][2])*pow(DX,-2)*pow(a[1][1],-1) - (a[0][1] - a[2][1])*(c[0][1] - c[2][1])*pow(DX,-2)*pow(a[1][1],-1) - 
     (b[1][0] - b[1][2])*(c[1][0] - c[1][2])*pow(DX,-2)*pow(b[1][1],-1) - (b[0][1] - b[2][1])*(c[0][1] - c[2][1])*pow(DX,-2)*pow(b[1][1],-1) - 
     (-2 + p)*pow(DX,-2)*pow(c[1][0] - c[1][2],2) - (-2 + p)*pow(DX,-2)*pow(c[0][1] - c[2][1],2))/4. ;

  srcD = (-2*(-2 + p)*(1 + p)*exp(2*d[1][1]) + (-2 + p)*(a[1][0] - a[1][2])*(c[1][0] - c[1][2])*pow(DX,-2)*pow(a[1][1],-1) + 
     (-2 + p)*(a[0][1] - a[2][1])*(c[0][1] - c[2][1])*pow(DX,-2)*pow(a[1][1],-1) + (-2 + p)*(b[1][0] - b[1][2])*(c[1][0] - c[1][2])*pow(DX,-2)*pow(b[1][1],-1) + 
     (-2 + p)*(b[0][1] - b[2][1])*(c[0][1] - c[2][1])*pow(DX,-2)*pow(b[1][1],-1) + (a[1][0] - a[1][2])*(b[1][0] - b[1][2])*pow(DX,-2)*pow(a[1][1],-1)*pow(b[1][1],-1) + 
     (a[0][1] - a[2][1])*(b[0][1] - b[2][1])*pow(DX,-2)*pow(a[1][1],-1)*pow(b[1][1],-1) + 
     ((-3 + p)*(-2 + p)*pow(DX,-2)*(pow(c[1][0] - c[1][2],2) + pow(c[0][1] - c[2][1],2)))/2.)/4. ;


  /* Gauss - Seidel formula */

  newA = 0.25*( a[2][1] + a[0][1] + a[1][2] + a[1][0] - DX2*srcA ) ;

  newB = 0.25*( b[2][1] + b[0][1] + b[1][2] + b[1][0] - DX2*srcB ) ;

  newC = 0.25*( c[2][1] + c[0][1] + c[1][2] + c[1][0] - DX2*srcC ) ;

  newD = 0.25*( d[2][1] + d[0][1] + d[1][2] + d[1][0] - DX2*srcD ) ;


  /* Update with underrelaxation */

  Aarr[posx][posy] = (1.-RELAX)*Aarr[posx][posy] + RELAX*newA ;

  Barr[posx][posy] = (1.-RELAX)*Barr[posx][posy] + RELAX*newB ;

  Carr[posx][posy] = (1.-RELAX)*Carr[posx][posy] + RELAX*newC ;

  Darr[posx][posy] = (1.-RELAX)*Darr[posx][posy] + RELAX*newD ;


  /* In case of error exit! */

  if(isnan(newA) || isnan(newB) || isnan(newC) || isnan(newD)) {
    cout << "-> " << newA << " " << newB << " " << newC << " " << newD << endl ;
    exit(1) ;
  }

}


/* 

Same as above for metric functions T,U,S,R using elliptic equations 

*/

void updatept2(int posx, int posy)
{
  int i, j ;
  double p, srcT, srcU, srcS, srcR, newT, newU, newS, newR ;
  double t[3][3], u[3][3], s[3][3], r[3][3], ff[3][3] ;

  double k, f ;

  double DX2 = DX*DX; 

  p = DIM ;

  for(i=0;i<=2;i++) {
    for(j=0;j<=2;j++) {
 
      ff[i][j] = farr[posx+i-1][posy+j-1] ;

      t[i][j] = Tarr[posx+i-1][posy+j-1] ;
      u[i][j] = Uarr[posx+i-1][posy+j-1] ;
      s[i][j] = Sarr[posx+i-1][posy+j-1] ;
      r[i][j] = Rarr[posx+i-1][posy+j-1] ;

    }
  }
  
  srcT = (pow(DX,-2)*pow(ff[1][1],-2)*pow(u[1][1],-1)*((1 + p)*(-1 + exp(2*r[1][1]))*(pow(ff[1][0] - ff[1][2],2) + pow(ff[0][1] - ff[2][1],2))*t[1][1]*u[1][1] + 
       pow(ff[1][1],2)*(-((t[1][0] - t[1][2])*(u[1][0] + (-2 + p)*(s[1][0] - s[1][2])*u[1][1] - u[1][2])) + t[2][1]*(u[0][1] + (-2 + p)*(s[0][1] - s[2][1])*u[1][1] - u[2][1]) + 
          t[0][1]*(-u[0][1] - (-2 + p)*(s[0][1] - s[2][1])*u[1][1] + u[2][1])) + 
       ff[1][1]*((ff[1][0] - ff[1][2])*((1 + p)*(t[1][0] - t[1][2])*u[1][1] + t[1][1]*(u[1][0] + (-2 + p)*(s[1][0] - s[1][2])*u[1][1] - u[1][2])) + 
          ff[0][1]*((1 + p)*(t[0][1] - t[2][1])*u[1][1] + t[1][1]*(u[0][1] + (-2 + p)*(s[0][1] - s[2][1])*u[1][1] - u[2][1])) + 
          ff[2][1]*(-((1 + p)*(t[0][1] - t[2][1])*u[1][1]) + t[1][1]*(-u[0][1] - (-2 + p)*(s[0][1] - s[2][1])*u[1][1] + u[2][1])))))/4. ;

  srcU = (pow(DX,-2)*(-((1 + p)*pow(ff[1][1],-2)*pow(ff[1][0] - ff[1][2],2)*u[1][1]) - (1 + p)*pow(ff[1][1],-2)*pow(ff[0][1] - ff[2][1],2)*u[1][1] + 
       (1 + p)*exp(2*r[1][1])*pow(ff[1][1],-2)*(pow(ff[1][0] - ff[1][2],2) + pow(ff[0][1] - ff[2][1],2))*u[1][1] + 
       (-2 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*(s[1][0] - s[1][2])*u[1][1] + (-2 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*(s[0][1] - s[2][1])*u[1][1] + 
       (ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[1][0] - t[1][2])*u[1][1] + (ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[0][1] - t[2][1])*u[1][1] + 
       (1 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*(u[1][0] - u[1][2]) - (-2 + p)*(s[1][0] - s[1][2])*(u[1][0] - u[1][2]) - 
       pow(t[1][1],-1)*(t[1][0] - t[1][2])*(u[1][0] - u[1][2]) + (1 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*(u[0][1] - u[2][1]) - 
       (-2 + p)*(s[0][1] - s[2][1])*(u[0][1] - u[2][1]) - pow(t[1][1],-1)*(t[0][1] - t[2][1])*(u[0][1] - u[2][1])))/4. ;

  srcS = -(pow(DX,-2)*((1 + p)*pow(ff[1][1],-2)*pow(ff[1][0] - ff[1][2],2) + (1 + p)*pow(ff[1][1],-2)*pow(ff[0][1] - ff[2][1],2) - 
        (1 + p)*exp(2*r[1][1])*pow(ff[1][1],-2)*(pow(ff[1][0] - ff[1][2],2) + pow(ff[0][1] - ff[2][1],2)) + (-2 + p)*pow(s[1][0] - s[1][2],2) + 
        (-2 + p)*pow(s[0][1] - s[2][1],2) - 2*(-1 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*(s[1][0] - s[1][2]) - 
        2*(-1 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*(s[0][1] - s[2][1]) - (ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[1][0] - t[1][2]) + 
        pow(t[1][1],-1)*(s[1][0] - s[1][2])*(t[1][0] - t[1][2]) - (ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[0][1] - t[2][1]) + 
        pow(t[1][1],-1)*(s[0][1] - s[2][1])*(t[0][1] - t[2][1]) - (ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*pow(u[1][1],-1)*(u[1][0] - u[1][2]) + 
        pow(u[1][1],-1)*(s[1][0] - s[1][2])*(u[1][0] - u[1][2]) - (ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*pow(u[1][1],-1)*(u[0][1] - u[2][1]) + 
        pow(u[1][1],-1)*(s[0][1] - s[2][1])*(u[0][1] - u[2][1])))/4. ;

  srcR = (pow(DX,-2)*((-2 + p)*(1 + p)*pow(ff[1][1],-2)*pow(ff[1][0] - ff[1][2],2) + (-2 + p)*(1 + p)*pow(ff[1][1],-2)*pow(ff[0][1] - ff[2][1],2) - 
       (-2 + p)*(1 + p)*exp(2*r[1][1])*pow(ff[1][1],-2)*(pow(ff[1][0] - ff[1][2],2) + pow(ff[0][1] - ff[2][1],2)) + (-3 + p)*(-2 + p)*pow(s[1][0] - s[1][2],2) + 
       (-3 + p)*(-2 + p)*pow(s[0][1] - s[2][1],2) - 2*(-2 + p)*(-1 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*(s[1][0] - s[1][2]) - 
       2*(-2 + p)*(-1 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*(s[0][1] - s[2][1]) - 2*(-1 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[1][0] - t[1][2]) + 
       2*(-2 + p)*pow(t[1][1],-1)*(s[1][0] - s[1][2])*(t[1][0] - t[1][2]) - 2*(-1 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*pow(t[1][1],-1)*(t[0][1] - t[2][1]) + 
       2*(-2 + p)*pow(t[1][1],-1)*(s[0][1] - s[2][1])*(t[0][1] - t[2][1]) - 2*(-1 + p)*(ff[1][0] - ff[1][2])*pow(ff[1][1],-1)*pow(u[1][1],-1)*(u[1][0] - u[1][2]) + 
       2*(-2 + p)*pow(u[1][1],-1)*(s[1][0] - s[1][2])*(u[1][0] - u[1][2]) + 2*pow(t[1][1],-1)*pow(u[1][1],-1)*(t[1][0] - t[1][2])*(u[1][0] - u[1][2]) - 
       2*(-1 + p)*(ff[0][1] - ff[2][1])*pow(ff[1][1],-1)*pow(u[1][1],-1)*(u[0][1] - u[2][1]) + 2*(-2 + p)*pow(u[1][1],-1)*(s[0][1] - s[2][1])*(u[0][1] - u[2][1]) + 
       2*pow(t[1][1],-1)*pow(u[1][1],-1)*(t[0][1] - t[2][1])*(u[0][1] - u[2][1])))/8. ;


  newT = 0.25*( t[2][1] + t[0][1] + t[1][2] + t[1][0] - DX2*srcT ) ;

  newU = 0.25*( u[2][1] + u[0][1] + u[1][2] + u[1][0] - DX2*srcU ) ;

  newS = 0.25*( s[2][1] + s[0][1] + s[1][2] + s[1][0] - DX2*srcS ) ;

  newR = 0.25*( r[2][1] + r[0][1] + r[1][2] + r[1][0] - DX2*srcR ) ;


  /* 

  Update R metric function very near UV using known behaviour for R to
  improve asymptotic behaviour a little.

  */

  f = farr[posx][posy] ;

  if(f<0.2) {

    switch(DIM) {

    case(4) : 
      
      k = 0.3 ;

      newR = pow(f,5)*k ;

      break ;
      
    case(3) : 
      
      k = 0.35 ;

      newR = pow(f,4)*k ;

      break ;
      
    default : 

      cout << "Case not covered!" << endl ;
      exit(1) ;

    }



  }

  

  Tarr[posx][posy] = (1.-RELAX)*Tarr[posx][posy] + RELAX*newT ;

  Uarr[posx][posy] = (1.-RELAX)*Uarr[posx][posy] + RELAX*newU ;

  Sarr[posx][posy] = (1.-RELAX)*Sarr[posx][posy] + RELAX*newS ;

  Rarr[posx][posy] = (1.-RELAX)*Rarr[posx][posy] + RELAX*newR ;


  /* In case error... */

  if(isnan(newT) || isnan(newU) || isnan(newS) || isnan(newR)) {
    cout << "-> " << newT << " " << newU << " " << newS << " " << newR << endl ;
    exit(1) ;
  }




}




/*

Write out the metric and other functions to view in mathematica...

*/

void write(void)
{
  int posx, posy ;
  double x, y, dfx, dfy ;
  
  ofstream fileX("saveX"), fileY("saveY") ;
  ofstream filef("savef"), fileh("saveh"), filefmag("savefmag"), filetemp("savetemp") ;
  ofstream fileA("saveA"), fileB("saveB"), fileC("saveC"), fileD("saveD") ;
  ofstream fileT("saveT"), fileU("saveU"), fileS("saveS"), fileR("saveR") ;
  
  cout << "Writing..." << endl ;

  for(posx=0;posx<NA;posx++) {
    for(posy=0;posy<NB;posy++) {

      x = coordx(posx,posy) ;
      y = coordy(posy,posy) ;
      
      fileX << x << " " ;
      fileY << y << " " ;

      fileh << harr[posx][posy] << " " ;

      filef << farr[posx][posy] << " " ;

      if(posx==0) {
	dfx = (farr[posx+1][posy] - farr[posx][posy])/(DX) ;
      } else if(posx==NA-1) {
	dfx = (farr[posx][posy] - farr[posx-1][posy])/(DX) ;
      } else {
	dfx = (farr[posx+1][posy] - farr[posx-1][posy])/(2.*DX) ;
      }
      if(posy==0) {
	dfy = (farr[posx][posy+1] - farr[posx][posy])/(DX) ;
      } else if(posy==NB-1) {
	dfy = (farr[posx][posy] - farr[posx][posy-1])/(DX) ;
      } else {
	dfy = (farr[posx][posy+1] - farr[posx][posy-1])/(2.*DX) ;
      }

      filefmag << sqrt(dfx*dfx+dfy*dfy) << " " ;

      filetemp << temp[posx][posy] << " " ;

      fileA << Aarr[posx][posy] << " " ;
      fileB << Barr[posx][posy] << " " ;
      fileC << Carr[posx][posy] << " " ;
      fileD << Darr[posx][posy] << " " ;

      fileT << Tarr[posx][posy] << " " ;
      fileU << Uarr[posx][posy] << " " ;
      fileR << Rarr[posx][posy] << " " ;
      fileS << Sarr[posx][posy] << " " ;

    } 

    fileX << endl ;
    fileY << endl ;
    
    filef << endl ;
    filefmag << endl ;
    filetemp << endl ;
    
    fileA << endl ;
    fileB << endl ;
    fileC << endl ;    
    fileD << endl ;
    
    fileT << endl ;
    fileU << endl ;
    fileR << endl ;    
    fileS << endl ;

  }

  fileX.close() ; 
  fileY.close() ; 
  
  filef.close() ; 
  filefmag.close() ; 
  filetemp.close() ; 

  fileA.close() ; 
  fileB.close() ; 
  fileC.close() ; 
  fileD.close() ; 
  
  fileT.close() ; 
  fileU.close() ; 
  fileR.close() ; 
  fileS.close() ; 

  cout << endl << "Done" << endl ;

}