/*@@ @file WaveToy.F @date @author Tom Goodale @desc Evolution routines for the wave equation solver @enddesc @@*/ #include "cctk.h" #include "cctk_Faces.h" #include "cctk_Parameters.h" #include "cctk_Arguments.h" #define BOUNDARY_ERROR if (ierr < 0) call CCTK_WARN(0,"WaveToyF90_Boundaries: Error in boundary routines") /*@@ @routine WaveToyF90_Evolution @date @author Tom Goodale @desc Evolution for the wave equation @enddesc @history @endhistory @@*/ subroutine WaveToyf90_Evolution(CCTK_ARGUMENTS) implicit none DECLARE_CCTK_ARGUMENTS DECLARE_CCTK_PARAMETERS ! Declare local variables INTEGER i,j,k INTEGER istart, jstart, kstart, iend, jend, kend CCTK_REAL dx,dy,dz,dt CCTK_REAL dx2,dy2,dz2,dt2 CCTK_REAL dx2i,dy2i,dz2i CCTK_REAL factor ! Set up shorthands ! ----------------- dx = CCTK_DELTA_SPACE(1) dy = CCTK_DELTA_SPACE(2) dz = CCTK_DELTA_SPACE(3) dt = CCTK_DELTA_TIME 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)) ! Do the evolution ! ---------------- do k = kstart, kend do j = jstart, jend do i = istart, iend phi(i,j,k) = factor*phi_p(i,j,k) - 1 phi_p_p(i,j,k) + (dt2) * 2 ((phi_p(i+1,j,k)+phi_p(i-1,j,k))*dx2i 3 +(phi_p(i,j+1,k)+phi_p(i,j-1,k))*dy2i 4 +(phi_p(i,j,k+1)+phi_p(i,j,k-1))*dz2i) end do end do end do end subroutine WaveToyF90_Evolution /*@@ @routine WaveToyF90_Boundaries @date @author Tom Goodale @desc Boundary conditions for the wave equation @enddesc @history @endhistory @@*/ subroutine WaveToyF90_Boundaries(CCTK_ARGUMENTS) implicit none DECLARE_CCTK_ARGUMENTS DECLARE_CCTK_PARAMETERS DECLARE_CCTK_FUNCTIONS CCTK_INT Boundary_SelectVarForBC integer i integer :: ierr=-1 integer,dimension(3):: sw=1 CCTK_REAL,parameter :: sval = 0.0 CCTK_REAL,parameter :: rzero = 0.0 CCTK_REAL,parameter :: rone = 1.0 integer,parameter :: swdir = 1 integer,parameter :: ione = 1,mione=-1 integer,parameter :: itwo = 2,mitwo=-2 integer,parameter :: ithree = 3,mithree=-3 integer,parameter :: ifour = 4,izero = 0 CCTK_REAL finf integer npow finf = 1.0d0 npow = 1 c Apply the symmetry boundary conditions on any coordinate axes c ------------------------------------------------------------- call CartSymGN(ierr,cctkGH,"wavetoy::scalarevolve") c Apply the outer boundary conditions c ----------------------------------- c Note: In each of the following calls to Boundary_SelectVarForBC, c default arguments are used, so an invalid table handle of -1 can c be passed if (CCTK_EQUALS(bound,"flat")) then ierr = Boundary_SelectVarForBC(cctkGH, CCTK_ALL_FACES, 1, -1, $ "wavetoy::phi", "Flat"); else if (CCTK_EQUALS(bound,"static")) then ierr = Boundary_SelectVarForBC(cctkGH, CCTK_ALL_FACES, 1, -1, $ "wavetoy::phi", "Static"); else if (CCTK_EQUALS(bound,"radiation")) then ierr = Boundary_SelectVarForBC(cctkGH, CCTK_ALL_FACES, 1, -1, $ "wavetoy::phi", "Radiation"); else if (CCTK_EQUALS(bound,"robin")) then ierr = Boundary_SelectVarForBC(cctkGH, CCTK_ALL_FACES, 1, -1, $ "wavetoy::phi", "Robin"); else if (CCTK_EQUALS(bound,"zero")) then c Face specific calls are not working yet with the new boundary interface: c call BndScalarDirVN(ierr,cctkGH,swdir,mione ,sval,"wavetoy::phi") c BOUNDARY_ERROR c call BndScalarDirVN(ierr,cctkGH,swdir,ione ,sval,"wavetoy::phi") c BOUNDARY_ERROR c call BndScalarDirVN(ierr,cctkGH,swdir,mitwo ,sval,"wavetoy::phi") c BOUNDARY_ERROR c call BndScalarDirVN(ierr,cctkGH,swdir,itwo ,sval,"wavetoy::phi") c BOUNDARY_ERROR c call BndScalarDirVN(ierr,cctkGH,swdir,mithree,sval,"wavetoy::phi") c BOUNDARY_ERROR c call BndScalarDirVN(ierr,cctkGH,swdir,ithree ,sval,"wavetoy::phi") c BOUNDARY_ERROR ierr = Boundary_SelectVarForBC(cctkGH, CCTK_ALL_FACES, 1, -1, $ "wavetoy::phi", "Scalar"); else if (.NOT. CCTK_EQUALS(bound,"none")) then call CCTK_WARN(0,"Unrecognized boundary condition") end if if (ierr < 0) then call CCTK_WARN(0,"WaveToyF90_Boundaries: Error in boundary routines") end if end subroutine WaveToyF90_Boundaries