



























































































































 


































































































































































 
































































































































































































 



















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                

















































































subroutine set_coeff_8 ( nsize, loc_order, bb, gsize, imin, imax, dd )

  use All_Coeffs_mod

  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
  subroutine Diff2_coeff (cctkGH, dir, nsize, imin, imax, q, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  INTEGER*4 nsize
  INTEGER*4 imin(*)
  INTEGER*4 imax(*)
  REAL*8 q(*)
  INTEGER*4 table_handle
  end subroutine Diff2_coeff
  end interface
  interface
  subroutine Diff2_gv (cctkGH, dir1, dir2, var, dvar, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir1
  INTEGER*4 dir2
  REAL*8 var(*)
  REAL*8 dvar(*)
  INTEGER*4 table_handle
  end subroutine Diff2_gv
  end interface
  interface
  subroutine Diff_coeff (cctkGH, dir, nsize, imin, imax, q, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  INTEGER*4 nsize
  INTEGER*4 imin(*)
  INTEGER*4 imax(*)
  REAL*8 q(*)
  INTEGER*4 table_handle
  end subroutine Diff_coeff
  end interface
  interface
  subroutine Diff_gf (cctkGH, dir, var_name, dvar_name)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  character(*) var_name
  character(*) dvar_name
  end subroutine Diff_gf
  end interface
  interface
  subroutine Diff_gv (cctkGH, dir, var, dvar, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  REAL*8 var(*)
  REAL*8 dvar(*)
  INTEGER*4 table_handle
  end subroutine Diff_gv
  end interface
  interface
  subroutine Diff_up_coeff (cctkGH, dir, nsize, imin, imax, q, up, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  INTEGER*4 nsize
  INTEGER*4 imin(*)
  INTEGER*4 imax(*)
  REAL*8 q(*)
  INTEGER*4 up
  INTEGER*4 table_handle
  end subroutine Diff_up_coeff
  end interface
  interface
  subroutine Diff_up_gv (cctkGH, dir, var, dvar, up, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  REAL*8 var(*)
  REAL*8 dvar(*)
  REAL*8 up(*)
  INTEGER*4 table_handle
  end subroutine Diff_up_gv
  end interface
  interface
  subroutine GetBoundWidth (cctkGH, bsize, table_handle)
  implicit none
  integer*8 cctkGH
  INTEGER*4 bsize(*)
  INTEGER*4 table_handle
  end subroutine GetBoundWidth
  end interface
  interface
  INTEGER*4 function GetBoundarySpecification (size, nboundaryzones, is_internal, is_staggered, shiftout)
  implicit none
  INTEGER*4 size
  INTEGER*4 nboundaryzones(*)
  INTEGER*4 is_internal(*)
  INTEGER*4 is_staggered(*)
  INTEGER*4 shiftout(*)
  end function GetBoundarySpecification
  end interface
  interface
  INTEGER*4 function GetDomainSpecification (size, physical_min, physical_max, interior_min, interior_max, exterior_min, exterior_m&
  &ax, spacing)
  implicit none
  INTEGER*4 size
  REAL*8 physical_min(*)
  REAL*8 physical_max(*)
  REAL*8 interior_min(*)
  REAL*8 interior_max(*)
  REAL*8 exterior_min(*)
  REAL*8 exterior_max(*)
  REAL*8 spacing(*)
  end function GetDomainSpecification
  end interface
  interface
  subroutine GetLshIndexRanges (cctkGH, imin, imax)
  implicit none
  integer*8 cctkGH
  INTEGER*4 imin(*)
  INTEGER*4 imax(*)
  end subroutine GetLshIndexRanges
  end interface
  interface
  REAL*8 function GetScalProdCoeff ()
  implicit none
  end function GetScalProdCoeff
  end interface
  interface
  subroutine GetScalProdDiag (cctkGH, dir, nsize, sigmad)
  implicit none
  integer*8 cctkGH
  INTEGER*4 dir
  INTEGER*4 nsize
  REAL*8 sigmad(*)
  end subroutine GetScalProdDiag
  end interface
  interface
  INTEGER*4 function MoLQueryEvolvedRHS (EvolvedIndex)
  implicit none
  INTEGER*4 EvolvedIndex
  end function MoLQueryEvolvedRHS
  end interface
  interface
  INTEGER*4 function MultiPatch_GetBbox (cctkGH, size, bbox)
  implicit none
  integer*8 cctkGH
  INTEGER*4 size
  INTEGER*4 bbox(*)
  end function MultiPatch_GetBbox
  end interface
  interface
  INTEGER*4 function MultiPatch_GetBoundarySpecification (map, size, nboundaryzones, is_internal, is_staggered, shiftout)
  implicit none
  INTEGER*4 map
  INTEGER*4 size
  INTEGER*4 nboundaryzones(*)
  INTEGER*4 is_internal(*)
  INTEGER*4 is_staggered(*)
  INTEGER*4 shiftout(*)
  end function MultiPatch_GetBoundarySpecification
  end interface
  interface
  INTEGER*4 function MultiPatch_GetMap (cctkGH)
  implicit none
  integer*8 cctkGH
  end function MultiPatch_GetMap
  end interface
  interface
  INTEGER*4 function MultiPatch_GetMaps (cctkGH)
  implicit none
  integer*8 cctkGH
  end function MultiPatch_GetMaps
  end interface
  interface
  INTEGER*4 function SymmetryHandleOfName (sym_name)
  implicit none
  character(*) sym_name
  end function SymmetryHandleOfName
  end interface
  interface
  INTEGER*4 function SymmetryTableHandleForGrid (cctkGH)
  implicit none
  integer*8 cctkGH
  end function SymmetryTableHandleForGrid
  end interface
  REAL*8 diss_fraction (3)
  integer, parameter :: cctki_use_diss_fraction = kind(diss_fraction)
  REAL*8 epsdis
  integer, parameter :: cctki_use_epsdis = kind(epsdis)
  REAL*8 h_scaling (3)
  integer, parameter :: cctki_use_h_scaling = kind(h_scaling)
  REAL*8 poison_value
  integer, parameter :: cctki_use_poison_value = kind(poison_value)
  integer*8 dissipation_type
  integer, parameter :: cctki_use_dissipation_type = kind(dissipation_type)
  integer*8 norm_type
  integer, parameter :: cctki_use_norm_type = kind(norm_type)
  integer*8 operator_type
  integer, parameter :: cctki_use_operator_type = kind(operator_type)
  integer*8 vars
  integer, parameter :: cctki_use_vars = kind(vars)
  INTEGER*4 check_grid_sizes
  integer, parameter :: cctki_use_check_grid_sizes = kind(check_grid_sizes)
  INTEGER*4 onesided_interpatch_boundaries
  integer, parameter :: cctki_use_onesided_interpatch_boundaries = kind(onesided_interpatch_boundaries)
  INTEGER*4 onesided_outer_boundaries
  integer, parameter :: cctki_use_onesided_outer_boundaries = kind(onesided_outer_boundaries)
  INTEGER*4 order
  integer, parameter :: cctki_use_order = kind(order)
  INTEGER*4 poison_derivatives
  integer, parameter :: cctki_use_poison_derivatives = kind(poison_derivatives)
  INTEGER*4 poison_dissipation
  integer, parameter :: cctki_use_poison_dissipation = kind(poison_dissipation)
  INTEGER*4 sbp_1st_deriv
  integer, parameter :: cctki_use_sbp_1st_deriv = kind(sbp_1st_deriv)
  INTEGER*4 sbp_2nd_deriv
  integer, parameter :: cctki_use_sbp_2nd_deriv = kind(sbp_2nd_deriv)
  INTEGER*4 sbp_upwind_deriv
  integer, parameter :: cctki_use_sbp_upwind_deriv = kind(sbp_upwind_deriv)
  INTEGER*4 scale_with_h
  integer, parameter :: cctki_use_scale_with_h = kind(scale_with_h)
  INTEGER*4 use_dissipation
  integer, parameter :: cctki_use_use_dissipation = kind(use_dissipation)
  INTEGER*4 use_shiftout
  integer, parameter :: cctki_use_use_shiftout = kind(use_shiftout)
  INTEGER*4 use_variable_deltas
  integer, parameter :: cctki_use_use_variable_deltas = kind(use_variable_deltas)
  INTEGER*4 zero_derivs_y
  integer, parameter :: cctki_use_zero_derivs_y = kind(zero_derivs_y)
  INTEGER*4 zero_derivs_z
  integer, parameter :: cctki_use_zero_derivs_z = kind(zero_derivs_z)
  COMMON /SummationByPartsrest/diss_fraction, epsdis, h_scaling, poison_value, dissipation_type, norm_type, operator_type, vars, ch&
  &eck_grid_sizes, onesided_interpatch_boundaries, onesided_outer_boundaries, order, poison_derivatives, poison_dissipation, sbp_1s&
  &t_deriv, sbp_2nd_deriv, sbp_upwind_deriv, scale_with_h, use_dissipation, use_shiftout, use_variable_deltas, zero_derivs_y, zero_&
  &derivs_z

  INTEGER*4, intent(IN) :: nsize, loc_order
  INTEGER*4, dimension(2), intent(IN) :: bb
  INTEGER*4, intent(IN) :: gsize
  INTEGER*4, dimension(nsize), intent(OUT) :: imin, imax
  REAL*8, dimension(nsize,nsize), intent(OUT) :: dd

  REAL*8, dimension(4), save :: a
  REAL*8, dimension(7,4), save :: q 

  INTEGER*4 :: i, il, ir

  logical, save :: first = .true.

  if ( first ) then
    call coeffs_1_8 ( a, q )
    first = .false.
  end if

  dd = zero
  imin = 0
  imax = -1

  if ( bb(1) == 0 ) then
    il = 1 + gsize
  else
    dd(1:7,1) = q(1:7,1)
    imin(1) = 1; imax(1) = 1

    dd(1:7,2) = q(1:7,2)
    imin(2) = 1; imax(2) = 3

    dd(1:7,3) = q(1:7,3)
    imin(3) = 1; imax(3) = 5

    dd(1:7,4) = q(1:7,4)
    imin(4) = 1; imax(4) = 7

    il = 5
  end if
  if ( bb(2) == 0 ) then
    ir = nsize - gsize
  else
    dd(nsize-6:nsize,nsize-3) = -q(7:1:-1,4)
    imin(nsize-3) = nsize-6; imax(nsize-3) = nsize

    dd(nsize-6:nsize,nsize-2) = -q(7:1:-1,3)
    imin(nsize-2) = nsize-4; imax(nsize-2) = nsize

    dd(nsize-6:nsize,nsize-1) = -q(7:1:-1,2)
    imin(nsize-1) = nsize-2; imax(nsize-1) = nsize

    dd(nsize-6:nsize,nsize) = -q(7:1:-1,1)
    imin(nsize) = nsize; imax(nsize) = nsize

    ir = nsize - 4
  end if
  do i = il, ir
    dd(i-4:i-1,i) = -a(4:1:-1);
    dd(i+1:i+4,i) = a(1:4)
    imin(i) = i-4; imax(i) = i+4
  end do
end subroutine set_coeff_8
