






















































































































 


































































































































































 


























































































































































































 























































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                



















































































subroutine CalcK (cctk_dim,cctk_gsh,cctk_lsh,cctk_lbnd,cctk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,cctk_alignment&
  &_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,cctk_time,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levoff,cctk_le&
  &voffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_nghostzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, gxx_nex&
  &t,gxx_prev,gxx_prev2,gxy_next,gxy_prev,gxy_prev2,gxz_next,gxz_prev,gxz_prev2,gyy_next,gyy_prev,gyy_prev2,gyz_next,gyz_prev,gyz_p&
  &rev2,gzz_next,gzz_prev,gzz_prev2, alp,alp_p,alp_p_p,betax,betax_p,betax_p_p,betay,betay_p,betay_p_p,betaz,betaz_p,betaz_p_p,coar&
  &se_dx,coarse_dy,coarse_dz,conformal_state,dtalp,dtalp_p,dtalp_p_p,dtbetax,dtbetax_p,dtbetax_p_p,dtbetay,dtbetay_p,dtbetay_p_p,dt&
  &betaz,dtbetaz_p,dtbetaz_p_p,dtlapse_state,dtshift_state,gxx,gxx_p,gxx_p_p,gxy,gxy_p,gxy_p_p,gxz,gxz_p,gxz_p_p,gyy,gyy_p,gyy_p_p,&
  &gyz,gyz_p,gyz_p_p,gzz,gzz_p,gzz_p_p,kxx,kxx_p,kxx_p_p,kxy,kxy_p,kxy_p_p,kxz,kxz_p,kxz_p_p,kyy,kyy_p,kyy_p_p,kyz,kyz_p,kyz_p_p,kz&
  &z,kzz_p,kzz_p_p,psi,psix,psixx,psixy,psixz,psiy,psiyy,psiyz,psiz,psizz,r,shift_state,x,y,z)
  use cctk
  implicit none

  INTEGER cctk_dim
  integer, parameter :: cctki_use_cctk_dim = kind(cctk_dim)
  INTEGER cctk_gsh (cctk_dim)
  integer, parameter :: cctki_use_cctk_gsh = kind(cctk_gsh)
  INTEGER cctk_lsh (cctk_dim)
  integer, parameter :: cctki_use_cctk_lsh = kind(cctk_lsh)
  INTEGER cctk_lbnd (cctk_dim)
  integer, parameter :: cctki_use_cctk_lbnd = kind(cctk_lbnd)
  INTEGER cctk_ubnd (cctk_dim)
  integer, parameter :: cctki_use_cctk_ubnd = kind(cctk_ubnd)
  INTEGER cctk_tile_min (cctk_dim)
  integer, parameter :: cctki_use_cctk_tile_min = kind(cctk_tile_min)
  INTEGER cctk_tile_max (cctk_dim)
  integer, parameter :: cctki_use_cctk_tile_max = kind(cctk_tile_max)
  INTEGER cctk_ash (cctk_dim)
  integer, parameter :: cctki_use_cctk_ash = kind(cctk_ash)
  INTEGER cctk_alignment
  integer, parameter :: cctki_use_cctk_alignment = kind(cctk_alignment)
  INTEGER cctk_alignment_offset
  integer, parameter :: cctki_use_cctk_alignment_offset = kind(cctk_alignment_offset)
  INTEGER cctk_from (cctk_dim)
  integer, parameter :: cctki_use_cctk_from = kind(cctk_from)
  INTEGER cctk_to (cctk_dim)
  integer, parameter :: cctki_use_cctk_to = kind(cctk_to)
  INTEGER cctk_bbox (2*cctk_dim)
  integer, parameter :: cctki_use_cctk_bbox = kind(cctk_bbox)
  REAL*8 cctk_delta_time
  integer, parameter :: cctki_use_cctk_delta_time = kind(cctk_delta_time)
  REAL*8 cctk_time
  integer, parameter :: cctki_use_cctk_time = kind(cctk_time)
  REAL*8 cctk_delta_space (cctk_dim)
  integer, parameter :: cctki_use_cctk_delta_space = kind(cctk_delta_space)
  REAL*8 cctk_origin_space (cctk_dim)
  integer, parameter :: cctki_use_cctk_origin_space = kind(cctk_origin_space)
  INTEGER cctk_levfac (cctk_dim)
  integer, parameter :: cctki_use_cctk_levfac = kind(cctk_levfac)
  INTEGER cctk_levoff (cctk_dim)
  integer, parameter :: cctki_use_cctk_levoff = kind(cctk_levoff)
  INTEGER cctk_levoffdenom (cctk_dim)
  integer, parameter :: cctki_use_cctk_levoffdenom = kind(cctk_levoffdenom)
  INTEGER cctk_timefac
  integer, parameter :: cctki_use_cctk_timefac = kind(cctk_timefac)
  INTEGER cctk_convlevel
  integer, parameter :: cctki_use_cctk_convlevel = kind(cctk_convlevel)
  INTEGER cctk_convfac
  integer, parameter :: cctki_use_cctk_convfac = kind(cctk_convfac)
  INTEGER cctk_nghostzones (cctk_dim)
  integer, parameter :: cctki_use_cctk_nghostzones = kind(cctk_nghostzones)
  INTEGER cctk_iteration
  integer, parameter :: cctki_use_cctk_iteration = kind(cctk_iteration)
  integer*8 cctkGH
  integer, parameter :: cctki_use_cctkGH = kind(cctkGH)
  INTEGER cctk_ash1
  integer, parameter :: cctki_use_cctk_ash1 = kind(cctk_ash1)
  INTEGER cctk_ash2
  integer, parameter :: cctki_use_cctk_ash2 = kind(cctk_ash2)
  INTEGER cctk_ash3
  integer, parameter :: cctki_use_cctk_ash3 = kind(cctk_ash3)
  REAL*8 gxx_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx_next = kind(gxx_next)
  REAL*8 gxx_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx_prev = kind(gxx_prev)
  REAL*8 gxx_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx_prev2 = kind(gxx_prev2)
  REAL*8 gxy_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy_next = kind(gxy_next)
  REAL*8 gxy_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy_prev = kind(gxy_prev)
  REAL*8 gxy_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy_prev2 = kind(gxy_prev2)
  REAL*8 gxz_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz_next = kind(gxz_next)
  REAL*8 gxz_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz_prev = kind(gxz_prev)
  REAL*8 gxz_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz_prev2 = kind(gxz_prev2)
  REAL*8 gyy_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy_next = kind(gyy_next)
  REAL*8 gyy_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy_prev = kind(gyy_prev)
  REAL*8 gyy_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy_prev2 = kind(gyy_prev2)
  REAL*8 gyz_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz_next = kind(gyz_next)
  REAL*8 gyz_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz_prev = kind(gyz_prev)
  REAL*8 gyz_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz_prev2 = kind(gyz_prev2)
  REAL*8 gzz_next (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz_next = kind(gzz_next)
  REAL*8 gzz_prev (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz_prev = kind(gzz_prev)
  REAL*8 gzz_prev2 (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz_prev2 = kind(gzz_prev2)
  REAL*8 alp (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_alp = kind(alp)
  REAL*8 alp_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_alp_p = kind(alp_p)
  REAL*8 alp_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_alp_p_p = kind(alp_p_p)
  REAL*8 betax (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betax = kind(betax)
  REAL*8 betax_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betax_p = kind(betax_p)
  REAL*8 betax_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betax_p_p = kind(betax_p_p)
  REAL*8 betay (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betay = kind(betay)
  REAL*8 betay_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betay_p = kind(betay_p)
  REAL*8 betay_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betay_p_p = kind(betay_p_p)
  REAL*8 betaz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betaz = kind(betaz)
  REAL*8 betaz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betaz_p = kind(betaz_p)
  REAL*8 betaz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_betaz_p_p = kind(betaz_p_p)
  REAL*8 coarse_dx
  integer, parameter :: cctki_use_coarse_dx = kind(coarse_dx)
  REAL*8 coarse_dy
  integer, parameter :: cctki_use_coarse_dy = kind(coarse_dy)
  REAL*8 coarse_dz
  integer, parameter :: cctki_use_coarse_dz = kind(coarse_dz)
  INTEGER*4 conformal_state
  integer, parameter :: cctki_use_conformal_state = kind(conformal_state)
  REAL*8 dtalp (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtalp = kind(dtalp)
  REAL*8 dtalp_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtalp_p = kind(dtalp_p)
  REAL*8 dtalp_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtalp_p_p = kind(dtalp_p_p)
  REAL*8 dtbetax (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetax = kind(dtbetax)
  REAL*8 dtbetax_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetax_p = kind(dtbetax_p)
  REAL*8 dtbetax_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetax_p_p = kind(dtbetax_p_p)
  REAL*8 dtbetay (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetay = kind(dtbetay)
  REAL*8 dtbetay_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetay_p = kind(dtbetay_p)
  REAL*8 dtbetay_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetay_p_p = kind(dtbetay_p_p)
  REAL*8 dtbetaz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetaz = kind(dtbetaz)
  REAL*8 dtbetaz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetaz_p = kind(dtbetaz_p)
  REAL*8 dtbetaz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_dtbetaz_p_p = kind(dtbetaz_p_p)
  INTEGER*4 dtlapse_state
  integer, parameter :: cctki_use_dtlapse_state = kind(dtlapse_state)
  INTEGER*4 dtshift_state
  integer, parameter :: cctki_use_dtshift_state = kind(dtshift_state)
  REAL*8 gxx (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx = kind(gxx)
  REAL*8 gxx_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx_p = kind(gxx_p)
  REAL*8 gxx_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxx_p_p = kind(gxx_p_p)
  REAL*8 gxy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy = kind(gxy)
  REAL*8 gxy_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy_p = kind(gxy_p)
  REAL*8 gxy_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxy_p_p = kind(gxy_p_p)
  REAL*8 gxz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz = kind(gxz)
  REAL*8 gxz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz_p = kind(gxz_p)
  REAL*8 gxz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gxz_p_p = kind(gxz_p_p)
  REAL*8 gyy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy = kind(gyy)
  REAL*8 gyy_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy_p = kind(gyy_p)
  REAL*8 gyy_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyy_p_p = kind(gyy_p_p)
  REAL*8 gyz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz = kind(gyz)
  REAL*8 gyz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz_p = kind(gyz_p)
  REAL*8 gyz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gyz_p_p = kind(gyz_p_p)
  REAL*8 gzz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz = kind(gzz)
  REAL*8 gzz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz_p = kind(gzz_p)
  REAL*8 gzz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_gzz_p_p = kind(gzz_p_p)
  REAL*8 kxx (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxx = kind(kxx)
  REAL*8 kxx_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxx_p = kind(kxx_p)
  REAL*8 kxx_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxx_p_p = kind(kxx_p_p)
  REAL*8 kxy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxy = kind(kxy)
  REAL*8 kxy_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxy_p = kind(kxy_p)
  REAL*8 kxy_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxy_p_p = kind(kxy_p_p)
  REAL*8 kxz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxz = kind(kxz)
  REAL*8 kxz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxz_p = kind(kxz_p)
  REAL*8 kxz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kxz_p_p = kind(kxz_p_p)
  REAL*8 kyy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyy = kind(kyy)
  REAL*8 kyy_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyy_p = kind(kyy_p)
  REAL*8 kyy_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyy_p_p = kind(kyy_p_p)
  REAL*8 kyz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyz = kind(kyz)
  REAL*8 kyz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyz_p = kind(kyz_p)
  REAL*8 kyz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kyz_p_p = kind(kyz_p_p)
  REAL*8 kzz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kzz = kind(kzz)
  REAL*8 kzz_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kzz_p = kind(kzz_p)
  REAL*8 kzz_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_kzz_p_p = kind(kzz_p_p)
  REAL*8 psi (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psi = kind(psi)
  REAL*8 psix (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psix = kind(psix)
  REAL*8 psixx (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psixx = kind(psixx)
  REAL*8 psixy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psixy = kind(psixy)
  REAL*8 psixz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psixz = kind(psixz)
  REAL*8 psiy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psiy = kind(psiy)
  REAL*8 psiyy (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psiyy = kind(psiyy)
  REAL*8 psiyz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psiyz = kind(psiyz)
  REAL*8 psiz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psiz = kind(psiz)
  REAL*8 psizz (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_psizz = kind(psizz)
  REAL*8 r (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_r = kind(r)
  INTEGER*4 shift_state
  integer, parameter :: cctki_use_shift_state = kind(shift_state)
  REAL*8 x (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_x = kind(x)
  REAL*8 y (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_y = kind(y)
  REAL*8 z (cctk_ash1,cctk_ash2,cctk_ash3)
  integer, parameter :: cctki_use_z = kind(z)
  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_SelectGroupForBC (cctkGH, faces, boundary_width, table_handle, group_name, bc_name)
  implicit none
  integer*8 cctkGH
  INTEGER*4 faces
  INTEGER*4 boundary_width
  INTEGER*4 table_handle
  character(*) group_name
  character(*) bc_name
  end function Boundary_SelectGroupForBC
  end interface
  interface
  subroutine ConfToPhysInPlace (nx, ny, nz, psi, gxx, gxy, gxz, gyy, gyz, gzz)
  implicit none
  INTEGER*4 nx
  INTEGER*4 ny
  INTEGER*4 nz
  REAL*8 psi(*)
  REAL*8 gxx(*)
  REAL*8 gxy(*)
  REAL*8 gxz(*)
  REAL*8 gyy(*)
  REAL*8 gyz(*)
  REAL*8 gzz(*)
  end subroutine ConfToPhysInPlace
  end interface
  interface
  subroutine PhysToConfInPlace (nx, ny, nz, psi, gxx, gxy, gxz, gyy, gyz, gzz)
  implicit none
  INTEGER*4 nx
  INTEGER*4 ny
  INTEGER*4 nz
  REAL*8 psi(*)
  REAL*8 gxx(*)
  REAL*8 gxy(*)
  REAL*8 gxz(*)
  REAL*8 gyy(*)
  REAL*8 gyz(*)
  REAL*8 gzz(*)
  end subroutine PhysToConfInPlace
  end interface
  integer*8 extcurv_boundary
  integer, parameter :: cctki_use_extcurv_boundary = kind(extcurv_boundary)
  integer*8 extcurv_boundary_options
  integer, parameter :: cctki_use_extcurv_boundary_options = kind(extcurv_boundary_options)
  INTEGER*4 calc_extcurv
  integer, parameter :: cctki_use_calc_extcurv = kind(calc_extcurv)
  INTEGER*4 copy_to_next
  integer, parameter :: cctki_use_copy_to_next = kind(copy_to_next)
  INTEGER*4 copy_to_prev
  integer, parameter :: cctki_use_copy_to_prev = kind(copy_to_prev)
  INTEGER*4 copy_to_prev2
  integer, parameter :: cctki_use_copy_to_prev2 = kind(copy_to_prev2)
  COMMON /CalcKpriv/extcurv_boundary, extcurv_boundary_options, calc_extcurv, copy_to_next, copy_to_prev, copy_to_prev2
  integer*8 CCTKH0
  integer, parameter :: cctki_use_CCTKH0 = kind(CCTKH0)
  integer*8 CCTKH1
  integer, parameter :: cctki_use_CCTKH1 = kind(CCTKH1)
  integer*8 CCTKH2
  integer, parameter :: cctki_use_CCTKH2 = kind(CCTKH2)
  integer*8 CCTKH3
  integer, parameter :: cctki_use_CCTKH3 = kind(CCTKH3)
  integer*8 CCTKH4
  integer, parameter :: cctki_use_CCTKH4 = kind(CCTKH4)
  integer*8 CCTKH5
  integer, parameter :: cctki_use_CCTKH5 = kind(CCTKH5)
  integer*8 CCTKH6
  integer, parameter :: cctki_use_CCTKH6 = kind(CCTKH6)
  integer*8 CCTKH7
  integer, parameter :: cctki_use_CCTKH7 = kind(CCTKH7)
  integer*8 CCTKH8
  integer, parameter :: cctki_use_CCTKH8 = kind(CCTKH8)
  integer*8 CCTKH9
  integer, parameter :: cctki_use_CCTKH9 = kind(CCTKH9)
  integer*8 CCTKH10
  integer, parameter :: cctki_use_CCTKH10 = kind(CCTKH10)
  integer*8 CCTKH12
  integer, parameter :: cctki_use_CCTKH12 = kind(CCTKH12)
  integer*8 metric_type
  integer, parameter :: cctki_use_metric_type = kind(metric_type)
  integer*8 CCTKH14
  integer, parameter :: cctki_use_CCTKH14 = kind(CCTKH14)
  integer*8 CCTKH15
  integer, parameter :: cctki_use_CCTKH15 = kind(CCTKH15)
  INTEGER*4 CCTKH11
  integer, parameter :: cctki_use_CCTKH11 = kind(CCTKH11)
  INTEGER*4 CCTKH13
  integer, parameter :: cctki_use_CCTKH13 = kind(CCTKH13)
  INTEGER*4 CCTKH16
  integer, parameter :: cctki_use_CCTKH16 = kind(CCTKH16)
  COMMON /ADMBASErest/CCTKH0, CCTKH1, CCTKH2, CCTKH3, CCTKH4, CCTKH5, CCTKH6, CCTKH7, CCTKH8, CCTKH9, CCTKH10, CCTKH12, metric_type&
  &, CCTKH14, CCTKH15, CCTKH11, CCTKH13, CCTKH16
  
  INTEGER*4, parameter :: idummy=0
  INTEGER*4, parameter :: ik=kind(idummy)
  
  integer, parameter :: bndwidth = 1
  
  integer         :: len_boundary, len_options
  character(1000) :: str_boundary, str_options
  integer         :: options
  
  REAL*8 :: dt, dx(3)
  
  REAL*8 :: gama(3,3), gama_dot(3,3), dgama(3,3,3)
  REAL*8 :: alfa
  REAL*8 :: beta(3), dbeta(3,3)
  REAL*8 :: kk(3,3)
  
  integer :: imin(3), imax(3)
  integer :: i, j, k
  integer :: a, b, c
  integer :: ierr
  
  dt = (cctk_delta_time/cctk_timefac)
  dx(:) = (cctk_delta_space(:)/cctk_levfac(:))
  
  call CCTK_FortranString &
       (len_boundary, extcurv_boundary, str_boundary)
  call CCTK_FortranString &
       (len_options, extcurv_boundary_options, str_options)
  call Util_TableCreateFromString (options, str_options)
  if (options<0) then
     call CCTK_Warn(0,45,"CalcK.F90","CalcK", "Parameter ""extcurv_boundary_options"" has an illegal syntax")
  end if
  
  imin(:) = 1+cctk_nghostzones(:)
  imax(:) = cctk_lsh(:)-cctk_nghostzones(:)
  where (cctk_bbox(1::2)/=0) imin(:) = 1+bndwidth
  where (cctk_bbox(2::2)/=0) imax(:) = cctk_lsh(:)-bndwidth
  
  
  if ((CCTK_Equals(metric_type, "static conformal") .ne. 0)) then
     call ConfToPhysInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx, gxy, gxz, gyy, gyz, gzz)
     call ConfToPhysInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx_prev, gxy_prev, gxz_prev, gyy_prev, gyz_prev, gzz_prev)





     call ConfToPhysInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx_next, gxy_next, gxz_next, gyy_next, gyz_next, gzz_next)

  end if
  
  do k = imin(3), imax(3)
     do j = imin(2), imax(2)
        do i = imin(1), imax(1)
           
           gama(1,1) = gxx(i,j,k)
           gama(1,2) = gxy(i,j,k)
           gama(1,3) = gxz(i,j,k)
           gama(2,2) = gyy(i,j,k)
           gama(2,3) = gyz(i,j,k)
           gama(3,3) = gzz(i,j,k)
           gama(2,1) = gama(1,2)
           gama(3,1) = gama(1,3)
           gama(3,2) = gama(2,3)
           
           gama_dot(1,1) = (gxx_next(i,j,k) - gxx_prev(i,j,k)) / (2*dt)
           gama_dot(1,2) = (gxy_next(i,j,k) - gxy_prev(i,j,k)) / (2*dt)
           gama_dot(1,3) = (gxz_next(i,j,k) - gxz_prev(i,j,k)) / (2*dt)
           gama_dot(2,2) = (gyy_next(i,j,k) - gyy_prev(i,j,k)) / (2*dt)
           gama_dot(2,3) = (gyz_next(i,j,k) - gyz_prev(i,j,k)) / (2*dt)
           gama_dot(3,3) = (gzz_next(i,j,k) - gzz_prev(i,j,k)) / (2*dt)

           gama_dot(2,1) = gama_dot(1,2)
           gama_dot(3,1) = gama_dot(1,3)
           gama_dot(3,2) = gama_dot(2,3)
           
           dgama(1,1,1) = (gxx(i+1,j,k) - gxx(i-1,j,k)) / (2*dx(1))
           dgama(1,2,1) = (gxy(i+1,j,k) - gxy(i-1,j,k)) / (2*dx(1))
           dgama(1,3,1) = (gxz(i+1,j,k) - gxz(i-1,j,k)) / (2*dx(1))
           dgama(2,2,1) = (gyy(i+1,j,k) - gyy(i-1,j,k)) / (2*dx(1))
           dgama(2,3,1) = (gyz(i+1,j,k) - gyz(i-1,j,k)) / (2*dx(1))
           dgama(3,3,1) = (gzz(i+1,j,k) - gzz(i-1,j,k)) / (2*dx(1))
           dgama(1,1,2) = (gxx(i,j+1,k) - gxx(i,j-1,k)) / (2*dx(2))
           dgama(1,2,2) = (gxy(i,j+1,k) - gxy(i,j-1,k)) / (2*dx(2))
           dgama(1,3,2) = (gxz(i,j+1,k) - gxz(i,j-1,k)) / (2*dx(2))
           dgama(2,2,2) = (gyy(i,j+1,k) - gyy(i,j-1,k)) / (2*dx(2))
           dgama(2,3,2) = (gyz(i,j+1,k) - gyz(i,j-1,k)) / (2*dx(2))
           dgama(3,3,2) = (gzz(i,j+1,k) - gzz(i,j-1,k)) / (2*dx(2))
           dgama(1,1,3) = (gxx(i,j,k+1) - gxx(i,j,k-1)) / (2*dx(3))
           dgama(1,2,3) = (gxy(i,j,k+1) - gxy(i,j,k-1)) / (2*dx(3))
           dgama(1,3,3) = (gxz(i,j,k+1) - gxz(i,j,k-1)) / (2*dx(3))
           dgama(2,2,3) = (gyy(i,j,k+1) - gyy(i,j,k-1)) / (2*dx(3))
           dgama(2,3,3) = (gyz(i,j,k+1) - gyz(i,j,k-1)) / (2*dx(3))
           dgama(3,3,3) = (gzz(i,j,k+1) - gzz(i,j,k-1)) / (2*dx(3))
           dgama(2,1,:) = dgama(1,2,:)
           dgama(3,1,:) = dgama(1,3,:)
           dgama(3,2,:) = dgama(2,3,:)
           
           alfa = alp(i,j,k)
           
           beta(1) = betax(i,j,k)
           beta(2) = betay(i,j,k)
           beta(3) = betaz(i,j,k)
           
           dbeta(1,1) = (betax(i+1,j,k) - betax(i-1,j,k)) / (2*dx(1))
           dbeta(2,1) = (betay(i+1,j,k) - betay(i-1,j,k)) / (2*dx(1))
           dbeta(3,1) = (betaz(i+1,j,k) - betaz(i-1,j,k)) / (2*dx(1))
           dbeta(1,2) = (betax(i,j+1,k) - betax(i,j-1,k)) / (2*dx(2))
           dbeta(2,2) = (betay(i,j+1,k) - betay(i,j-1,k)) / (2*dx(2))
           dbeta(3,2) = (betaz(i,j+1,k) - betaz(i,j-1,k)) / (2*dx(2))
           dbeta(1,3) = (betax(i,j,k+1) - betax(i,j,k-1)) / (2*dx(3))
           dbeta(2,3) = (betay(i,j,k+1) - betay(i,j,k-1)) / (2*dx(3))
           dbeta(3,3) = (betaz(i,j,k+1) - betaz(i,j,k-1)) / (2*dx(3))
           
           
           
           
           
           
           do a=1,3
              do b=1,3
                 kk(a,b) = - gama_dot(a,b)
                 do c=1,3
                    kk(a,b) = kk(a,b) + gama(c,b) * dbeta(c,a) &
                         &            + gama(a,c) * dbeta(c,b) &
                         &            + beta(c) * dgama(a,b,c)
                 end do
                 kk(a,b) = kk(a,b) / (2*alfa)
              end do
           end do
           
           kxx(i,j,k) = kk(1,1)
           kxy(i,j,k) = kk(1,2)
           kxz(i,j,k) = kk(1,3)
           kyy(i,j,k) = kk(2,2)
           kyz(i,j,k) = kk(2,3)
           kzz(i,j,k) = kk(3,3)
           
        end do
     end do
  end do
  
  call CartSymGN (ierr, cctkGH, "ADMBase::curv")
  if (ierr /= 0) call CCTK_Warn(0,172,"CalcK.F90","CalcK", "internal error")
  ierr = Boundary_SelectGroupForBC (cctkGH, int(16383,ik), &
       int(bndwidth,ik), int(options,ik), "ADMBase::curv", str_boundary)
  if (ierr /= 0) call CCTK_Warn(0,175,"CalcK.F90","CalcK", "internal error")
  
  
  if ((CCTK_Equals(metric_type, "static conformal") .ne. 0)) then
     call PhysToConfInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx, gxy, gxz, gyy, gyz, gzz)
     call PhysToConfInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx_prev, gxy_prev, gxz_prev, gyy_prev, gyz_prev, gzz_prev)





     call PhysToConfInPlace &
          (int(cctk_lsh(1),ik), int(cctk_lsh(2),ik), int(cctk_lsh(3),ik), &
          psi, gxx_next, gxy_next, gxz_next, gyy_next, gyz_next, gzz_next)

  end if
  
end subroutine CalcK
