














































c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c




































































 


































































































































































 


















































































































































































































 



















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                




















































































c
c

c
c
c
c
c
c

c
c
c
c
c

c

c
c
c
c
c
c
c
c
c
c
c
c

c







c

c

c
c

c




c

      subroutine Exact__metric(
     $     decoded_exact_model,
     $     x, y, z, t,
     $     gdtt, gdtx, gdty, gdtz,
     $     gdxx, gdyy, gdzz, gdxy, gdyz, gdxz,
     $     gutt, gutx, guty, gutz,
     $     guxx, guyy, guzz, guxy, guyz, guxz,
     $     psi)

      implicit none
      interface
      integer*8 function CCTK_PointerTo (var)
      implicit none
      type(*),dimension(..),TARGET :: var
      end function CCTK_PointerTo
      end interface
      interface
      integer function CCTK_Equals (arg1, arg2)
      implicit none
      integer*8 arg1
      character(*) arg2
      end function CCTK_Equals
      integer function CCTK_MyProc (cctkGH)
      implicit none
      integer*8 cctkGH
      end function CCTK_MyProc
      integer function CCTK_nProcs (cctkGH)
      implicit none
      integer*8 cctkGH
      end function CCTK_nProcs
      integer function CCTK_IsThornActive (name)
      implicit none
      character(*) name
      end function CCTK_IsThornActive
      integer*8 function CCTK_NullPointer ()
      implicit none
      end function CCTK_NullPointer
      end interface
      interface
      INTEGER*4 function Boundary_RegisterPhysicalBC (GH, function_point
     &er, bc_name)
      implicit none
      integer*8 GH
      external function_pointer
      INTEGER*4 function_pointer
      character(*) bc_name
      end function Boundary_RegisterPhysicalBC
      end interface
      interface
      INTEGER*4 function Boundary_SelectGroupForBC (GH, faces, boundary_
     &width, table_handle, group_name, bc_name)
      implicit none
      integer*8 GH
      INTEGER*4 faces
      INTEGER*4 boundary_width
      INTEGER*4 table_handle
      character(*) group_name
      character(*) bc_name
      end function Boundary_SelectGroupForBC
      end interface
      interface
      INTEGER*4 function Driver_NotifyDataModified (cctkGH, variables, t
     &ls, nvariables, where)
      implicit none
      integer*8 cctkGH
      INTEGER*4 variables(*)
      INTEGER*4 tls(*)
      INTEGER*4 nvariables
      INTEGER*4 where(*)
      end function Driver_NotifyDataModified
      end interface
      interface
      INTEGER*4 function Driver_RequireValidData (cctkGH, variables, tls
     &, nvariables, where)
      implicit none
      integer*8 cctkGH
      INTEGER*4 variables(*)
      INTEGER*4 tls(*)
      INTEGER*4 nvariables
      INTEGER*4 where(*)
      end function Driver_RequireValidData
      end interface
      REAL*8 Alvi__mass1
      integer, parameter :: cctki_use_Alvi__mass1 = kind(Alvi__mass1)
      REAL*8 Alvi__mass2
      integer, parameter :: cctki_use_Alvi__mass2 = kind(Alvi__mass2)
      REAL*8 Alvi__separation
      integer, parameter :: cctki_use_Alvi__separation = kind(Alvi__sepa
     &ration)
      REAL*8 Bertotti__Lambda
      integer, parameter :: cctki_use_Bertotti__Lambda = kind(Bertotti__
     &Lambda)
      REAL*8 Bianchi_I__scale
      integer, parameter :: cctki_use_Bianchi_I__scale = kind(Bianchi_I_
     &_scale)
      REAL*8 Goedel__scale
      integer, parameter :: cctki_use_Goedel__scale = kind(Goedel__scale
     &)
      REAL*8 Gowdy_wave__amplitude
      integer, parameter :: cctki_use_Gowdy_wave__amplitude = kind(Gowdy
     &_wave__amplitude)
      REAL*8 Kasner_generalized__p1
      integer, parameter :: cctki_use_Kasner_generalized__p1 = kind(Kasn
     &er_generalized__p1)
      REAL*8 Kasner_generalized__p2
      integer, parameter :: cctki_use_Kasner_generalized__p2 = kind(Kasn
     &er_generalized__p2)
      REAL*8 Kasner_like__q
      integer, parameter :: cctki_use_Kasner_like__q = kind(Kasner_like_
     &_q)
      REAL*8 Kerr_BoyerLindquist__mass
      integer, parameter :: cctki_use_Kerr_BoyerLindquist__mass = kind(K
     &err_BoyerLindquist__mass)
      REAL*8 Kerr_BoyerLindquist__spin
      integer, parameter :: cctki_use_Kerr_BoyerLindquist__spin = kind(K
     &err_BoyerLindquist__spin)
      REAL*8 Kerr_KerrSchild__boost_v
      integer, parameter :: cctki_use_Kerr_KerrSchild__boost_v = kind(Ke
     &rr_KerrSchild__boost_v)
      REAL*8 Kerr_KerrSchild__epsilon
      integer, parameter :: cctki_use_Kerr_KerrSchild__epsilon = kind(Ke
     &rr_KerrSchild__epsilon)
      REAL*8 Kerr_KerrSchild__mass
      integer, parameter :: cctki_use_Kerr_KerrSchild__mass = kind(Kerr_
     &KerrSchild__mass)
      REAL*8 Kerr_KerrSchild__spin
      integer, parameter :: cctki_use_Kerr_KerrSchild__spin = kind(Kerr_
     &KerrSchild__spin)
      REAL*8 Kerr_KerrSchild__t
      integer, parameter :: cctki_use_Kerr_KerrSchild__t = kind(Kerr_Ker
     &rSchild__t)
      REAL*8 Kerr_KerrSchild__x
      integer, parameter :: cctki_use_Kerr_KerrSchild__x = kind(Kerr_Ker
     &rSchild__x)
      REAL*8 Kerr_KerrSchild__y
      integer, parameter :: cctki_use_Kerr_KerrSchild__y = kind(Kerr_Ker
     &rSchild__y)
      REAL*8 Kerr_KerrSchild__z
      integer, parameter :: cctki_use_Kerr_KerrSchild__z = kind(Kerr_Ker
     &rSchild__z)
      REAL*8 Lemaitre__Lambda
      integer, parameter :: cctki_use_Lemaitre__Lambda = kind(Lemaitre__
     &Lambda)
      REAL*8 Lemaitre__R0
      integer, parameter :: cctki_use_Lemaitre__R0 = kind(Lemaitre__R0)
      REAL*8 Lemaitre__epsilon0
      integer, parameter :: cctki_use_Lemaitre__epsilon0 = kind(Lemaitre
     &__epsilon0)
      REAL*8 Lemaitre__kappa
      integer, parameter :: cctki_use_Lemaitre__kappa = kind(Lemaitre__k
     &appa)
      REAL*8 Minkowski_conf_wave__amplitude
      integer, parameter :: cctki_use_Minkowski_conf_wave__amplitude = k
     &ind(Minkowski_conf_wave__amplitude)
      REAL*8 Minkowski_conf_wave__wavelength
      integer, parameter :: cctki_use_Minkowski_conf_wave__wavelength = 
     &kind(Minkowski_conf_wave__wavelength)
      REAL*8 Minkowski_funny__amplitude
      integer, parameter :: cctki_use_Minkowski_funny__amplitude = kind(
     &Minkowski_funny__amplitude)
      REAL*8 Minkowski_funny__sigma
      integer, parameter :: cctki_use_Minkowski_funny__sigma = kind(Mink
     &owski_funny__sigma)
      REAL*8 Minkowski_gauge_wave__amplitude
      integer, parameter :: cctki_use_Minkowski_gauge_wave__amplitude = 
     &kind(Minkowski_gauge_wave__amplitude)
      REAL*8 Minkowski_gauge_wave__lambda
      integer, parameter :: cctki_use_Minkowski_gauge_wave__lambda = kin
     &d(Minkowski_gauge_wave__lambda)
      REAL*8 Minkowski_gauge_wave__omega
      integer, parameter :: cctki_use_Minkowski_gauge_wave__omega = kind
     &(Minkowski_gauge_wave__omega)
      REAL*8 Minkowski_gauge_wave__phase
      integer, parameter :: cctki_use_Minkowski_gauge_wave__phase = kind
     &(Minkowski_gauge_wave__phase)
      REAL*8 Minkowski_shift__amplitude
      integer, parameter :: cctki_use_Minkowski_shift__amplitude = kind(
     &Minkowski_shift__amplitude)
      REAL*8 Minkowski_shift__sigma
      integer, parameter :: cctki_use_Minkowski_shift__sigma = kind(Mink
     &owski_shift__sigma)
      REAL*8 Schwarzschild_BL__epsilon
      integer, parameter :: cctki_use_Schwarzschild_BL__epsilon = kind(S
     &chwarzschild_BL__epsilon)
      REAL*8 Schwarzschild_BL__mass
      integer, parameter :: cctki_use_Schwarzschild_BL__mass = kind(Schw
     &arzschild_BL__mass)
      REAL*8 Schwarzschild_EF__epsilon
      integer, parameter :: cctki_use_Schwarzschild_EF__epsilon = kind(S
     &chwarzschild_EF__epsilon)
      REAL*8 Schwarzschild_EF__mass
      integer, parameter :: cctki_use_Schwarzschild_EF__mass = kind(Schw
     &arzschild_EF__mass)
      REAL*8 Schwarzschild_Lemaitre__Lambda
      integer, parameter :: cctki_use_Schwarzschild_Lemaitre__Lambda = k
     &ind(Schwarzschild_Lemaitre__Lambda)
      REAL*8 Schwarzschild_Lemaitre__mass
      integer, parameter :: cctki_use_Schwarzschild_Lemaitre__mass = kin
     &d(Schwarzschild_Lemaitre__mass)
      REAL*8 Schwarzschild_Novikov__epsilon
      integer, parameter :: cctki_use_Schwarzschild_Novikov__epsilon = k
     &ind(Schwarzschild_Novikov__epsilon)
      REAL*8 Schwarzschild_Novikov__mass
      integer, parameter :: cctki_use_Schwarzschild_Novikov__mass = kind
     &(Schwarzschild_Novikov__mass)
      REAL*8 Schwarzschild_PG__epsilon
      integer, parameter :: cctki_use_Schwarzschild_PG__epsilon = kind(S
     &chwarzschild_PG__epsilon)
      REAL*8 Schwarzschild_PG__mass
      integer, parameter :: cctki_use_Schwarzschild_PG__mass = kind(Schw
     &arzschild_PG__mass)
      REAL*8 Thorne_fakebinary__Omega0
      integer, parameter :: cctki_use_Thorne_fakebinary__Omega0 = kind(T
     &horne_fakebinary__Omega0)
      REAL*8 Thorne_fakebinary__epsilon
      integer, parameter :: cctki_use_Thorne_fakebinary__epsilon = kind(
     &Thorne_fakebinary__epsilon)
      REAL*8 Thorne_fakebinary__mass
      integer, parameter :: cctki_use_Thorne_fakebinary__mass = kind(Tho
     &rne_fakebinary__mass)
      REAL*8 Thorne_fakebinary__separation
      integer, parameter :: cctki_use_Thorne_fakebinary__separation = ki
     &nd(Thorne_fakebinary__separation)
      REAL*8 Thorne_fakebinary__smoothing
      integer, parameter :: cctki_use_Thorne_fakebinary__smoothing = kin
     &d(Thorne_fakebinary__smoothing)
      REAL*8 anti_de_Sitter_Lambda__scale
      integer, parameter :: cctki_use_anti_de_Sitter_Lambda__scale = kin
     &d(anti_de_Sitter_Lambda__scale)
      REAL*8 boost_rotation_symmetric__amp
      integer, parameter :: cctki_use_boost_rotation_symmetric__amp = ki
     &nd(boost_rotation_symmetric__amp)
      REAL*8 boost_rotation_symmetric__min_d
      integer, parameter :: cctki_use_boost_rotation_symmetric__min_d = 
     &kind(boost_rotation_symmetric__min_d)
      REAL*8 boost_rotation_symmetric__scale
      integer, parameter :: cctki_use_boost_rotation_symmetric__scale = 
     &kind(boost_rotation_symmetric__scale)
      REAL*8 bowl__center
      integer, parameter :: cctki_use_bowl__center = kind(bowl__center)
      REAL*8 bowl__sigma
      integer, parameter :: cctki_use_bowl__sigma = kind(bowl__sigma)
      REAL*8 bowl__sigma_t
      integer, parameter :: cctki_use_bowl__sigma_t = kind(bowl__sigma_t
     &)
      REAL*8 bowl__strength
      integer, parameter :: cctki_use_bowl__strength = kind(bowl__streng
     &th)
      REAL*8 bowl__t0
      integer, parameter :: cctki_use_bowl__t0 = kind(bowl__t0)
      REAL*8 bowl__x_scale
      integer, parameter :: cctki_use_bowl__x_scale = kind(bowl__x_scale
     &)
      REAL*8 bowl__y_scale
      integer, parameter :: cctki_use_bowl__y_scale = kind(bowl__y_scale
     &)
      REAL*8 bowl__z_scale
      integer, parameter :: cctki_use_bowl__z_scale = kind(bowl__z_scale
     &)
      REAL*8 constant_density_star__mass
      integer, parameter :: cctki_use_constant_density_star__mass = kind
     &(constant_density_star__mass)
      REAL*8 constant_density_star__radius
      integer, parameter :: cctki_use_constant_density_star__radius = ki
     &nd(constant_density_star__radius)
      REAL*8 de_Sitter_Lambda__scale
      integer, parameter :: cctki_use_de_Sitter_Lambda__scale = kind(de_
     &Sitter_Lambda__scale)
      REAL*8 de_Sitter__scale
      integer, parameter :: cctki_use_de_Sitter__scale = kind(de_Sitter_
     &_scale)
      REAL*8 multi_BH__Hubble
      integer, parameter :: cctki_use_multi_BH__Hubble = kind(multi_BH__
     &Hubble)
      REAL*8 multi_BH__mass1
      integer, parameter :: cctki_use_multi_BH__mass1 = kind(multi_BH__m
     &ass1)
      REAL*8 multi_BH__mass2
      integer, parameter :: cctki_use_multi_BH__mass2 = kind(multi_BH__m
     &ass2)
      REAL*8 multi_BH__mass3
      integer, parameter :: cctki_use_multi_BH__mass3 = kind(multi_BH__m
     &ass3)
      REAL*8 multi_BH__mass4
      integer, parameter :: cctki_use_multi_BH__mass4 = kind(multi_BH__m
     &ass4)
      REAL*8 multi_BH__x1
      integer, parameter :: cctki_use_multi_BH__x1 = kind(multi_BH__x1)
      REAL*8 multi_BH__x2
      integer, parameter :: cctki_use_multi_BH__x2 = kind(multi_BH__x2)
      REAL*8 multi_BH__x3
      integer, parameter :: cctki_use_multi_BH__x3 = kind(multi_BH__x3)
      REAL*8 multi_BH__x4
      integer, parameter :: cctki_use_multi_BH__x4 = kind(multi_BH__x4)
      REAL*8 multi_BH__y1
      integer, parameter :: cctki_use_multi_BH__y1 = kind(multi_BH__y1)
      REAL*8 multi_BH__y2
      integer, parameter :: cctki_use_multi_BH__y2 = kind(multi_BH__y2)
      REAL*8 multi_BH__y3
      integer, parameter :: cctki_use_multi_BH__y3 = kind(multi_BH__y3)
      REAL*8 multi_BH__y4
      integer, parameter :: cctki_use_multi_BH__y4 = kind(multi_BH__y4)
      REAL*8 multi_BH__z1
      integer, parameter :: cctki_use_multi_BH__z1 = kind(multi_BH__z1)
      REAL*8 multi_BH__z2
      integer, parameter :: cctki_use_multi_BH__z2 = kind(multi_BH__z2)
      REAL*8 multi_BH__z3
      integer, parameter :: cctki_use_multi_BH__z3 = kind(multi_BH__z3)
      REAL*8 multi_BH__z4
      integer, parameter :: cctki_use_multi_BH__z4 = kind(multi_BH__z4)
      integer*8 Minkowski_gauge_wave__what_fn
      integer, parameter :: cctki_use_Minkowski_gauge_wave__what_fn = ki
     &nd(Minkowski_gauge_wave__what_fn)
      integer*8 Thorne_fakebinary__atype
      integer, parameter :: cctki_use_Thorne_fakebinary__atype = kind(Th
     &orne_fakebinary__atype)
      integer*8 bowl__shape
      integer, parameter :: cctki_use_bowl__shape = kind(bowl__shape)
      integer*8 exact_model
      integer, parameter :: cctki_use_exact_model = kind(exact_model)
      INTEGER*4 Kerr_KerrSchild__parabolic
      integer, parameter :: cctki_use_Kerr_KerrSchild__parabolic = kind(
     &Kerr_KerrSchild__parabolic)
      INTEGER*4 Kerr_KerrSchild__power
      integer, parameter :: cctki_use_Kerr_KerrSchild__power = kind(Kerr
     &_KerrSchild__power)
      INTEGER*4 Minkowski_conf_wave__direction
      integer, parameter :: cctki_use_Minkowski_conf_wave__direction = k
     &ind(Minkowski_conf_wave__direction)
      INTEGER*4 Minkowski_gauge_wave__diagonal
      integer, parameter :: cctki_use_Minkowski_gauge_wave__diagonal = k
     &ind(Minkowski_gauge_wave__diagonal)
      INTEGER*4 Thorne_fakebinary__retarded
      integer, parameter :: cctki_use_Thorne_fakebinary__retarded = kind
     &(Thorne_fakebinary__retarded)
      INTEGER*4 bowl__evolve
      integer, parameter :: cctki_use_bowl__evolve = kind(bowl__evolve)
      INTEGER*4 multi_BH__nBH
      integer, parameter :: cctki_use_multi_BH__nBH = kind(multi_BH__nBH
     &)
      COMMON /exactrest/Alvi__mass1, Alvi__mass2, Alvi__separation, Bert
     &otti__Lambda, Bianchi_I__scale, Goedel__scale, Gowdy_wave__amplitu
     &de, Kasner_generalized__p1, Kasner_generalized__p2, Kasner_like__q
     &, Kerr_BoyerLindquist__mass, Kerr_BoyerLindquist__spin, Kerr_KerrS
     &child__boost_v, Kerr_KerrSchild__epsilon, Kerr_KerrSchild__mass, K
     &err_KerrSchild__spin, Kerr_KerrSchild__t, Kerr_KerrSchild__x, Kerr
     &_KerrSchild__y, Kerr_KerrSchild__z, Lemaitre__Lambda, Lemaitre__R0
     &, Lemaitre__epsilon0, Lemaitre__kappa, Minkowski_conf_wave__amplit
     &ude, Minkowski_conf_wave__wavelength, Minkowski_funny__amplitude, 
     &Minkowski_funny__sigma, Minkowski_gauge_wave__amplitude, Minkowski
     &_gauge_wave__lambda, Minkowski_gauge_wave__omega, Minkowski_gauge_
     &wave__phase, Minkowski_shift__amplitude, Minkowski_shift__sigma, S
     &chwarzschild_BL__epsilon, Schwarzschild_BL__mass, Schwarzschild_EF
     &__epsilon, Schwarzschild_EF__mass, Schwarzschild_Lemaitre__Lambda,
     & Schwarzschild_Lemaitre__mass, Schwarzschild_Novikov__epsilon, Sch
     &warzschild_Novikov__mass, Schwarzschild_PG__epsilon, Schwarzschild
     &_PG__mass, Thorne_fakebinary__Omega0, Thorne_fakebinary__epsilon, 
     &Thorne_fakebinary__mass, Thorne_fakebinary__separation, Thorne_fak
     &ebinary__smoothing, anti_de_Sitter_Lambda__scale, boost_rotation_s
     &ymmetric__amp, boost_rotation_symmetric__min_d, boost_rotation_sym
     &metric__scale, bowl__center, bowl__sigma, bowl__sigma_t, bowl__str
     &ength, bowl__t0, bowl__x_scale, bowl__y_scale, bowl__z_scale, cons
     &tant_density_star__mass, constant_density_star__radius, de_Sitter_
     &Lambda__scale, de_Sitter__scale, multi_BH__Hubble, multi_BH__mass1
     &, multi_BH__mass2, multi_BH__mass3, multi_BH__mass4, multi_BH__x1,
     & multi_BH__x2, multi_BH__x3, multi_BH__x4, multi_BH__y1, multi_BH_
     &_y2, multi_BH__y3, multi_BH__y4, multi_BH__z1, multi_BH__z2, multi
     &_BH__z3, multi_BH__z4, Minkowski_gauge_wave__what_fn, Thorne_fakeb
     &inary__atype, bowl__shape, exact_model, Kerr_KerrSchild__parabolic
     &, Kerr_KerrSchild__power, Minkowski_conf_wave__direction, Minkowsk
     &i_gauge_wave__diagonal, Thorne_fakebinary__retarded, bowl__evolve,
     & multi_BH__nBH
      REAL*8 boost_vx
      integer, parameter :: cctki_use_boost_vx = kind(boost_vx)
      REAL*8 boost_vy
      integer, parameter :: cctki_use_boost_vy = kind(boost_vy)
      REAL*8 boost_vz
      integer, parameter :: cctki_use_boost_vz = kind(boost_vz)
      REAL*8 exact_eps
      integer, parameter :: cctki_use_exact_eps = kind(exact_eps)
      REAL*8 exblend_rout
      integer, parameter :: cctki_use_exblend_rout = kind(exblend_rout)
      REAL*8 exblend_width
      integer, parameter :: cctki_use_exblend_width = kind(exblend_width
     &)
      REAL*8 rotation_euler_phi
      integer, parameter :: cctki_use_rotation_euler_phi = kind(rotation
     &_euler_phi)
      REAL*8 rotation_euler_psi
      integer, parameter :: cctki_use_rotation_euler_psi = kind(rotation
     &_euler_psi)
      REAL*8 rotation_euler_theta
      integer, parameter :: cctki_use_rotation_euler_theta = kind(rotati
     &on_euler_theta)
      REAL*8 shift_add_x
      integer, parameter :: cctki_use_shift_add_x = kind(shift_add_x)
      REAL*8 shift_add_y
      integer, parameter :: cctki_use_shift_add_y = kind(shift_add_y)
      REAL*8 shift_add_z
      integer, parameter :: cctki_use_shift_add_z = kind(shift_add_z)
      REAL*8 slice_Gauss_ampl
      integer, parameter :: cctki_use_slice_Gauss_ampl = kind(slice_Gaus
     &s_ampl)
      REAL*8 slice_Gauss_width
      integer, parameter :: cctki_use_slice_Gauss_width = kind(slice_Gau
     &ss_width)
      integer*8 overwrite_boundary
      integer, parameter :: cctki_use_overwrite_boundary = kind(overwrit
     &e_boundary)
      INTEGER*4 exact_order
      integer, parameter :: cctki_use_exact_order = kind(exact_order)
      INTEGER*4 exblend_Ks
      integer, parameter :: cctki_use_exblend_Ks = kind(exblend_Ks)
      INTEGER*4 exblend_gauge
      integer, parameter :: cctki_use_exblend_gauge = kind(exblend_gauge
     &)
      INTEGER*4 exblend_gs
      integer, parameter :: cctki_use_exblend_gs = kind(exblend_gs)
      COMMON /Exactpriv/boost_vx, boost_vy, boost_vz, exact_eps, exblend
     &_rout, exblend_width, rotation_euler_phi, rotation_euler_psi, rota
     &tion_euler_theta, shift_add_x, shift_add_y, shift_add_z, slice_Gau
     &ss_ampl, slice_Gauss_width, overwrite_boundary, exact_order, exble
     &nd_Ks, exblend_gauge, exblend_gs
      integer*8 CCTKH0
      integer, parameter :: cctki_use_CCTKH0 = kind(CCTKH0)
      integer*8 dtlapse_evolution_method
      integer, parameter :: cctki_use_dtlapse_evolution_method = kind(dt
     &lapse_evolution_method)
      integer*8 dtshift_evolution_method
      integer, parameter :: cctki_use_dtshift_evolution_method = kind(dt
     &shift_evolution_method)
      integer*8 evolution_method
      integer, parameter :: cctki_use_evolution_method = kind(evolution_
     &method)
      integer*8 initial_data
      integer, parameter :: cctki_use_initial_data = kind(initial_data)
      integer*8 initial_dtlapse
      integer, parameter :: cctki_use_initial_dtlapse = kind(initial_dtl
     &apse)
      integer*8 initial_dtshift
      integer, parameter :: cctki_use_initial_dtshift = kind(initial_dts
     &hift)
      integer*8 initial_lapse
      integer, parameter :: cctki_use_initial_lapse = kind(initial_lapse
     &)
      integer*8 initial_shift
      integer, parameter :: cctki_use_initial_shift = kind(initial_shift
     &)
      integer*8 lapse_evolution_method
      integer, parameter :: cctki_use_lapse_evolution_method = kind(laps
     &e_evolution_method)
      integer*8 CCTKH1
      integer, parameter :: cctki_use_CCTKH1 = kind(CCTKH1)
      integer*8 CCTKH3
      integer, parameter :: cctki_use_CCTKH3 = kind(CCTKH3)
      integer*8 metric_type
      integer, parameter :: cctki_use_metric_type = kind(metric_type)
      integer*8 shift_evolution_method
      integer, parameter :: cctki_use_shift_evolution_method = kind(shif
     &t_evolution_method)
      integer*8 CCTKH5
      integer, parameter :: cctki_use_CCTKH5 = kind(CCTKH5)
      INTEGER*4 CCTKH2
      integer, parameter :: cctki_use_CCTKH2 = kind(CCTKH2)
      INTEGER*4 CCTKH4
      integer, parameter :: cctki_use_CCTKH4 = kind(CCTKH4)
      INTEGER*4 CCTKH6
      integer, parameter :: cctki_use_CCTKH6 = kind(CCTKH6)
      COMMON /ADMBASErest/CCTKH0, dtlapse_evolution_method, dtshift_evol
     &ution_method, evolution_method, initial_data, initial_dtlapse, ini
     &tial_dtshift, initial_lapse, initial_shift, lapse_evolution_method
     &, CCTKH1, CCTKH3, metric_type, shift_evolution_method, CCTKH5, CCT
     &KH2, CCTKH4, CCTKH6
      integer*8 conformal_storage
      integer, parameter :: cctki_use_conformal_storage = kind(conformal
     &_storage)
      COMMON /STATICCONFORMALrest/conformal_storage

c
      INTEGER*4 decoded_exact_model
      REAL*8 x, y, z, t

c
      REAL*8 gdtt, gdtx, gdty, gdtz,
     $          gdxx, gdyy, gdzz, gdxy, gdyz, gdxz,
     $          gutt, gutx, guty, gutz,
     $          guxx, guyy, guzz, guxy, guyz, guxz,
     $          psi

c
      logical   firstcall
      data      firstcall /.true./
      REAL*8 gamma
      REAL*8 vv(3), nn(3)
      REAL*8 parallel(3,3), perp(3,3)
      REAL*8 Cx_par(3), Cx_perp(3)
      REAL*8 partial_Mx_wrt_Cx(0:3,0:3)
      REAL*8 partial_Cx_wrt_Mx(0:3,0:3)
      REAL*8 R(0:3,0:3)
      save      firstcall
      save      gamma
      save      vv
      save      parallel, perp
      save      partial_Mx_wrt_Cx
      save      partial_Cx_wrt_Mx
      save      R
c$omp threadprivate (firstcall, gamma, vv, parallel, perp, 
c$omp+               partial_Mx_wrt_Cx,partial_Cx_wrt_Mx, R)

c
      REAL*8 Cx(0:3)
      REAL*8 Cgdd(0:3,0:3), Cguu(0:3,0:3)
      REAL*8 Mx(0:3)
      REAL*8 Mgdd(0:3,0:3), Mguu(0:3,0:3)
      REAL*8 Nx(0:3)
      REAL*8 Ngdd(0:3,0:3), Nguu(0:3,0:3)

c
      REAL*8 vnorm, vnormsq
      REAL*8 delta_ij
      REAL*8 Cx_par_i, Cx_perp_i
      REAL*8 vdotCx
      REAL*8 Cgdd_ab, Cguu_ab
      REAL*8 cos_phi, sin_phi
      REAL*8 cos_theta, sin_theta
      REAL*8 cos_psi, sin_psi
      REAL*8 R_phi(0:3,0:3), R_theta(0:3,0:3), R_psi(0:3,0:3)
      character*1000 warn_buffer

c
      logical Tmunu_flag
      integer i, j, k, l
      integer Ca, Cb, MA, MB

c
      integer n
      parameter (n = 3)

c

c
c
c
      if (       (boost_vx .eq. 0.0)
     $     .and. (boost_vy .eq. 0.0)
     $     .and. (boost_vz .eq. 0.0)
     $     .and. (rotation_euler_phi   .eq. 0.0)
     $     .and. (rotation_euler_theta .eq. 0.0)
     $     .and. (rotation_euler_psi   .eq. 0.0)) then
         call Exact__metric_for_model(
     $        decoded_exact_model,
     $        x, y, z, t,
     $        gdtt, gdtx, gdty, gdtz,
     $        gdxx, gdyy, gdzz, gdxy, gdyz, gdxz,
     $        gutt, gutx, guty, gutz,
     $        guxx, guyy, guzz, guxy, guyz, guxz,
     $        psi,
     $        Tmunu_flag)
         return
      end if

c

c
c
c
c
c
c
c
c
c

c

c
c
c
      if (firstcall) then

c
         vv(1) = boost_vx
         vv(2) = boost_vy
         vv(3) = boost_vz

c
         vnormsq = 0.0
         do i = 1,n
            vnormsq = vnormsq + vv(i)*vv(i)
         end do
         gamma = 1.0 / sqrt(1.0 - vnormsq)
         vnorm = sqrt(vnormsq)
         if (       (boost_vx .eq. 0.0)
     $        .and. (boost_vy .eq. 0.0)
     $        .and. (boost_vz .eq. 0.0)) then
            nn(1) = 1
            nn(2) = 0
            nn(3) = 0
         else
            do i = 1,n
               nn(i) = vv(i) / vnorm
            end do
         end if

c
         do j = 1,n
            do i = 1,n
               parallel(i,j) = nn(i) * nn(j)
               if (i .eq. j) then
                  delta_ij = 1.0
               else
                  delta_ij = 0.0
               end if
               perp(i,j) = delta_ij - parallel(i,j)
            end do
         end do

c
         partial_Mx_wrt_Cx(0,0) = gamma
         do i = 1,n
            partial_Mx_wrt_Cx(0,i) = -gamma*vv(i)
         end do
         do i = 1,n
            partial_Mx_wrt_Cx(i,0) = -gamma*vv(i)
            do j=1,n
               partial_Mx_wrt_Cx(i,j) = gamma*parallel(i,j) + perp(i,j)
            end do
         end do

c
         partial_Cx_wrt_Mx(0,0) = gamma
         do i = 1,n
            partial_Cx_wrt_Mx(0,i) = + gamma*vv(i)
         end do
         do i = 1,n
            partial_Cx_wrt_Mx(i,0) = + gamma*vv(i)
            do j=1,n
               partial_Cx_wrt_Mx(i,j) = gamma*parallel(i,j) + perp(i,j)
            end do
         end do

c
         cos_phi   = cos (rotation_euler_phi)
         sin_phi   = sin (rotation_euler_phi)
         cos_theta = cos (rotation_euler_theta)
         sin_theta = sin (rotation_euler_theta)
         cos_psi   = cos (rotation_euler_psi)
         sin_psi   = sin (rotation_euler_psi)

c
         R_phi(0,0) = 1
         R_phi(0,1) = 0
         R_phi(0,2) = 0
         R_phi(0,3) = 0
         R_phi(1,0) = 0
         R_phi(1,1) = + cos_phi
         R_phi(1,2) = + sin_phi
         R_phi(1,3) = 0
         R_phi(2,0) = 0
         R_phi(2,1) = - sin_phi
         R_phi(2,2) = + cos_phi
         R_phi(2,3) = 0
         R_phi(3,0) = 0
         R_phi(3,1) = 0
         R_phi(3,2) = 0
         R_phi(3,3) = 1

         R_theta(0,0) = 1
         R_theta(0,1) = 0
         R_theta(0,2) = 0
         R_theta(0,3) = 0
         R_theta(1,0) = 0
         R_theta(1,1) = 1
         R_theta(1,2) = 0
         R_theta(1,3) = 0
         R_theta(2,0) = 0
         R_theta(2,1) = 0
         R_theta(2,2) = + cos_theta
         R_theta(2,3) = + sin_theta
         R_theta(3,0) = 0
         R_theta(3,1) = 0
         R_theta(3,2) = - sin_theta
         R_theta(3,3) = + cos_theta

         R_psi(0,0) = 1
         R_psi(0,1) = 0
         R_psi(0,2) = 0
         R_psi(0,3) = 0
         R_psi(1,0) = 0
         R_psi(1,1) = + cos_psi
         R_psi(1,2) = + sin_psi
         R_psi(1,3) = 0
         R_psi(2,0) = 0
         R_psi(2,1) = - sin_psi
         R_psi(2,2) = + cos_psi
         R_psi(2,3) = 0
         R_psi(3,0) = 0
         R_psi(3,1) = 0
         R_psi(3,2) = 0
         R_psi(3,3) = 1

c
         do i = 0,n
            do j = 0,n
               R(i,j) = 0
               do k = 0,n
                  do l = 0,n
                     R(i,j) = R(i,j) + R_psi(i,k) * R_theta(k,l) * R_phi
     &(l,j)
                  end do
               end do
            end do
         end do

c
c
c
c
c
c
c
c
c
c
c
c
c
c

         firstcall = .false.
      end if

c

c
c
c
      Cx(0) = t
      Cx(1) = x
      Cx(2) = y
      Cx(3) = z

      do i=1,n
         Cx_par_i  = 0.0
         Cx_perp_i = 0.0
         do j=1,n
            Cx_par_i  = Cx_par_i  + parallel(i,j)*Cx(j)
            Cx_perp_i = Cx_perp_i + perp    (i,j)*Cx(j)
         end do
         Cx_par (i) = Cx_par_i
         Cx_perp(i) = Cx_perp_i
      end do

c
c
c
c

c
      vdotCx = 0.0
      do i = 1,n
         vdotCx = vdotCx + vv(i)*Cx(i)
      end do

      Mx(0) = gamma * (Cx(0) - vdotCx)
      do i=1,n
         Mx(i) = gamma * (Cx_par(i) - vv(i)*Cx(0)) + Cx_perp(i)
      end do

c
      do i=0,n
         Nx(i) = 0
         do j = 0,n
            Nx(i) = Nx(i) + R(i,j) * Mx(j)
         end do
      end do


c
c
c
      call Exact__metric_for_model(
     $     decoded_exact_model,
     $     Nx(1), Nx(2), Nx(3), Nx(0),
     $     Ngdd(0,0), Ngdd(0,1), Ngdd(0,2), Ngdd(0,3),
     $     Ngdd(1,1), Ngdd(2,2), Ngdd(3,3),
     $     Ngdd(1,2), Ngdd(2,3), Ngdd(1,3),
     $     Nguu(0,0), Nguu(0,1), Nguu(0,2), Nguu(0,3),
     $     Nguu(1,1), Nguu(2,2), Nguu(3,3),
     $     Nguu(1,2), Nguu(2,3), Nguu(1,3),
     $     psi, Tmunu_flag)

      if (Tmunu_flag) then
         write (warn_buffer, '(a,i8,a,a)')
     $        'exact_model = ', decoded_exact_model,
     $        'sets the stress-energy tensor',
     $        ' ==> we cannot Lorentz-boost or rotate it!'
         call CCTK_Warn(0,363,"boost.F","Exact", warn_buffer)
      end if

c
c
c
c
      Ngdd(1,0) = Ngdd(0,1)
      Ngdd(2,0) = Ngdd(0,2)
      Ngdd(2,1) = Ngdd(1,2)
      Ngdd(3,0) = Ngdd(0,3)
      Ngdd(3,1) = Ngdd(1,3)
      Ngdd(3,2) = Ngdd(2,3)

      Nguu(1,0) = Nguu(0,1)
      Nguu(2,0) = Nguu(0,2)
      Nguu(2,1) = Nguu(1,2)
      Nguu(3,0) = Nguu(0,3)
      Nguu(3,1) = Nguu(1,3)
      Nguu(3,2) = Nguu(2,3)

c
c
c

c
      do i = 0,n
         do j = 0,n
            Mgdd(i,j) = 0
            Mguu(i,j) = 0
            do k = 0,n
               do l = 0,n
                  Mgdd(i,j) = Mgdd(i,j) + R(k,i) * R(l,j) * Ngdd(k,l)
c
c
c
                  Mguu(i,j) = Mguu(i,j) + R(k,i) * R(l,j) * Nguu(k,l)
               end do
            end do
         end do
      end do

c
      do Ca = 0,n
         do Cb = Ca,n
            Cgdd_ab = 0.0
            do Ma = 0,n
               do Mb = 0,n
                  Cgdd_ab = Cgdd_ab
     $                 +  Mgdd(Ma,Mb)
     $                    * partial_Mx_wrt_Cx(Ma,Ca)
     $                    * partial_Mx_wrt_Cx(Mb,Cb)
               end do
            end do
            Cgdd(Ca,Cb) = Cgdd_ab
         end do
      end do

      do Ca = 0,n
         do Cb = Ca,n
            Cguu_ab = 0.0
            do Ma = 0,n
               do Mb = 0,n
                  Cguu_ab = Cguu_ab
     $                 +  Mguu(Ma,Mb)
     $                    * partial_Cx_wrt_Mx(Ca,Ma)
     $                    * partial_Cx_wrt_Mx(Cb,Mb)
               end do
            end do
            Cguu(Ca,Cb) = Cguu_ab
         end do
      end do

c
c
c
c
      gdtt = Cgdd(0,0)
      gdtx = Cgdd(0,1)
      gdty = Cgdd(0,2)
      gdtz = Cgdd(0,3)
      gdxx = Cgdd(1,1)
      gdxy = Cgdd(1,2)
      gdxz = Cgdd(1,3)
      gdyy = Cgdd(2,2)
      gdyz = Cgdd(2,3)
      gdzz = Cgdd(3,3)

      gutt = Cguu(0,0)
      gutx = Cguu(0,1)
      guty = Cguu(0,2)
      gutz = Cguu(0,3)
      guxx = Cguu(1,1)
      guxy = Cguu(1,2)
      guxz = Cguu(1,3)
      guyy = Cguu(2,2)
      guyz = Cguu(2,3)
      guzz = Cguu(3,3)

      end
