














































 
  






































































 


































































































































































 





























































































































































































 






















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                




















































































 

      subroutine WaveToyF77_Evolution(cctk_dim,cctk_gsh,cctk_lsh,cctk_lb
     &nd,cctk_ubnd,cctk_tile_min,cctk_tile_max,cctk_ash,cctk_alignment,c
     &ctk_alignment_offset,cctk_from,cctk_to,cctk_bbox,cctk_delta_time,c
     &ctk_time,cctk_delta_space,cctk_origin_space,cctk_levfac,cctk_levof
     &f,cctk_levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_n
     &ghostzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, co
     &arse_dx,coarse_dy,coarse_dz,phi,phi_p,phi_p_p,r,x,y,z)

      implicit none

c

      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_alignme
     &nt)
      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_orig
     &in_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_levof
     &fdenom)
      INTEGER cctk_timefac
      integer, parameter :: cctki_use_cctk_timefac = kind(cctk_timefac)
      INTEGER cctk_convlevel
      integer, parameter :: cctki_use_cctk_convlevel = kind(cctk_convlev
     &el)
      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_nghos
     &tzones)
      INTEGER cctk_iteration
      integer, parameter :: cctki_use_cctk_iteration = kind(cctk_iterati
     &on)
      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 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)
      REAL*8 phi (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi = kind(phi)
      REAL*8 phi_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi_p = kind(phi_p)
      REAL*8 phi_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi_p_p = kind(phi_p_p)
      REAL*8 r (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_r = kind(r)
      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)

      INTEGER*4, parameter :: izero = 0
      integer, parameter :: ik = kind(izero)

      INTEGER   i,j,k
      INTEGER   istart, jstart, kstart, iend, jend, kend
      REAL*8 dx,dy,dz,dt
      REAL*8 dx2,dy2,dz2,dt2
      REAL*8 dx2i,dy2i,dz2i

      REAL*8 factor

c
c
      dx = (cctk_delta_space(1)/cctk_levfac(1))
      dy = (cctk_delta_space(2)/cctk_levfac(2))
      dz = (cctk_delta_space(3)/cctk_levfac(3))
      dt = (cctk_delta_time/cctk_timefac)

      dx2 = dx*dx
      dy2 = dy*dy
      dz2 = dz*dz
      dt2 = dt*dt

      dx2i = 1.0/dx2
      dy2i = 1.0/dy2
      dz2i = 1.0/dz2

      istart = 2
      jstart = 2
      kstart = 2
      
      iend = cctk_lsh(1)-1
      jend = cctk_lsh(2)-1
      kend = cctk_lsh(3)-1

      factor = 2*(1 - (dt2)*(dx2i + dy2i + dz2i))

c
c
      do k = kstart, kend
         do j = jstart, jend
            do i = istart, iend
               
               phi(i,j,k) = factor*phi_p(i,j,k) -
     &              phi_p_p(i,j,k) + (dt2) * 
     &              ((phi_p(i+1,j,k)+phi_p(i-1,j,k))*dx2i
     &              +(phi_p(i,j+1,k)+phi_p(i,j-1,k))*dy2i
     &              +(phi_p(i,j,k+1)+phi_p(i,j,k-1))*dz2i)

            end do
         end do
      end do
         
      return
      end 


 

      subroutine WaveToyF77_Boundaries(cctk_dim,cctk_gsh,cctk_lsh,cctk_l
     &bnd,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_levo
     &ff,cctk_levoffdenom,cctk_timefac,cctk_convlevel,cctk_convfac,cctk_
     &nghostzones,cctk_iteration,cctkGH,cctk_ash1,cctk_ash2,cctk_ash3, c
     &oarse_dx,coarse_dy,coarse_dz,phi,phi_p,phi_p_p,r,x,y,z)

      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_alignme
     &nt)
      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_orig
     &in_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_levof
     &fdenom)
      INTEGER cctk_timefac
      integer, parameter :: cctki_use_cctk_timefac = kind(cctk_timefac)
      INTEGER cctk_convlevel
      integer, parameter :: cctki_use_cctk_convlevel = kind(cctk_convlev
     &el)
      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_nghos
     &tzones)
      INTEGER cctk_iteration
      integer, parameter :: cctki_use_cctk_iteration = kind(cctk_iterati
     &on)
      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 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)
      REAL*8 phi (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi = kind(phi)
      REAL*8 phi_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi_p = kind(phi_p)
      REAL*8 phi_p_p (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_phi_p_p = kind(phi_p_p)
      REAL*8 r (cctk_ash1,cctk_ash2,cctk_ash3)
      integer, parameter :: cctki_use_r = kind(r)
      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)
      integer*8 bound
      integer, parameter :: cctki_use_bound = kind(bound)
      COMMON /wavetoyrest/bound
      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_SelectVarForBC (GH, faces, boundary_wi
     &dth, table_handle, var_name, bc_name)
      implicit none
      integer*8 GH
      INTEGER*4 faces
      INTEGER*4 boundary_width
      INTEGER*4 table_handle
      character(*) var_name
      character(*) bc_name
      end function Boundary_SelectVarForBC
      end interface

      INTEGER*4, parameter :: izero = 0
      integer, parameter :: ik = kind(izero)

c
      INTEGER*4 ierr

      CHARACTER*100 boundary
      INTEGER length

      ierr = 0

c
      call CCTK_FortranString(length,bound,boundary)

c
c
c
c
c
      if ((CCTK_Equals(bound,"flat") .ne. 0) .or. (CCTK_Equals(bound,"st
     &atic") .ne. 0) .or.
     $    (CCTK_Equals(bound,"radiation") .ne. 0) .or. (CCTK_Equals(boun
     &d,"robin") .ne. 0) .or.
     $    (CCTK_Equals(bound,"none") .ne. 0) ) then
         ierr = Boundary_SelectVarForBC(cctkGH, int(16383,ik), 1_ik, -1_
     &ik,
     $        "wavetoy::phi", boundary)
      else if ((CCTK_Equals(bound,"zero") .ne. 0)) then
         ierr = Boundary_SelectVarForBC(cctkGH, int(16383,ik), 1_ik, -1_
     &ik,
     $        "wavetoy::phi", "Scalar")
      end if

      if (ierr .lt. 0)  then
        call CCTK_Warn(0,147,"WaveToy.F77","WaveToyF77","WaveToyF77_Boun
     &daries: Error selecting boundary condition")
      end if

      return
      end 
