Task: Implement ksq_axi_rdbh.x for EinsteinInitialData/IDAxiOddBrillBH thorn

thorn_name: EinsteinInitialData/IDAxiOddBrillBH
src_filename: ksq_axi_rdbh.x
interface: # Interface definition for thorn AxiOddBrillBHIVP
# $Header$

implements: axiodd
inherits: ADMBase grid StaticConformal

private:

real sph_to_car_coord type = GF
{
eta,
abseta,
sign_eta,
q,
phi
} "coordinate range"

real sph_to_car_psi type = GF
{
 psi2d,
 detapsi2d,
 dqpsi2d,
 detaetapsi2d,
 detaqpsi2d,
 dqqpsi2d
 } "psi"



schedule: # Schedule definitions for thorn AxiOddBrillBHIVP
# $Header$

if (CCTK_Equals(initial_data,"axioddbh")) 
{ 
  STORAGE: sph_to_car_coord, sph_to_car_psi

  schedule IDAxiOddBrillBH_ParamCheck at PARAMCHECK
  {
    LANG: C
  } "Check Parameters"

  schedule IDAxiOddBrillBH IN ADMBase_InitialData
  {
    LANG: Fortran
  } "Construct IDAxiOddBrillBH"  
}



param: # Parameter definitions for thorn AxiOddBrillBHIVP
# $Header$

shares: StaticConformal

USES KEYWORD conformal_storage

shares:admbase

USES KEYWORD metric_type

EXTENDS KEYWORD initial_lapse 
{
  "schwarz" :: "Set lapse to Schwarzschild"
}
EXTENDS KEYWORD initial_data 
{
   "axioddbh" :: "Axisymmetry Initial data for Brandt-Seidel"
}

private:

REAL amp "Brill wave amplitude for extrinsic curveture"
{
  *:* :: "No restriction"
} 0.1

REAL amp_me "Brill wave amplitude for metric"
{
  *:* :: "No restriction"
} 0.0

REAL xi "for recoil"
{
  *:* :: "No restriction"
} 0.0

REAL eta0 "Brill wave center (in eta coords) for extrisic curvature"
{
  *:* :: "No restriction"
} 0.0

REAL eta0_me "Brill wave center (in eta coords) for metric"
{
  *:* :: "No restriction"
} 0.0

REAL sigma "Brill wave width (in eta) for extrinsic curveture"
{
  *:* :: "No restriction"
} 1.0

REAL sigma_me "Brill wave width (in eta) for metric"
{
  *:* :: "No restriction"
} 1.0

REAL byJ "Bowen and York Momenta"
{
  *:* :: "No restriction"
} 0.0

REAL etamax "Eta value for outer edge of grid"
{
  *:* :: "No restriction"
} 5.0


INT n "sin**n theta in brill wave for extrinsic curveture"
{
  *:* :: "No restriction"
} 3

INT n_me "sin**n theta in brill wave for metric"
{
  *:* :: "No restriction"
} 3

INT neta "Eta resolution for solve"
{
  *:* :: "No restriction"
} 300

INT ntheta "Theta resolution for solve"
{
  *:* :: "No restriction"
} 50

BOOLEAN brandt_seidel "Brand-Seidel initial data"
{
} "no"

BOOLEAN sergio "Sergio initial data"
{
} "no"

BOOLEAN verbose ""
{
} "yes"

INT interpolation_order "Order for interpolation" STEERABLE = ALWAYS
{
  1:3 :: "Choose between first, second, and third-order"
} 1

context: kij_bs.x:
```
        o1 = cos(phi(i,j,k))
        o2 = cos(q(i,j,k))
        o3 = o2**2
        o4 = -3.00000000000000d0*eta(i,j,k)
        o5 = exp(o4)
        o6 = sin(phi(i,j,k))
        o7 = sin(q(i,j,k))
        o8 = -1.00000000000000d0 + n
        o9 = o7**o8
        o10 = 2.00000000000000d0 + n
        o11 = o7**2
        o12 = -(o10*o11)
        o13 = 1.00000000000000d0 + n + o12
        o14 = o1**2
        o15 = o6**2
        o16 = o7**n
        o17 = -2.00000000000000d0 + n
        o18 = o7**o17
        kxx(i,j,k) = -2.00000000000000d0*gtil*o1*o13*o5*o6*o9 + 2.000000
     &  00000000d0*dngtil*o1*o3*o5*o6*o9
        kxy(i,j,k) = gtil*o13*o14*o5*o9 - gtil*o13*o15*o5*o9 - dngtil*o1
     &  4*o3*o5*o9 + dngtil*o15*o3*o5*o9
        kxz(i,j,k) = -(dngtil*o16*o2*o5*o6) - gtil*o13*o18*o2*o5*o6
        kyy(i,j,k) = 2.00000000000000d0*gtil*o1*o13*o5*o6*o9 - 2.0000000
     &  0000000d0*dngtil*o1*o3*o5*o6*o9
        kyz(i,j,k) = dngtil*o1*o16*o2*o5 + gtil*o1*o13*o18*o2*o5
        kzz(i,j,k) = 0

```

ParamCheck.c:
```
 /*@@
   @file      ParamCheck.c
   @date      Fri Apr 26 18:03:09 2002
   @author    Tom Goodale
   @desc 
              Check the parameters for IDAxiOddBrillBH
   @enddesc 
   @version $Header: /arrangements/PerturbedBH2/IDAxiOddBrillBH/src/ParamCheck.c,v 1.1 2002/04/30 guzman
 @@*/

#include "cctk.h"

#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

static const char *rcsid = "$Header$";

CCTK_FILEVERSION(IDAxiOddBrillBH_ParamCheck_c)

/********************************************************************
 *********************     Local Data Types   ***********************
 ********************************************************************/

/********************************************************************
 ********************* Local Routine Prototypes *********************
 ********************************************************************/

/********************************************************************
 ***************** Scheduled Routine Prototypes *********************
 ********************************************************************/

void IDAxiOddBrillBH_ParamCheck(CCTK_ARGUMENTS);
void IDAxiOddBrillBH_ConformalCheck(CCTK_ARGUMENTS);

/********************************************************************
 ********************* Other Routine Prototypes *********************
 ********************************************************************/

/********************************************************************
 *********************     Local Data   *****************************
 ********************************************************************/

/********************************************************************
 *********************     External Routines   **********************
 ********************************************************************/

void IDAxiOddBrillBH_ParamCheck(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS

  /* Do we know how to deal with this type of metric ? */
  if(! CCTK_EQUALS(metric_type, "physical") &&
     ! CCTK_EQUALS(metric_type, "static conformal"))
  {
    CCTK_PARAMWARN("Unknown ADMBase::metric_type - known types are \"physical\" and \"static conformal\"");
  }

  if(CCTK_EQUALS(metric_type, "static conformal") &&
     ! CCTK_EQUALS(conformal_storage, "factor+derivs+2nd derivs"))
  {
    CCTK_PARAMWARN("ADMConstraints can currently only work with a physical metric or a static conf");
  }
   
}

/********************************************************************
 *********************     Local Routines   *************************
 ********************************************************************/

 /*@@
   @routine    IDAxiOddBrillBH_ConformalCheck
   @date       Tu Apr 30 2002
   @author     Goodale-Guzman
   @desc
   Check that the initial data has setup enough derivatives.
   @enddesc
   @calls
   @calledby
   @history

   @endhistory

 @@*/
void IDAxiOddBrillBH_ConformalCheck(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  if(CCTK_EQUALS(metric_type, "physical"))
  {
    /* Use this internally so we don't need to check the parameter again. */
    *conformal_state = 0;
  }
  else if(CCTK_EQUALS(metric_type, "static conformal"))
  {
    if(*conformal_state < 3)
    {
      CCTK_WARN(0, "IDAxiOddBrillBH needs second derivatives of the conformal factor when running with a static conformal metric");
    }
  }

}
/********************************************************************
 *********************     Local Routines   *************************
 ********************************************************************/


```

kerr.x:
```
        mass = sqrt(2.0 + sqrt(4.0 + byJ**2
     &  ))
        a = byJ/mass
        rBL = 5.0e-1*exp(etagrd(i))*(1.0 + (1.0*(a
     &   + mass)*exp(-etagrd(i)))/sqrt(-a**2 + mass**2))*sqrt(-a**2 + mass**2)
     &  *(1.0 + (1.0*(a + mass)*exp(-etagrd(i)))/sqrt(a**2 + m
     &  ass**2))

```

gauss.x:
```
        gtil = amp*(exp(-((-eta0 + etagrd(i))**2/sigma**2)) + exp(-((eta0 +
     &   etagrd(i))**2/sigma**2)))
        dngtil = amp*((-2.00000000000000d0*(-eta0 + etagrd(i))*exp(-((-eta0
     &   + etagrd(i))**2/sigma**2)))/sigma**2 - (2.00000000000000d0*(eta0 +
     &   etagrd(i))*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**2)
        dnngtil = amp*((4.0000000000000d0*(-eta0 + etagrd(i))**2*exp(-((-et
     &  a0 + etagrd(i))**2/sigma**2)))/sigma**4 - (2.00000000000000d0*exp(-
     &  ((-eta0 + etagrd(i))**2/sigma**2)))/sigma**2 + (4.0000000000000d0*(
     &  eta0 + etagrd(i))**2*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**4 
     &  - (2.00000000000000d0*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma
     &  **2)
        dnnngtil = amp*((-8.0000000000000d0*(-eta0 + etagrd(i))**3*exp(-((-
     &  eta0 + etagrd(i))**2/sigma**2)))/sigma**6 + (1.20000000000000d1*(-e
     &  ta0 + etagrd(i))*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigma**4 - (
     &  8.0000000000000d0*(eta0 + etagrd(i))**3*exp(-((eta0 + etagrd(i))**2/si
     &  gma**2)))/sigma**6 + (1.20000000000000d1*(eta0 + etagrd(i))*exp(-((
     &  eta0 + etagrd(i))**2/sigma**2)))/sigma**4)
        dnnnngtil = amp*((1.60000000000000d1*(-eta0 + etagrd(i))**4*exp(-((
     &  -eta0 + etagrd(i))**2/sigma**2)))/sigma**8 - (4.8000000000000d1*(-e
     &  ta0 + etagrd(i))**2*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigma**6 
     &  + (1.20000000000000d1*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigm
     &  a**4 + (1.60000000000000d1*(eta0 + etagrd(i))**4*exp(-((eta0 + etag
     &  rd(i))**2/sigma**2)))/sigma**8 - (4.8000000000000d1*(eta0 + etagrd(i))
     &  **2*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**6 + (1.200000000
     &  00000d1*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**4)
        dnnnnngtil = amp*((-3.2000000000000d1*(-eta0 + etagrd(i))**5*exp(-(
     &  (-eta0 + etagrd(i))**2/sigma**2)))/sigma**10 + (1.60000000000000d2*
     &  (-eta0 + etagrd(i))**3*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigma*
     &  *8 - (1.20000000000000d2*(-eta0 + etagrd(i))*exp(-((-eta0 + etagrd(i))
     &  **2/sigma**2)))/sigma**6 - (3.2000000000000d1*(eta0 + etagrd(i))**5
     &  *exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**10 + (1.60000000000
     &  000d2*(eta0 + etagrd(i))**3*exp(-((eta0 + etagrd(i))**2/sigma**2)))/si
     &  gma**8 - (1.20000000000000d2*(eta0 + etagrd(i))*exp(-((eta0 + etagr
     &  d(i))**2/sigma**2)))/sigma**6)
        dnnnnnngtil = amp*((6.4000000000000d1*(-eta0 + etagrd(i))**6*exp(-(
     &  (-eta0 + etagrd(i))**2/sigma**2)))/sigma**12 - (4.8000000000000d2*(
     &  -eta0 + etagrd(i))**4*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigma**
     &  10 + (7.2000000000000d2*(-eta0 + etagrd(i))**2*exp(-((-eta0 + etagr
     &  d(i))**2/sigma**2)))/sigma**8 - (1.20000000000000d2*exp(-((-eta0 + 
     &  etagrd(i))**2/sigma**2)))/sigma**6 + (6.4000000000000d1*(eta0 + eta
     &  grd(i))**6*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**12 - (4.8000
     &  000000000d2*(eta0 + etagrd(i))**4*exp(-((eta0 + etagrd(i))**2/sigma**2
     &  )))/sigma**10 + (7.2000000000000d2*(eta0 + etagrd(i))**2*exp(-((eta
     &  0 + etagrd(i))**2/sigma**2)))/sigma**8 - (1.20000000000000d2*exp(-(
     &  (eta0 + etagrd(i))**2/sigma**2)))/sigma**6)
        dnnnnnnngtil = amp*((-1.28000000000000d2*(-eta0 + etagrd(i))**7*exp
     &  (-((-eta0 + etagrd(i))**2/sigma**2)))/sigma**14 + (1.34400000000000
     &  d3*(-eta0 + etagrd(i))**5*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sig
     &  ma**12 - (3.3600000000000d3*(-eta0 + etagrd(i))**3*exp(-((-eta0 + e
     &  tagrd(i))**2/sigma**2)))/sigma**10 + (1.68000000000000d3*(-eta0 + e
     &  tagrd(i))*exp(-((-eta0 + etagrd(i))**2/sigma**2)))/sigma**8 - (1.28000
     &  000000000d2*(eta0 + etagrd(i))**7*exp(-((eta0 + etagrd(i))**2/sigma**2
     &  )))/sigma**14 + (1.34400000000000d3*(eta0 + etagrd(i))**5*exp(-((et
     &  a0 + etagrd(i))**2/sigma**2)))/sigma**12 - (3.3600000000000d3*(eta0
     &   + etagrd(i))**3*exp(-((eta0 + etagrd(i))**2/sigma**2)))/sigma**10 + (
     &  1.68000000000000d3*(eta0 + etagrd(i))*exp(-((eta0 + etagrd(i))**2/sigm
     &  a**2)))/sigma**8)

```

psi_2nd_deriv.x:
```
        o1 = 5.0000000000000d-1*eta(i,j,k)
        o2 = exp(o1)
        o3 = psi2d(i,j,k)
        o4 = 1/o3
        o5 = cos(phi(i,j,k))
        o6 = o5**2
        o7 = cos(q(i,j,k))
        o8 = o7**2
        o9 = detapsi2d(i,j,k)
        o10 = -2.50000000000000d0*eta(i,j,k)
        o11 = exp(o10)
        o12 = dqqpsi2d(i,j,k)
        o13 = sin(phi(i,j,k))
        o14 = o13**2
        o15 = detaqpsi2d(i,j,k)
        o16 = sin(q(i,j,k))
        o17 = dqpsi2d(i,j,k)
        o18 = detaetapsi2d(i,j,k)
        o19 = o16**2
        o20 = tan(q(i,j,k))
        o21 = 1/o20
        psixx(i,j,k) = o2*o4*(1.00000000000000d0*o11*o14*o17*o21 - 5.000
     &  0000000000d-1*o11*o14*o3 + o11*o18*o19*o6 + 7.5000000000000d-1*o
     &  11*o19*o3*o6 + 2.00000000000000d0*o11*o15*o16*o6*o7 - 3.00000000
     &  000000d0*o11*o16*o17*o6*o7 + o11*o12*o6*o8 - 5.0000000000000d-1*
     &  o11*o3*o6*o8 + o11*o14*o9 - 2.00000000000000d0*o11*o19*o6*o9 + o
     &  11*o6*o8*o9)
        psixy(i,j,k) = o2*o4*(o11*o13*o18*o19*o5 - o11*o13*o17*o21*o5 + 
     &  5.0000000000000d-1*o11*o13*o3*o5 + 7.5000000000000d-1*o11*o13*o1
     &  9*o3*o5 + 2.00000000000000d0*o11*o13*o15*o16*o5*o7 - 3.000000000
     &  00000d0*o11*o13*o16*o17*o5*o7 + o11*o12*o13*o5*o8 - 5.0000000000
     &  000d-1*o11*o13*o3*o5*o8 - o11*o13*o5*o9 - 2.00000000000000d0*o11
     &  *o13*o19*o5*o9 + o11*o13*o5*o8*o9)
        psixz(i,j,k) = o2*o4*(-(o11*o15*o19*o5) + 1.50000000000000d0*o11
     &  *o17*o19*o5 - o11*o12*o16*o5*o7 + o11*o16*o18*o5*o7 + 1.25000000
     &  000000d0*o11*o16*o3*o5*o7 + o11*o15*o5*o8 - 1.50000000000000d0*o
     &  11*o17*o5*o8 - 3.00000000000000d0*o11*o16*o5*o7*o9)
        psiyy(i,j,k) = o2*o4*(o11*o14*o18*o19 + 7.5000000000000d-1*o11*o
     &  14*o19*o3 + 1.00000000000000d0*o11*o17*o21*o6 - 5.0000000000000d
     &  -1*o11*o3*o6 + 2.00000000000000d0*o11*o14*o15*o16*o7 - 3.0000000
     &  0000000d0*o11*o14*o16*o17*o7 + o11*o12*o14*o8 - 5.0000000000000d
     &  -1*o11*o14*o3*o8 - 2.00000000000000d0*o11*o14*o19*o9 + o11*o6*o9
     &   + o11*o14*o8*o9)
        psiyz(i,j,k) = o2*o4*(-(o11*o13*o15*o19) + 1.50000000000000d0*o1
     &  1*o13*o17*o19 - o11*o12*o13*o16*o7 + o11*o13*o16*o18*o7 + 1.2500
     &  0000000000d0*o11*o13*o16*o3*o7 + o11*o13*o15*o8 - 1.500000000000
     &  00d0*o11*o13*o17*o8 - 3.00000000000000d0*o11*o13*o16*o7*o9)
        psizz(i,j,k) = o2*o4*(o11*o12*o19 - 5.0000000000000d-1*o11*o19*o
     &  3 - 2.00000000000000d0*o11*o15*o16*o7 + 3.00000000000000d0*o11*o
     &  16*o17*o7 + o11*o18*o8 + 7.5000000000000d-1*o11*o3*o8 + o11*o19*
     &  o9 - 2.00000000000000d0*o11*o8*o9)

```

kij_axi_rdbh.x:
```
        o1 = cos(phi(i,j,k))
        o2 = cos(q(i,j,k))
        o3 = o2**2
        o4 = -3.00000000000000d0*eta(i,j,k)
        o5 = exp(o4)
        o6 = sin(phi(i,j,k))
        o7 = sin(q(i,j,k))
        o8 = o7**2
        o9 = dnnnnngtil
        o10 = -3.6000000000000d1*o9
        o11 = dnnnnnnngtil
        o12 = -4.0000000000000d0*o11*o8
        o13 = 1.16000000000000d2*o8*o9
        o14 = dnnngtil
        o15 = -4.1500000000000d2*o8
        o16 = 1.50000000000000d2 + o15
        o17 = o14*o16
        o18 = dngtil
        o19 = 5.0000000000000d0*o8
        o20 = -2.00000000000000d0 + o19
        o21 = 7.5000000000000d1*o18*o20
        o22 = o10 + o12 + o13 + o17 + o21
        o23 = 6.0000000000000d1*byJ
        o24 = dnnnnnngtil
        o25 = 3.00000000000000d0*o24
        o26 = 2.00000000000000d0*q(i,j,k)
        o27 = cos(o26)
        o28 = 4.0000000000000d0*o24*o27
        o29 = 4.0000000000000d0*q(i,j,k)
        o30 = cos(o29)
        o31 = -7.0000000000000d0*o24*o30
        o32 = dnnnngtil
        o33 = 2.10000000000000d1*o32
        o34 = 6.4000000000000d1*o27*o32
        o35 = 2.03000000000000d2*o30*o32
        o36 = o23 + o25 + o28 + o31 + o33 + o34 + o35
        o37 = 4.0000000000000d0*o36
        o38 = 2.68000000000000d2*o27
        o39 = 5.8100000000000d2*o30
        o40 = 1.11000000000000d2 + o38 + o39
        o41 = dnngtil
        o42 = -5.0000000000000d0*o40*o41
        o43 = 2.00000000000000d1*o27
        o44 = 3.5000000000000d1*o30
        o45 = 9.0000000000000d0 + o43 + o44
        o46 = gtil
        o47 = 7.5000000000000d1*o45*o46
        o48 = o37 + o42 + o47
        o49 = o1**2
        o50 = o6**2
        o51 = o7*o8
        kxx(i,j,k) = -2.00000000000000d-1*o1*o22*o3*o5*o6*o8 - 2.5000000
     &  0000000d-2*o1*o48*o5*o6*o8
        kxy(i,j,k) = 1.00000000000000d-1*o22*o3*o49*o5*o8 + 1.2500000000
     &  0000d-2*o48*o49*o5*o8 - 1.00000000000000d-1*o22*o3*o5*o50*o8 - 1
     &  .25000000000000d-2*o48*o5*o50*o8
        kxz(i,j,k) = 1.00000000000000d-1*o2*o22*o5*o51*o6 - 1.2500000000
     &  0000d-2*o2*o48*o5*o6*o7
        kyy(i,j,k) = 2.00000000000000d-1*o1*o22*o3*o5*o6*o8 + 2.50000000
     &  000000d-2*o1*o48*o5*o6*o8
        kyz(i,j,k) = -1.00000000000000d-1*o1*o2*o22*o5*o51 + 1.250000000
     &  00000d-2*o1*o2*o48*o5*o7
        kzz(i,j,k) = 0

```

gij.x:
```
        o1 = 2.0*phi(i,j,k)
        o2 = cos(o1)
        o3 = -xi
        o4 = cos(q(i,j,k))
        o5 = o4*xi
        o6 = 1.0 + o3 + o5
        o7 = -eta0_me
        o8 = eta(i,j,k) + o7
        o9 = o8**2
        o10 = sigma_me**2
        o11 = 1/o10
        o12 = -(o11*o9)
        o13 = exp(o12)
        o14 = eta(i,j,k) + eta0_me
        o15 = o14**2
        o16 = -(o11*o15)
        o17 = exp(o16)
        o18 = o13 + o17
        o19 = sin(q(i,j,k))
        o20 = o19**n_me
        o21 = 2.0*amp_me*o18*o20*o6
        o22 = exp(o21)
        o23 = -1.0 + o22
        gxx(i,j,k) = 5.d-1*(1.0 + o22 + o2*o23)
        gxy(i,j,k) = o23*cos(phi(i,j,k))*sin(phi(i,j,k))
        gxz(i,j,k) = 0
        gyy(i,j,k) = 5.d-1*(1.0 + o22 - o2*o23)
        gyz(i,j,k) = 0
        gzz(i,j,k) = o22

```

Stab2d.F:
```
      subroutine bicgst2d(cc,ce,cw,cn,cs,u,rhs,
     &             eps,rmax,ier,im,jm)
c
c This routine was lifted from stab.f. Minor modifications have
c been made.
c
      implicit none
c
      integer,intent(in) :: im,jm
      real*8,intent(inout) :: cc(im,jm),cn(im,jm),cs(im,jm),
     $     ce(im,jm),cw(im,jm)
      real*8,intent(out) :: eps
      real*8,intent(out) :: rmax
      real*8 :: u(im,jm),rhs(im,jm)
c     Local variable
      integer ncyc
      integer iscale,i,j,k,ier
c
c******************************************************************************
c
      ncyc = (im-2)*(jm-2)
      
      ier=0

*
*  Determine whether we can diagonally scale the problem to speed
*  convergence. Can only be done if there are no zeros on the main
*  diagonal (ie. central difference coefficient).
*
      iscale=1
      do j = 2,jm-1
         do i = 2,im-1
            if (cc(i,j).eq.0.) iscale = 0
         enddo
      enddo
      
*
*  Do the diagonal scaling if we can.
*
      if (iscale.eq.1) then


         do j = 2,jm-1
            do i = 2,im-1
               rhs(i,j)=rhs(i,j)/cc(i,j)
               cw(i,j)=cw(i,j)/cc(i,j)
               ce(i,j)=ce(i,j)/cc(i,j)
               cs(i,j)=cs(i,j)/cc(i,j)
               cn(i,j)=cn(i,j)/cc(i,j)
               cc(i,j)=1.
            enddo
         enddo
         
      endif
      
*     
*   Now call the bicgstab routine
*     
      
      call bicgstab2d (cc,cn,cs,ce,cw,u,rhs,eps,ncyc,rmax,ier,
     &     im,jm)
      if (rmax.gt.eps) then
         ier = -1
         print*,'Did not converge'
         print*,' maximum residual    = ',rmax
         print*,' tolerance           = ',eps
      endif
      
      return
      end
c     
c******************************************************************
c
      subroutine bicgstab2d (cc,cn,cs,ce,cw,x,r,tol,ncyc,rnorm,
     $     ier,im,jm)
c     
c This routine was lifted from stab.f. Minor modifications have
c been made.
c
      implicit none
c     
      integer,intent(in) :: im,jm
      integer :: ncyc
      real*8,intent(in) :: cc(im*jm),cn(im*jm)
      real*8,intent(in) :: cs(im*jm),ce(im*jm)
      real*8,intent(in) :: cw(im*jm)
      real*8,intent(in) :: tol
      real*8,intent(out):: rnorm
      integer,intent(out) :: ier
      real*8 x(im*jm),r(im*jm)
c     Local variables
      integer :: i,j,k,kk
      real*8 :: p(im*jm),Ap(im*jm),w(im*jm),As(im*jm)
      real*8 :: omega, chi,chi1,chi2, delta, deltap, pp
*
***********************************************************************
*     

      do i = 1,im*jm
         p(i) = 0.
         Ap(i) = 0.
         w(i) = 0.
         As(i) = 0.
      enddo
      
      kk = 0
 10   call usermv2d(cc,cn,cs,ce,cw,x,Ap,im,jm)

      
      do i = 1,im*jm
         r(i) = r(i)-Ap(i)
         p(i) = r(i)
      enddo

c      delta = sum(r)
      delta = 0.

      do i = 1,im*jm
         delta = delta+r(i)
      enddo

      if (delta.eq.0.) then
        ier=-1
        return
      endif

      call usermv2d(cc,cn,cs,ce,cw,p,Ap,im,jm)

c      phi = sum(Ap)
      pp = 0.

      do i = 1,im*jm
         pp = pp+Ap(i)
      enddo
      pp = pp/delta

      if (pp.eq.0.) then
        ier=-1
        return
      endif

c      rnorm = sum(r**2)
      rnorm = 0.

      do i = 1,im*jm
         rnorm = rnorm + r(i)**2
      enddo
      rnorm=sqrt(rnorm)
      
c     Test if initial guess is great (residual less than tolerance)
      if (rnorm .lt. tol)  return
      
 1    continue
      kk = kk + 1

      omega = 1./pp


      do i = 1,im*jm
         w(i) = r(i) - omega*Ap(i)
      enddo

      call usermv2d(cc,cn,cs,ce,cw,w,As,im,jm)

c      chi1 = sum(As*w)
      chi1 = 0.

      do i = 1,im*jm
         chi1 = chi1+As(i)*w(i)
      enddo
c      chi2 = sum(As**2)
      chi2 = 0.

      do i = 1,im*jm
         chi2 = chi2+As(i)**2
      enddo

      chi = chi1/chi2


      do i = 1,im*jm
         r(i) = w(i) - chi*As(i)
         x(i) = x(i) + omega*p(i) + chi*w(i)
      enddo

      deltap = delta
c      delta = sum(r)
      delta = 0.

      do i = 1,im*jm
         delta = delta+r(i)
      enddo

      if (delta.eq.0.) then
        goto 10
      endif


      do i = 1,im*jm
         p(i) = r(i) + (p(i)-chi*Ap(i))*omega*
     &        delta/(deltap*chi)
      enddo
      
      call usermv2d(cc,cn,cs,ce,cw,p,Ap,im,jm)

c      phi = sum(Ap)
      pp = 0.

      do i = 1,im*jm
         pp = pp+Ap(i)
      enddo
      pp=pp/delta

      if (pp.eq.0.) then
        goto 10
      endif

      if (kk.gt.ncyc) then
        print*,' BI-CGStab solver reached maximum nuber of iterations.'
        ier=-1
        return
      endif

c      rnorm = sum(r**2)
      rnorm = 0.

      do i = 1,im*jm
         rnorm = rnorm+r(i)**2
      enddo
      rnorm=sqrt(rnorm)
            
      if (rnorm .gt. tol) goto 1
      return
      end
c
c******************************************************************
c
      subroutine usermv2d(cc,cn,cs,ce,cw,x,y,im,jm)
c
c This routine was lifted from stab.f. Minor modifications have
c been made.
c
c Be careful that the cs are zero on their outer boundary!!
c
      implicit none
c
      integer,intent(in) :: im,jm
      real*8,intent(in) :: cc(im*jm),cn(im*jm)
      real*8,intent(in) :: cs(im*jm),ce(im*jm)
      real*8,intent(in) :: cw(im*jm)
      real*8 :: x(im*jm), y(im*jm)
c     Local variables
      integer :: i, j, k
*
***********************************************************************
*
*
      do i = im+1,im*jm-im-1
         y(i) = cw(i)*x(i-1)
     &        +cc(i)*x(i)
     &        +ce(i)*x(i+1)
     &        +cn(i)*x(i+im)
     &        +cs(i)*x(i-im)
      enddo
c     
      return
      end
      

```

IDAxiOddBrillBH.F:
```
c/*@@
c  @file      IDAxiOddBrillBH.F
c  @date      
c  @author    
c  @desc 
c  
c  @enddesc 
c@@*/

#include "cctk.h" 
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

c/*@@
c  @routine    IDAxiOddBrillBH
c  @date       
c  @author     
c  @desc 
c  
c  @enddesc 
c  @calls     
c  @calledby   
c  @history 
c
c  @endhistory 
c@@*/

      subroutine IDAxiOddBrillBH(CCTK_ARGUMENTS)
      
      implicit none
      
      DECLARE_CCTK_ARGUMENTS
      DECLARE_CCTK_PARAMETERS
      DECLARE_CCTK_FUNCTIONS

      CCTK_REAL deta,dq
      CCTK_REAL, allocatable :: ac(:,:),ae(:,:),aw(:,:),an(:,:),as(:,:),
     $     rhs(:,:),qfetaeta(:,:),qfqq(:,:),ksq(:,:), 
     $     psi2dv(:,:),dpsi2dv(:,:),ddpsi2dv(:,:),
     $     detapsisph(:,:),dqpsisph(:,:),detaetapsisph(:,:),
     $     detaqpsisph(:,:),dqqpsisph(:,:),
     $     etagrd(:),qgrd(:)
      CCTK_REAL o1,o2,o3,o4,o5,o6,o7,o8,o9,o10,
     $     o11,o12,o13,o14,o15,o16,o17,o18,o19,
     $     o20,o21,o22,o23,o24,o25,o26,o27,o28,o29,
     $     o30,o31,o32,o33,o34,o35,o36,o37,o38,o39,
     $     o40,o41,o42,o43,o44,o45,o46,o47,o48,o49,
     $     o50,o51
      CCTK_REAL t1,t2,t3,t4
      CCTK_REAL gtil,dngtil,dnngtil,dnnngtil,dnnnngtil,dnnnnngtil,
     $     dnnnnnngtil,dnnnnnnngtil
      CCTK_REAL rhsmax,rmax,odd_get2d,adm,Jmom,mass,a,r_iso,rBL,rbh_eps
      CCTK_REAL,parameter :: rbh_tol = 1.0d-7
      integer,parameter :: itmax = 100 
      CCTK_REAL pi,zero,one,two
      CCTK_REAL :: xmin,xmax,ymin,ymax,zmin,zmax
      integer :: ne, nq
      integer :: nx,ny,nz
      integer :: i,j,k,it,ier,nquads,ntries
      integer :: npoints,handle,ierror
      integer make_conformal_derivs

      integer       param_table_handle, interp_handle
      character(30) options_string
      CCTK_REAL,    dimension(2) :: coord_origin, coord_delta
      CCTK_POINTER, dimension(2) :: interp_coords
      CCTK_POINTER, dimension(6) :: in_arrays, out_arrays
      CCTK_INT,     dimension(2) :: in_array_dims
      CCTK_INT,     dimension(6), parameter :: type_codes = CCTK_VARIABLE_REAL


      rbh_eps = 1.0d-10
      pi = 4.0d0*atan(1.0d0)
c     DO NOT use integer*4
      ne = neta
      nq = ntheta

c     Set up the grid spacings
      nx = cctk_lsh(1)
      ny = cctk_lsh(2)
      nz = cctk_lsh(3)      

c     Get parameters
c     --------------
      if (brandt_seidel == 1) then
         write(*,*) '"Solve Bradt-Seidel Initial Data Sets"'
      endif

      write(*,*) 'Brill Wave: amplitude for K :',amp
      write(*,*) 'Brill Wave: center for K:',eta0
      write(*,*) 'Brill Wave: sigma for K:',sigma
      write(*,*) 'Bowen & York Momenta:  :',byJ
      write(*,*) 'Brill Wave: sin^n theta for K:',n

      write(*,*) 'Brill Wave: amplitude for g :',amp_me
      write(*,*) 'Brill Wave: center for g:',eta0_me
      write(*,*) 'Brill Wave: sigma for g:',sigma_me
      write(*,*) 'Brill Wave: sin^n theta for g:',n_me


c Check if we should create and store conformal factor stuff
      
      if (CCTK_EQUALS(metric_type, "static conformal")) then
     
         conformal_state = 1
     
         if(CCTK_EQUALS(conformal_storage,"factor+derivs")) then  
     
            conformal_state = 2
            make_conformal_derivs = 1
      
          else if (CCTK_EQUALS(conformal_storage,"factor+derivs+2nd derivs")) then
     
            conformal_state = 3
            make_conformal_derivs = 1

          endif

       else

         make_conformal_derivs = 0
      
       endif

c      conformal_state = CONFORMAL_METRIC

c     Sovle on this sized cartesian grid
c     3D grid size NE x NT x NP
c     Add 2 zones for eta coordinate and 4 for theta
      ne = ne+2
      nq = nq+2
c     
      allocate(ac(ne,nq),ae(ne,nq),aw(ne,nq),an(ne,nq),as(ne,nq),
     $     rhs(ne,nq),qfetaeta(ne,nq),qfqq(ne,nq),ksq(ne,nq),
     $     psi2dv(ne,nq),dpsi2dv(ne,nq),
     $     ddpsi2dv(ne,nq),detapsisph(ne,nq),dqpsisph(ne,nq),
     $     detaetapsisph(ne,nq),detaqpsisph(ne,nq),dqqpsisph(ne,nq),
     $     etagrd(ne),qgrd(nq))
c     
c     Initialize some array
c     
      nquads = 2      
      dq = nquads*0.5*pi/(nq-2)
      deta = etamax/(ne-3)
      
      do j = 1,nq
         qgrd(j) = (j-1.5)*dq
      enddo
      do i=1,ne
         etagrd(i) = (i-2)*deta
      enddo
c     
c Initialize q-function and its derivatives: should be generalized
c     
       do j = 1,nq
          do i = 1,ne
#include "qfunc_even.x"
          enddo
       enddo


c     
c     Specify the initial guess for the conformal factor:
c     
      dpsi2dv = 0.
      ddpsi2dv = 0.
      do j = 1,nq
         do i = 1,ne
            psi2dv(i,j) = 2.*cosh(0.5*etagrd(i))
         enddo
      enddo
c     
c     Compute K^2:
c     
      do j = 1,nq
         do i = 1,ne
#include "gauss.x"
            if(brandt_seidel == 1) then
#include "ksq_bs.x"
	    else if (sergio == 1) then
#include "kerr.x"
#include "ksq_sergio.x"
            else
#include "ksq_axi_rdbh.x"
            endif
         enddo
      enddo
c     
c     Solve the Hamiltonian constraint for the conformal factor:
c     

      ntries = 0

      do it = 1,itmax+1
         
         ac = 0.
         ae = 0.
         aw = 0.
         an = 0.
         as = 0.
         rhs = 0.

c     
         do j = 2,nq-1
            do i = 2,ne-1
               rhs(i,j) =
     $              (dpsi2dv(i+1,j)-2.*dpsi2dv(i,j)+dpsi2dv(i-1,j))/
     $              deta**2+(dpsi2dv(i,j+1)-2.*dpsi2dv(i,j)+
     $              dpsi2dv(i,j-1))/dq**2+0.5*(dpsi2dv(i,j+1)-
     $              dpsi2dv(i,j-1))/(dq*tan(qgrd(j)))
     $              +0.25*dpsi2dv(i,j)*
     $              (qfetaeta(i,j)+qfqq(i,j)-1.0d0)+
     $              0.125*ksq(i,j)/(psi2dv(i,j)+dpsi2dv(i,j))**7
            enddo
         enddo
c     
         rhs = -rhs
c     
c     See if the residual is small enough:
c     
         rhsmax = 0.
c     
         do j = 2,nq-1
            do i = 2,ne-1
               rhsmax = max(rhsmax,abs(rhs(i,j)))
            enddo
         enddo

         if (verbose == 1) then
            ntries = ntries+1
            print*,'-----------Retry', ntries
            print*,'residual =', rhsmax
            print*,'--------------------------------------------------'
         endif

         if (rhsmax.lt.rbh_tol) goto 110
c     
c     Compute stencil coefficients:
c     
         do j = 2,nq-1
            do i = 2,ne-1
               ac(i,j) = -2./deta**2-2./dq**2-sin(qgrd(j))**2+0.25
     $              *(qfetaeta(i,j)+qfqq(i,j) - 1.0d0)
     $              -0.875*ksq(i,j)/(psi2dv(i,j)+ 
     $              dpsi2dv(i,j))**8
c     
               ae(i,j) = 1./deta**2
c     
               aw(i,j) = 1./deta**2
c     
               an(i,j) = 1./dq**2 + 0.5/(tan(qgrd(j))*dq)
c     
               as(i,j) = 1./dq**2 - 0.5/(tan(qgrd(j))*dq)
c     
            enddo
         enddo
         
c     
c     Apply boundary conditions:
c     
c     i=2:
c     
         do j = 3,nq-2
            ae(2,j) = ae(2,j) + aw(2,j)
            aw(2,j) = 0.
c     
c     i=ne-1:
c     
            ac(ne-1,j) = ac(ne-1,j) + 4.*ae(ne-1,j)/(3.+deta)
            aw(ne-1,j) = aw(ne-1,j) - ae(ne-1,j)/(3.+deta)
            ae(ne-1,j) = 0.
         enddo
c     
c     j=2:
c     
         do i = 3,ne-2
            ac(i,2) = ac(i,2) + as(i,2)
            as(i,2) = 0.
c     
c     j=nq-1:
c     
            ac(i,nq-1) = ac(i,nq-1) + an(i,nq-1)
            an(i,nq-1) = 0.
         enddo
         
c     
c     i=2, j=2:
c     
         ae(2,2) = ae(2,2) + aw(2,2)
         ac(2,2) = ac(2,2) + as(2,2)
         aw(2,2) = 0.
         as(2,2) = 0.
c     
c     i=2, j=nq-1:
c     
         ae(2,nq-1) = ae(2,nq-1) + aw(2,nq-1)
         ac(2,nq-1) = ac(2,nq-1) + an(2,nq-1)
         aw(2,nq-1) = 0.
         an(2,nq-1) = 0.
c     
c     i=ne-1, j=2:
c     
         ac(ne-1,2) = ac(ne-1,2) + 4.*ae(ne-1,2)/(3.+deta) + 
     $        as(ne-1,2)
         aw(ne-1,2) = aw(ne-1,2) - ae(ne-1,2)/(3.+deta)
         ae(ne-1,2) = 0.
         as(ne-1,2) = 0.
c     
c     i=ne-1, j=nq-1:
c     
         ac(ne-1,nq-1) = ac(ne-1,nq-1) + 4.*ae(ne-1,nq-1)/(3.+deta) +
     $        an(ne-1,nq-1)
         aw(ne-1,nq-1) = aw(ne-1,nq-1) - ae(ne-1,nq-1)/(3.+deta)
         ae(ne-1,nq-1) = 0.
         an(ne-1,nq-1) = 0.
c     
         call bicgst2d(ac,ae,aw,an,as,ddpsi2dv,rhs,rbh_eps
     $        ,rmax,ier,ne,nq)
         if (rmax.gt.1.0e-10) then
            write(*,*) '***WARNING: bicgst3d did not converge.'
         endif
         if (ier.eq.-1) then
            write(*,*) '***WARNING: ier=-1'
         endif
         
c     
c     Now, apply boundary conditions to ddpsi2dv:
c     
         do j = 1,nq
            ddpsi2dv(1,j) = ddpsi2dv(3,j)
            ddpsi2dv(ne,j) = (4.*ddpsi2dv(ne-1,j)-ddpsi2dv(ne-2,j))/(3.+deta)
         enddo
         do i = 1,ne
            ddpsi2dv(i,1) = ddpsi2dv(i,2)
            ddpsi2dv(i,nq) = ddpsi2dv(i,nq-1)
         enddo
         do j = 1,nq
            do i = 1,ne
               ddpsi2dv(i,j) = ddpsi2dv(i,j)
               ddpsi2dv(i,j) = ddpsi2dv(i,j)
            enddo
         enddo
c     
c     Update dpsi2dv:
c     
         do j = 1,nq
            do i = 1,ne
               dpsi2dv(i,j) = dpsi2dv(i,j) + ddpsi2dv(i,j)
            enddo
         enddo
         
c     
      enddo
c     
      write(*,*) 'It did not converge.'
      stop
c     
 110  continue
      write(*,*) '--------------------------------------------------'
      print*,'Converge at Residual = ',rhsmax
c     
c     Here, compute the derivatives of the spherical conformal factor
c     
      do j = 1,nq
         do i = 2,ne-1
            detapsisph(i,j)=0.5*(dpsi2dv(i+1,j)-dpsi2dv(i-1,j))/
     $           deta + sinh(0.5*etagrd(i))
         enddo
         detapsisph(1,j) = -detapsisph(3,j)
      enddo
c     
      do j = 2,nq-1
         do i = 1,ne
            dqpsisph(i,j)=0.5*(dpsi2dv(i,j+1)-dpsi2dv(i,j-1))/dq
         enddo
      enddo
      do i = 1,ne
         dqpsisph(i,1) = -dqpsisph(i,2)
         dqpsisph(i,nq) = -dqpsisph(i,nq-1)
      enddo
      
c     
      do j = 1,nq
         do i = 2,ne-1
            detaetapsisph(i,j)=(dpsi2dv(i+1,j)-2.*dpsi2dv(i,j)+dpsi2dv(i-1,j))/
     $           deta**2 + sqrt(0.25)*cosh(0.5*etagrd(i))
         enddo
         detaetapsisph(1,j) = detaetapsisph(3,j)
      enddo
      
c     
      do j = 2,nq-1
         do i = 1,ne
            detaqpsisph(i,j)=0.5*(detapsisph(i,j+1)-
     $           detapsisph(i,j-1))/dq
         enddo
      enddo
      do i = 1,ne
         detaqpsisph(i,1) = -detaqpsisph(i,2)
         detaqpsisph(i,nq) = -detaqpsisph(i,nq-1)
      enddo
c     
      do j = 2,nq-1
         do i = 1,ne
            dqqpsisph(i,j)=0.5*(dqpsisph(i,j+1)-dqpsisph(i,j-1))/dq
         enddo
      enddo
      do i = 1,ne
         dqqpsisph(i,1) = dqqpsisph(i,2)
         dqqpsisph(i,nq) = dqqpsisph(i,nq-1)
      enddo
c     
      do j = 1,nq
         psi2dv(:,j)=dpsi2dv(:,j)+2.0*cosh(0.5*etagrd)
      enddo
c     
c     Now compute on the Cartesian coordinate.
c     
c     Compute eta,q,phi at the each points of cartesian grid
         
      eta = 0.5 * log(x**2 + y**2 + z**2)
      abseta = abs (eta)
      q = atan2 (sqrt (x**2 + y**2),z)
      phi = atan2 (y, x)
      
      do k = 1,nz
         do j = 1,ny
            do i = 1,nx
      
               if(eta(i,j,k) .lt. 0)then
                  sign_eta(i,j,k) = -1
               else
                  sign_eta(i,j,k) = 1
               endif
            enddo
         enddo
      enddo

     
c     Find the local origin of the spatial coordinates
c     ------------------------------------------------

      npoints = nx*ny*nz

!     Parameter table and interpolator handles.
      options_string = "order = " // char(ichar('0') + interpolation_order)
      call Util_TableCreateFromString (param_table_handle, options_string)
      if (param_table_handle .lt. 0) then
        call CCTK_WARN(0,"Cannot create parameter table for interpolator")
      endif

      call CCTK_InterpHandle (interp_handle, "uniform cartesian")
      if (interp_handle .lt. 0) then
        call CCTK_WARN(0,"Cannot get handle for interpolation ! Forgot to activate an implementation providing interpolation operators ??")
      endif

!     fill in the input/output arrays for the interpolator
      coord_origin(1) = etagrd(1)
      coord_origin(2) = qgrd(1)
      coord_delta(1)  = etagrd(2) - etagrd(1)
      coord_delta(2)  = qgrd(2) - qgrd(1)

      interp_coords(1) = CCTK_PointerTo(abseta)
      interp_coords(2) = CCTK_PointerTo(q)

      in_array_dims(1) = ne; in_array_dims(2) = nq

      in_arrays(1) = CCTK_PointerTo(psi2dv)
      in_arrays(2) = CCTK_PointerTo(detapsisph)
      in_arrays(3) = CCTK_PointerTo(dqpsisph)
      in_arrays(4) = CCTK_PointerTo(detaetapsisph)
      in_arrays(5) = CCTK_PointerTo(detaqpsisph)
      in_arrays(6) = CCTK_PointerTo(dqqpsisph)

      out_arrays(1) = CCTK_PointerTo(psi2d)
      out_arrays(2) = CCTK_PointerTo(detapsi2d)
      out_arrays(3) = CCTK_PointerTo(dqpsi2d)
      out_arrays(4) = CCTK_PointerTo(detaetapsi2d)
      out_arrays(5) = CCTK_PointerTo(detaqpsi2d)
      out_arrays(6) = CCTK_PointerTo(dqqpsi2d)

      call CCTK_InterpLocalUniform (ierror, 2,
     $                              interp_handle, param_table_handle,
     $                              coord_origin, coord_delta,
     $                              npoints, type_codes(1), interp_coords,
     $                              6, in_array_dims, type_codes, in_arrays,
     $                              6, type_codes, out_arrays)

      psi = psi2d * exp(-0.5 * eta)
      detapsi2d = sign_eta * detapsi2d
      detaqpsi2d = sign_eta * detaqpsi2d
  
      do k=1,nz
         do j=1,ny
            do i=1,nx
               
c     psix = \partial psi / \partial x / psi
#include "psi_1st_deriv.x"
               
c     psixx = \partial^2\psi / \partial x^2 / psi
#include "psi_2nd_deriv.x"

            enddo
         enddo
      enddo
      
c     Conformal metric (here, we define conformally flat)
c     gxx = 1...
      
c     Derivatives of the metric
c     dxgxx = 1/2 \partial gxx / \partial x = 0...
c     
      do k= 1,nz
         do j= 1,ny
            do i= 1,nx
#include "gij.x"
            enddo
         enddo
      enddo
c     Extrinsic curvature: Cactus only needs physical extrinsic curvature
      do k= 1,nz
         do j= 1,ny
            do i= 1,nx 
#include "cgauss.x"
               if (brandt_seidel == 1) then
#include "kij_bs.x"
	       else if (sergio == 1) then
#include "ckerr.x"
#include "kij_sergio.x"
               else
#include "kij_axi_rdbh.x"
               endif
            enddo
         enddo
      enddo
      
      kxx = kxx/psi**2
      kxy = kxy/psi**2
      kxz = kxz/psi**2
      kyy = kyy/psi**2
      kyz = kyz/psi**2
      kzz = kzz/psi**2

c     Set ADM mass
      i = ne-15
      adm = 0.0
      do j=2,nq-1
         adm=adm+(psi2dv(i,j)-(psi2dv(i+1,j)-psi2dv(i-1,j))/
     $        deta)*exp(0.5*etagrd(i))
      enddo
      
      adm=adm/(nq-2)
      print *,'ADM mass: ',adm

c     Set Angular momentum
      print*,'Angular momentum parameter: a/m = ', byJ/(adm**2)
c      i = ne-15
c      Jmom = 0.0
c      do j=2,nq-1
c         Jmom=Jmom+psi2dv(i,j)**6*exc31(i,j)*sin(qgrd(j))**3*dq*.5d0
c      enddo
      
c      Jmom=Jmom/(nq-2)**9
c      print *,'Angular momentum: ',Jmom
      
      if (CCTK_Equals(initial_lapse,"schwarz")==1) then 
         write (*,*)"Initial with schwarzschild-like lapse"
         write (*,*)"using alp = (2.*r - adm)/(2.*r+adm)."
         alp = (2.*r - adm)/(2.*r+adm)
      endif
      
      deallocate(ac,ae,aw,an,as,rhs,qfetaeta,qfqq,
     $     ksq,psi2dv,dpsi2dv,ddpsi2dv,
     $     detapsisph,dqpsisph,detaetapsisph,detaqpsisph,dqqpsisph,
     $     etagrd,qgrd)
      
      return
      end
      

```

qfunc_even.x:
```
        o1 = -xi
        o2 = cos(qgrd(j))
        o3 = xi*o2
        o4 = 1.0 + o1 + o3
        o5 = -eta0_me
        o6 = etagrd(i) + o5
        o7 = o6**2
        o8 = sigma_me**2
        o9 = o8**2
        o10 = 1/o9
        o11 = 1/o8
        o12 = -(o11*o7)
        o13 = exp(o12)
        o14 = eta0_me + etagrd(i)
        o15 = o14**2
        o16 = -(o11*o15)
        o17 = exp(o16)
        o18 = sin(qgrd(j))
        o19 = o18**n_me
        o20 = o2**2
        o21 = o13 + o17
        qfetaeta(i,j) = amp_me*o19*o4*(-2.0*o11*o13 - 2.0*o11*o17 + 4.0*o10*o15*o
     &  17 + 4.0*o10*o13*o7)
        qfqq(i,j) = -(amp_me*xi*n_me*o19*o2*o21) - amp_me*xi*(1.0 + n_me)*o19*o2*o21 -
     &   amp_me*n_me*o19*o21*o4 + amp_me*(-1.0 + n_me)*n_me*o18**(-2 + n)*o20*o21*o
     &  4

```

ckerr.x:
```
        mass = sqrt(2.0 + sqrt(4.0 + byJ**2
     &  ))
        a = byJ/mass
        rBL = 5.0e-1*exp(eta(i,j,k))*(1.0 + (1.0*(a
     &   + mass)*exp(-eta(i,j,k)))/sqrt(-a**2 + mass**2))*sqrt(-a**2 + mass**2)
     &  *(1.0 + (1.*(a + mass)*exp(-eta(i,j,k)))/sqrt(a**2 + m
     &  ass**2))

```

psi_1st_deriv.x:
```
        o1 = 5.0000000000000d-1*eta(i,j,k)
        o2 = exp(o1)
        o3 = psi2d(i,j,k)
        o4 = 1/o3
        o5 = cos(phi(i,j,k))
        o6 = cos(q(i,j,k))
        o7 = dqpsi2d(i,j,k)
        o8 = -1.50000000000000d0*eta(i,j,k)
        o9 = exp(o8)
        o10 = detapsi2d(i,j,k)
        o11 = sin(q(i,j,k))
        o12 = sin(phi(i,j,k))
        psix(i,j,k) = o2*o4*(o10*o11*o5*o9 - 5.0000000000000d-1*o11*o3*o
     &  5*o9 + o5*o6*o7*o9)
        psiy(i,j,k) = o2*o4*(o10*o11*o12*o9 - 5.0000000000000d-1*o11*o12
     &  *o3*o9 + o12*o6*o7*o9)
        psiz(i,j,k) = o2*o4*(o10*o6*o9 - 5.0000000000000d-1*o3*o6*o9 - o
     &  11*o7*o9)

```

ksq_bs.x:
```
        o1 = cos(qgrd(j))
        o2 = 1.0
        o3 = o2**2
        o4 = 1/o3
        o5 = sin(qgrd(j))
        o6 = 2.0 + n
        o7 = o5**2
        o8 = -(o6*o7)
        o9 = 1.0 + n + o8
        o10 = o3**2
        o11 = o10**2
        o12 = dngtil**2
        o13 = o1**2
        o14 = gtil**2
        o15 = o9**2
c        exc33(i,j) = 0
c        exc32(i,j) = -(dngtil*o1*o4*o5**n)
c        exc31(i,j) = gtil*o4*o5**(-1.0 + n)*o9
c        exc22(i,j) = 0
c        exc21(i,j) = 0
c        exc11(i,j) = 0
        ksq(i,j) = (2.0*o5**(2*(
     $	-2 + n))*(o14*o15 + o12*o13*o7))/(o10*o11)

```

make.code.defn:
```
# Main make.code.defn file for thorn AxiOddBHWave
# $Header$

# Source files in this directory
SRCS = IDAxiOddBrillBH.F Stab2d.F ParamCheck.c

# Subdirectories containing source files
SUBDIRS = 


```

ksq_sergio.x:
```
        o1 = a**2
        o2 = -2.00000000000000d0*mass*rBL
        o3 = rBL**2
        o4 = o1 + o2 + o3
        o5 = sqrt(o4)
        o6 = cos(qgrd(j))
        o7 = o6**2
        o8 = o1*o7
        o9 = o3 + o8
        o10 = o9**2
        o11 = 1/o10
        o12 = 1.0!psi2dv(eta,q)
        o13 = o12**2
        o14 = 1/o13
        o15 = sin(qgrd(j))
        o16 = o15**2
        o17 = o1 + o3
        o18 = 2.00000000000000d0*o17*o3
        o19 = -o1
        o20 = o19 + o3
        o21 = o20*o9
        o22 = o18 + o21
        o23 = mass**2
        o24 = o10**2
        o25 = 1/o24
        o26 = o22**2
        o27 = o13**2
        o28 = o27**2
        o29 = o27*o28
        o30 = 1/o29
        o31 = o1**2
        o32 = o16**2
c        exc33(i,j) = 0
c        exc32(i,j) = -2.00000000000000d0*a*mass*o1*o11*o14*o15*o16*o5*o6
c     &  *rBL
c        exc31(i,j) = a*mass*o11*o14*o16*o22
c        exc22(i,j) = 0
c        exc21(i,j) = 0
c        exc11(i,j) = 0
        ksq(i,j) = 2.00000000000000d0*o1*o16*o23*o25*o26*o30 + 8.0000000
     &  000000d0*o1*o23*o25*o3*o30*o31*o32*o4*o7

```

gauss2d.x:
```
        gtil = amp*(exp(-((etagrd(i) - eta0)**2/sigma**2)) + exp(-((etagrd(i) + eta0
     &  )**2/sigma**2)))
        dngtil = amp*((-2.00000000000000d0*(etagrd(i) - eta0)*exp(-((etagrd(i) - eta
     &  0)**2/sigma**2)))/sigma**2 - (2.00000000000000d0*(etagrd(i) + eta0)*ex
     &  p(-((etagrd(i) + eta0)**2/sigma**2)))/sigma**2)

```

cgauss.x:
```
        gtil = amp*(exp(-((-eta0 + eta(i,j,k))**2/sigma**2)) + exp(-((eta0 +
     &   eta(i,j,k))**2/sigma**2)))
        dngtil = amp*((-2.00000000000000d0*(-eta0 + eta(i,j,k))*exp(-((-eta0
     &   + eta(i,j,k))**2/sigma**2)))/sigma**2 - (2.00000000000000d0*(eta0 +
     &   eta(i,j,k))*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**2)
        dnngtil = amp*((4.0000000000000d0*(-eta0 + eta(i,j,k))**2*exp(-((-et
     &  a0 + eta(i,j,k))**2/sigma**2)))/sigma**4 - (2.00000000000000d0*exp(-
     &  ((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**2 + (4.0000000000000d0*(
     &  eta0 + eta(i,j,k))**2*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**4 
     &  - (2.00000000000000d0*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma
     &  **2)
        dnnngtil = amp*((-8.0000000000000d0*(-eta0 + eta(i,j,k))**3*exp(-((-
     &  eta0 + eta(i,j,k))**2/sigma**2)))/sigma**6 + (1.20000000000000d1*(-e
     &  ta0 + eta(i,j,k))*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**4 - (
     &  8.0000000000000d0*(eta0 + eta(i,j,k))**3*exp(-((eta0 + eta(i,j,k))**2/si
     &  gma**2)))/sigma**6 + (1.20000000000000d1*(eta0 + eta(i,j,k))*exp(-((
     &  eta0 + eta(i,j,k))**2/sigma**2)))/sigma**4)
        dnnnngtil = amp*((1.60000000000000d1*(-eta0 + eta(i,j,k))**4*exp(-((
     &  -eta0 + eta(i,j,k))**2/sigma**2)))/sigma**8 - (4.8000000000000d1*(-e
     &  ta0 + eta(i,j,k))**2*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**6 
     &  + (1.20000000000000d1*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigm
     &  a**4 + (1.60000000000000d1*(eta0 + eta(i,j,k))**4*exp(-((eta0 + eta(i,j,k)
     &  )**2/sigma**2)))/sigma**8 - (4.8000000000000d1*(eta0 + eta(i,j,k))
     &  **2*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**6 + (1.200000000
     &  00000d1*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**4)
        dnnnnngtil = amp*((-3.2000000000000d1*(-eta0 + eta(i,j,k))**5*exp(-(
     &  (-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**10 + (1.60000000000000d2*
     &  (-eta0 + eta(i,j,k))**3*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma*
     &  *8 - (1.20000000000000d2*(-eta0 + eta(i,j,k))*exp(-((-eta0 + eta(i,j,k))
     &  **2/sigma**2)))/sigma**6 - (3.2000000000000d1*(eta0 + eta(i,j,k))**5
     &  *exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**10 + (1.60000000000
     &  000d2*(eta0 + eta(i,j,k))**3*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/si
     &  gma**8 - (1.20000000000000d2*(eta0 + eta(i,j,k))*exp(-((eta0 + eta(i,j,k)
     &  )**2/sigma**2)))/sigma**6)
        dnnnnnngtil = amp*((6.4000000000000d1*(-eta0 + eta(i,j,k))**6*exp(-(
     &  (-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**12 - (4.8000000000000d2*(
     &  -eta0 + eta(i,j,k))**4*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**
     &  10 + (7.2000000000000d2*(-eta0 + eta(i,j,k))**2*exp(-((-eta0 + eta(i,j,k)
     &  )**2/sigma**2)))/sigma**8 - (1.20000000000000d2*exp(-((-eta0 + 
     &  eta(i,j,k))**2/sigma**2)))/sigma**6 + (6.4000000000000d1*(eta0 + eta(i,j,k)
     &  )**6*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**12 - (4.8000
     &  000000000d2*(eta0 + eta(i,j,k))**4*exp(-((eta0 + eta(i,j,k))**2/sigma**2
     &  )))/sigma**10 + (7.2000000000000d2*(eta0 + eta(i,j,k))**2*exp(-((eta
     &  0 + eta(i,j,k))**2/sigma**2)))/sigma**8 - (1.20000000000000d2*exp(-(
     &  (eta0 + eta(i,j,k))**2/sigma**2)))/sigma**6)
        dnnnnnnngtil = amp*((-1.28000000000000d2*(-eta0 + eta(i,j,k))**7*exp
     &  (-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**14 + (1.34400000000000
     &  d3*(-eta0 + eta(i,j,k))**5*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sig
     &  ma**12 - (3.3600000000000d3*(-eta0 + eta(i,j,k))**3*exp(-((-eta0 + e
     &  ta(i,j,k))**2/sigma**2)))/sigma**10 + (1.68000000000000d3*(-eta0 + e
     &  ta(i,j,k))*exp(-((-eta0 + eta(i,j,k))**2/sigma**2)))/sigma**8 - (1.28000
     &  000000000d2*(eta0 + eta(i,j,k))**7*exp(-((eta0 + eta(i,j,k))**2/sigma**2
     &  )))/sigma**14 + (1.34400000000000d3*(eta0 + eta(i,j,k))**5*exp(-((et
     &  a0 + eta(i,j,k))**2/sigma**2)))/sigma**12 - (3.3600000000000d3*(eta0
     &   + eta(i,j,k))**3*exp(-((eta0 + eta(i,j,k))**2/sigma**2)))/sigma**10 + (
     &  1.68000000000000d3*(eta0 + eta(i,j,k))*exp(-((eta0 + eta(i,j,k))**2/sigm
     &  a**2)))/sigma**8)

```

kij_sergio.x:
```
        o1 = a**2
        o2 = a*o1
        o3 = -2.00000000000000d0*mass*rBL
        o4 = rBL**2
        o5 = o1 + o3 + o4
        o6 = sqrt(o5)
        o7 = cos(phi(i,j,k))
        o8 = cos(q(i,j,k))
        o9 = o8**2
        o10 = o1*o9
        o11 = o10 + o4
        o12 = o11**2
        o13 = 1/o12
        o14 = -3.00000000000000d0*eta(i,j,k)
        o15 = exp(o14)
        o16 = sin(phi(i,j,k))
        o17 = sin(q(i,j,k))
        o18 = o17**2
        o19 = o1 + o4
        o20 = 2.00000000000000d0*o19*o4
        o21 = -o1
        o22 = o21 + o4
        o23 = o11*o22
        o24 = o20 + o23
        o25 = o7**2
        o26 = o16**2
        o27 = o17*o18
        kxx(i,j,k) = -2.00000000000000d0*a*mass*o13*o15*o16*o18*o24*o7 +
     &   4.0000000000000d0*mass*o13*o15*o16*o18*o2*o6*o7*o9*rBL
        kxy(i,j,k) = a*mass*o13*o15*o18*o24*o25 - a*mass*o13*o15*o18*o24
     &  *o26 - 2.00000000000000d0*mass*o13*o15*o18*o2*o25*o6*o9*rBL + 2.
     &  00000000000000d0*mass*o13*o15*o18*o2*o26*o6*o9*rBL
        kxz(i,j,k) = -(a*mass*o13*o15*o16*o17*o24*o8) - 2.00000000000000
     &  d0*mass*o13*o15*o16*o2*o27*o6*o8*rBL
        kyy(i,j,k) = 2.00000000000000d0*a*mass*o13*o15*o16*o18*o24*o7 - 
     &  4.0000000000000d0*mass*o13*o15*o16*o18*o2*o6*o7*o9*rBL
        kyz(i,j,k) = a*mass*o13*o15*o17*o24*o7*o8 + 2.00000000000000d0*m
     &  ass*o13*o15*o2*o27*o6*o7*o8*rBL
        kzz(i,j,k) = 0

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn IDAxiOddBrillBH
Authors    : Ryoji Takahashi 
CVS info   : $Header$
--------------------------------------------------------------------------

This thorn does calculates initial data for a black hole distorted
by a axisymmetric odd parity perturbation 


```



Reference answer:
src_code:         o1 = cos(qgrd(j))
        o2 = 2.00000000000000d0*qgrd(j)
        o3 = cos(o2)
        o4 = dnnnnngtil
        o5 = sin(qgrd(j))
        o6 = o5**2
        o7 = o5*o6
        o8 = dnnngtil
        o9 = dngtil
        o10 = dnnnnnnngtil
        o11 = o6**2
        o12 = 4.0000000000000d0*qgrd(j)
        o13 = cos(o12)
        o14 = dnnnngtil
        o15 = dnngtil
        o16 = o1**2
        o17 = dnnnnnngtil
        o18 = o11*o6
        o19 = gtil
        o20 = byJ**2
        o21 = o14**2
        o22 = o3**2
        o23 = o13**2
        o24 = o15**2
        o25 = o4**2
        o26 = o8**2
        o27 = o9**2
        o28 = o16**2
        o29 = o17**2
        o30 = o10**2
        o31 = o11**2
        o32 = o31*o6
        o33 = o19**2
        t1 = 2.88000000000000d1*byJ*o11*o16*o17 + 1.00800000000000d1*o11*o
     &  14*o16*o17 + 9.7440000000000d1*o11*o13*o14*o16*o17 - 6.660000000
     &  0000d1*o11*o15*o16*o17 - 3.4860000000000d2*o11*o13*o15*o16*o17 -
     &   4.8000000000000d0*byJ*o17*o18 - 1.68000000000000d0*o14*o17*o18 - 
     &  1.62400000000000d1*o13*o14*o17*o18 + 1.11000000000000d1*o15*o17*
     &  o18 + 5.8100000000000d1*o13*o15*o17*o18 - 1.80000000000000d2*byJ*o
     &  11*o19 - 6.3000000000000d1*o11*o14*o19 - 6.0900000000000d2*o11*o
     &  13*o14*o19 + 4.1625000000000d2*o11*o15*o19 + 2.17875000000000d3*
     &  o11*o13*o15*o19 - 2.70000000000000d3*byJ*o11*o16*o19 - 9.450000000
     &  0000d2*o11*o14*o16*o19 - 9.1350000000000d3*o11*o13*o14*o16*o19 +
     &   6.2437500000000d3*o11*o15*o16*o19 + 3.2681250000000d4*o11*o13*o
     &  15*o16*o19 + 4.5000000000000d2*byJ*o18*o19 + 1.57500000000000d2*o1
     &  4*o18*o19 + 1.52250000000000d3*o13*o14*o18*o19 - 1.0406250000000
     &  0d3*o15*o18*o19 - 5.4468750000000d3*o13*o15*o18*o19 - 2.40000000
     &  000000d2*o16*o17*o18*o19 + 9.6800000000000d0*o11*o16*o25
        t2 = 6.7280000000000d1*o11*o16*o22*o25 + 6.6125000000000d1*o11*o
     &  16*o26 + 8.6112500000000d2*o11*o16*o22*o26 + 2.81250000000000d1*
     &  o11*o16*o27 + 7.0312500000000d2*o11*o16*o22*o27 + 5.760000000000
     &  0d2*o11*o17*o19*o28 - 2.16000000000000d3*o17*o18*o19*o28 + 1.152
     &  00000000000d1*o18*o28*o29 + 3.07200000000000d1*o11*o14*o16*o17*o
     &  3 - 1.60800000000000d2*o11*o15*o16*o17*o3 - 5.1200000000000d0*o1
     &  4*o17*o18*o3 + 2.68000000000000d1*o15*o17*o18*o3 - 1.92000000000
     &  000d2*o11*o14*o19*o3 + 1.00500000000000d3*o11*o15*o19*o3 - 2.880
     &  00000000000d3*o11*o14*o16*o19*o3 + 1.50750000000000d4*o11*o15*o1
     &  6*o19*o3 + 4.8000000000000d2*o14*o18*o19*o3 - 2.51250000000000d3
     &  *o15*o18*o19*o3 - 5.1040000000000d1*o11*o16*o25*o3 - 4.772500000
     &  0000d2*o11*o16*o26*o3 - 2.81250000000000d2*o11*o16*o27*o3 + 2.40
     &  000000000000d1*o17*o19*o31 + 7.2000000000000d2*o16*o17*o19*o31 -
     &   3.8400000000000d0*o16*o29*o31 + 3.2000000000000d-1*o16*o30*o31 
     &  - 6.0000000000000d1*o17*o19*o32 + 3.2000000000000d-1*o29*o32 - 3
     &  .6000000000000d3*o11*o16*o33
        t3 = 4.5000000000000d2*o18*o33 + 2.25000000000000d4*o16*o18*o33 
     &  - 5.4000000000000d4*o11*o28*o33 + 1.01250000000000d5*o18*o28*o33
     &   - 2.25000000000000d3*o31*o33 - 3.3750000000000d4*o16*o31*o33 + 
     &  2.81250000000000d3*o32*o33 - 3.5200000000000d0*o10*o16*o18*o4 + 
     &  9.2800000000000d0*o10*o16*o18*o3*o4 + 1.26000000000000d1*byJ*o14*o
     &  6 + 1.21800000000000d2*byJ*o13*o14*o6 - 8.3250000000000d1*byJ*o15*o6
     &   - 4.3575000000000d2*byJ*o13*o15*o6 - 2.91375000000000d1*o14*o15*o
     &  6 - 4.3417500000000d2*o13*o14*o15*o6 + 7.2000000000000d2*byJ*o16*o
     &  19*o6 + 2.52000000000000d2*o14*o16*o19*o6 + 2.43600000000000d3*o
     &  13*o14*o16*o19*o6 - 1.66500000000000d3*o15*o16*o19*o6 - 8.715000
     &  0000000d3*o13*o15*o16*o19*o6 + 1.80000000000000d1*o20*o6 + 2.205
     &  00000000000d0*o21*o6 + 4.2630000000000d1*o13*o21*o6 - 2.14400000
     &  000000d2*o14*o15*o22*o6 + 2.04800000000000d1*o21*o22*o6 - 1.4742
     &  8750000000d3*o14*o15*o23*o6 + 2.06045000000000d2*o21*o23*o6
        t4 = 9.6257812500000d1*o24*o6 + 1.00767187500000d3*o13*o24*o6 + 
     &  5.6112500000000d2*o22*o24*o6 + 2.63719531250000d3*o23*o24*o6 + 3
     &  .8400000000000d1*byJ*o14*o3*o6 - 2.01000000000000d2*byJ*o15*o3*o6 - 
     &  1.59150000000000d2*o14*o15*o3*o6 - 1.14485000000000d3*o13*o14*o1
     &  5*o3*o6 + 7.6800000000000d2*o14*o16*o19*o3*o6 - 4.0200000000000d
     &  3*o15*o16*o19*o3*o6 + 1.34400000000000d1*o21*o3*o6 + 1.299200000
     &  00000d2*o13*o21*o3*o6 + 4.6481250000000d2*o24*o3*o6 + 2.43293750
     &  000000d3*o13*o24*o3*o6 + 7.2000000000000d3*o28*o33*o6 + 9.200000
     &  0000000d0*o10*o16*o18*o8 - 3.3200000000000d1*o10*o16*o18*o3*o8 -
     &   5.0600000000000d1*o11*o16*o4*o8 - 4.8140000000000d2*o11*o16*o22
     &  *o4*o8 + 3.16000000000000d2*o11*o16*o3*o4*o8 - 6.0000000000000d0
     &  *o10*o16*o18*o9 + 3.00000000000000d1*o10*o16*o18*o3*o9 + 3.30000
     &  00000000d1*o11*o16*o4*o9 + 4.3500000000000d2*o11*o16*o22*o4*o9 -
     &   2.52000000000000d2*o11*o16*o3*o4*o9 - 8.6250000000000d1*o11*o16
     &  *o8*o9 - 1.55625000000000d3*o11*o16*o22*o8*o9 + 7.4250000000000d
     &  2*o11*o16*o3*o8*o9
        ksq(i,j) = t1 + t2 + t3 + t4