From 7a90dca5f61a61ec27fde2268f2b823b0eadc7ad Mon Sep 17 00:00:00 2001 From: allen Date: Sun, 25 Jul 1999 20:43:55 +0000 Subject: This commit was generated by cvs2svn to compensate for changes in r2, which included commits to RCS files with non-trunk default branches. git-svn-id: http://svn.cactuscode.org/arrangements/CactusWave/WaveToyF77/trunk@3 4451c3c6-1034-4891-99ea-21147727ccdf --- src/CheckParameters.F | 52 +++++++++++++++++ src/CheckParameters.F77 | 52 +++++++++++++++++ src/InitSymBound.F77 | 47 +++++++++++++++ src/Initial.F77 | 51 ++++++++++++++++ src/InitialData.F | 126 ++++++++++++++++++++++++++++++++++++++++ src/InitialData.F77 | 126 ++++++++++++++++++++++++++++++++++++++++ src/Startup.c | 18 ++++++ src/WaveToy.F77 | 151 ++++++++++++++++++++++++++++++++++++++++++++++++ src/make.code.defn | 9 +++ 9 files changed, 632 insertions(+) create mode 100644 src/CheckParameters.F create mode 100644 src/CheckParameters.F77 create mode 100644 src/InitSymBound.F77 create mode 100644 src/Initial.F77 create mode 100644 src/InitialData.F create mode 100644 src/InitialData.F77 create mode 100644 src/Startup.c create mode 100644 src/WaveToy.F77 create mode 100644 src/make.code.defn (limited to 'src') diff --git a/src/CheckParameters.F b/src/CheckParameters.F new file mode 100644 index 0000000..c2dec7e --- /dev/null +++ b/src/CheckParameters.F @@ -0,0 +1,52 @@ + /*@@ + @file CheckParameters.F + @date + @author Gabrielle Allen + @desc + Check parameters for the wave equation evolver + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + /*@@ + @routine WaveToy_CheckParameters + @date + @author Gabrielle Allen + @desc + Check parameters for the wave equation evolver + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToy_CheckParameters(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + INTEGER CCTK_Equals + + if (CCTK_Equals(initial_data,"box").eq.1) then + + if (CCTK_Equals(type, "box").eq.0) then + call CCTK_PARAMWARN("Must have a box grid with box initial data") + end if + + if (kx.eq.0 .or. ky.eq.0 .or. kz.eq.0) then + call CCTK_PARAMWARN("Cannot have zero kx,ky,kz for box initial data") + end if + + end if + + return + end diff --git a/src/CheckParameters.F77 b/src/CheckParameters.F77 new file mode 100644 index 0000000..ccf9fbb --- /dev/null +++ b/src/CheckParameters.F77 @@ -0,0 +1,52 @@ + /*@@ + @file CheckParameters.F77 + @date + @author Gabrielle Allen + @desc + Check parameters for the wave equation evolver + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + /*@@ + @routine WaveToyF77_CheckParameters + @date + @author Gabrielle Allen + @desc + Check parameters for the wave equation evolver + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToyF77_CheckParameters(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + INTEGER CCTK_Equals + + if (CCTK_Equals(initial_data,"box").eq.1) then + + if (CCTK_Equals(type, "box").eq.0) then + call CCTK_PARAMWARN("Must have a box grid with box initial data") + end if + + if (kx.eq.0 .or. ky.eq.0 .or. kz.eq.0) then + call CCTK_PARAMWARN("Cannot have zero kx,ky,kz for box initial data") + end if + + end if + + return + end diff --git a/src/InitSymBound.F77 b/src/InitSymBound.F77 new file mode 100644 index 0000000..3ca909e --- /dev/null +++ b/src/InitSymBound.F77 @@ -0,0 +1,47 @@ + /*@@ + @file InitSymBound.F77 + @date + @author Gabrielle Allen + @desc + Sets the symmetries for Wave Toy + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_arguments.h" + + /*@@ + @routine WaveToyF77_InitSymBound + @date + @author Gabrielle Allen + @desc + Sets the symmetries for Wave Toy + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToyF77_InitSymBound(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + + INTEGER one + PARAMETER (one = 1) + INTEGER sym(3) + + sym(1) = one + sym(2) = one + sym(3) = one + + call SetCartSymmetry(cctkGH, sym,'wavetoy::phi') + call SetCartSymmetry(cctkGH, sym,'wavetoy::phi_old') + + return + end + diff --git a/src/Initial.F77 b/src/Initial.F77 new file mode 100644 index 0000000..dca2e8b --- /dev/null +++ b/src/Initial.F77 @@ -0,0 +1,51 @@ + /*@@ + @file WaveToy.F + @date + @author Tom Goodale + @desc + Solve the 3D Wave Equation + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + + /*@@ + @routine WaveToy_Initial + @date + @author Tom Goodale + @desc + Set up initial properties for Wave Toy evolver + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToy_Initial(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + CCTK_REAL :: min_delta,dx,dy,dz + + dx = cctk_delta_space(1) + dy = cctk_delta_space(2) + dz = cctk_delta_space(3) + +c Calculate timestep +c ------------------ + min_delta = min(dx,dy,dz) + cctk_delta_time = dtfac*min_delta + + end subroutine wavetoy_initial + + diff --git a/src/InitialData.F b/src/InitialData.F new file mode 100644 index 0000000..b7dfffd --- /dev/null +++ b/src/InitialData.F @@ -0,0 +1,126 @@ + /*@@ + @file InitialData.F77 + @date + @author Tom Goodale + @desc + Initial data for the 3D Wave Equation + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + + /*@@ + @routine WaveToyF77_InitialData + @date + @author Tom Goodale + @desc + Set up initial data for the wave equation + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToy_InitialData(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + INTEGER CCTK_Equals + + INTEGER i,j,k + CCTK_REAL dt, omega, pi + CCTK_REAL min_delta, dx,dy,dz + + pi = 4.0*atan(1.0) + +c Grid spacing shortcuts +c ---------------------- + dx = cctk_delta_space(1) + dy = cctk_delta_space(2) + dz = cctk_delta_space(3) + +c Calculate timestep +c ------------------ + min_delta = min(dx,dy,dz) + cctk_delta_time = dtfac*min_delta + dt = cctk_delta_time + + omega = sqrt(kx**2+ky**2+kz**2) + + if (CCTK_EQUALS(initial_data,"plane")) then + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*cos(kx*x(i,j,k)+ky*y(i,j,k) + & +kz*z(i,j,k)+omega*cctk_time) + phi_old(i,j,k) = amplitude*cos(kx*x(i,j,k)+ky*y(i,j,k) + & +kz*z(i,j,k)+omega*(cctk_time-dt)) + + end do + end do + end do + + else if (CCTK_Equals(initial_data,"gaussian").eq.1) then + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*exp( -(sqrt(x(i,j,k)**2 + & +y(i,j,k)**2+z(i,j,k)**2)-radius)**2/sigma**2) + phi_old(i,j,k) = amplitude*exp( -(sqrt(x(i,j,k)**2 + & +y(i,j,k)**2+z(i,j,k)**2)-radius(i,j,k)-dt)**2/sigma**2) + + end do + end do + end do + + else if (CCTK_Equals(initial_data, "box").eq.1) then + +c Use kx,ky,kz as number of modes in each direction. + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*sin(kx*(x(i,j,k)-0.5)*pi)* + $ sin(ky*(y(i,j,k)-0.5)*pi)* + $ sin(kz*(z(i,j,k)-0.5)*pi)* + $ cos(omega*cctk_time*pi) + + phi_old(i,j,k)= amplitude*sin(kx*(x(i,j,k)-0.5)*pi)* + $ sin(ky*(y(i,j,k)-0.5)*pi)* + $ sin(kz*(z(i,j,k)-0.5)*pi)* + $ cos(omega*(cctk_time-dt)*pi) + + + end do + end do + end do + + end if + +c Apply symmetry boundary conditions +c ---------------------------------- + call ApplySymmetry(cctkGH,"wavetoy::scalarfields") + +c Synchronise +c ----------- + call CCTK_SyncGroup(cctkGH,"wavetoy::scalarfields") + + return + end + + diff --git a/src/InitialData.F77 b/src/InitialData.F77 new file mode 100644 index 0000000..777a8ca --- /dev/null +++ b/src/InitialData.F77 @@ -0,0 +1,126 @@ + /*@@ + @file InitialData.F + @date + @author Tom Goodale + @desc + Initial data for the 3D Wave Equation + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + + /*@@ + @routine WaveToyF77_InitialData + @date + @author Tom Goodale + @desc + Set up initial data for the wave equation + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToyF77_InitialData(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + INTEGER CCTK_Equals + + INTEGER i,j,k + CCTK_REAL dt,omega, pi + CCTK_REAL min_delta,dx,dy,dz + + pi = 4.0*atan(1.0) + +c Grid spacing shortcuts +c ---------------------- + dx = cctk_delta_space(1) + dy = cctk_delta_space(2) + dz = cctk_delta_space(3) + +c Calculate timestep +c ------------------ + min_delta = min(dx,dy,dz) + cctk_delta_time = dtfac*min_delta + dt = cctk_delta_time + + omega = sqrt(kx**2+ky**2+kz**2) + + if (CCTK_Equals(initial_data,"plane").eq.1) then + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*cos(kx*x(i,j,k)+ky*y(i,j,k) + & +kz*z(i,j,k)+omega*cctk_time) + phi_old(i,j,k) = amplitude*cos(kx*x(i,j,k)+ky*y(i,j,k) + & +kz*z(i,j,k)+omega*(cctk_time-dt)) + + end do + end do + end do + + else if (CCTK_Equals(initial_data,"gaussian").eq.1) then + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*exp( -(sqrt(x(i,j,k)**2 + & +y(i,j,k)**2+z(i,j,k)**2)-radius)**2/sigma**2) + phi_old(i,j,k) = amplitude*exp( -(sqrt(x(i,j,k)**2 + & +y(i,j,k)**2+z(i,j,k)**2)-radius-dt)**2/sigma**2) + + end do + end do + end do + + else if (CCTK_Equals(initial_data, "box").eq.1) then + +c Use kx,ky,kz as number of modes in each direction. + + do k=1,cctk_lsh(3) + do j=1,cctk_lsh(2) + do i=1,cctk_lsh(1) + + phi(i,j,k) = amplitude*sin(kx*(x(i,j,k)-0.5)*pi)* + $ sin(ky*(y(i,j,k)-0.5)*pi)* + $ sin(kz*(z(i,j,k)-0.5)*pi)* + $ cos(omega*cctk_time*pi) + + phi_old(i,j,k)= amplitude*sin(kx*(x(i,j,k)-0.5)*pi)* + $ sin(ky*(y(i,j,k)-0.5)*pi)* + $ sin(kz*(z(i,j,k)-0.5)*pi)* + $ cos(omega*(cctk_time-dt)*pi) + + + end do + end do + end do + + end if + +c Apply symmetry boundary conditions +c ---------------------------------- + call ApplySymmetry(cctkGH,"wavetoy::scalarfields") + +c Synchronise +c ----------- + call CCTK_SyncGroup(cctkGH,"wavetoy::scalarfields") + + return + end + + diff --git a/src/Startup.c b/src/Startup.c new file mode 100644 index 0000000..c23386d --- /dev/null +++ b/src/Startup.c @@ -0,0 +1,18 @@ + /*@@ + @file Startup.c + @date + @author Gabrielle Allen + @desc + Register banner + @enddesc + @@*/ + +int WaveToyF77_Startup(void) +{ + + const char *banner = +"WaveToyF77: Evolutions of a Scalar Field\nWritten by: Tom Goodale"; + + CCTK_RegisterBanner(banner); + +} diff --git a/src/WaveToy.F77 b/src/WaveToy.F77 new file mode 100644 index 0000000..9a116e4 --- /dev/null +++ b/src/WaveToy.F77 @@ -0,0 +1,151 @@ + /*@@ + @file WaveToy.F77 + @date + @author Tom Goodale + @desc + Evolution routines for the wave equation solver + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_parameters.h" +#include "cctk_arguments.h" + + + /*@@ + @routine WaveToyF77_Boundaries + @date + @author Tom Goodale + @desc + Boundary conditions for the wave equation + @enddesc + @calls ApplyFlatBC,ApplyRadiativeBC + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToyF77_Boundaries(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + integer sw(3) + integer CCTK_Equals + +c Set the stencil width + sw(1)=1 + sw(2)=1 + sw(3)=1 + + call ApplySymmetry(cctkGH,"wavetoy::scalarfields") + + if (CCTK_EQUALS(bound,"flat")) then + call ApplyFlatBC(cctkGH,sw,"wavetoy::phi") + else if (CCTK_Equals(bound,"radiation").eq.1) then + call ApplyRadiativeBC(cctkGH,1.0,sw,"wavetoy::phi","wavetoy::phi_old") + end if + + return + end + +c -------------------------------------------------------------- + + /*@@ + @routine WaveToyF77_Evolution + @date + @author Tom Goodale + @desc + Evolution for the wave equation + @enddesc + @calls CCTK_SyncGroup, wavetoy_boundaries + @calledby + @history + + @endhistory + +@@*/ + + subroutine WaveToyF77_evolution(CCTK_FARGUMENTS) + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + +c Declare local variables + INTEGER i,j,k + INTEGER istart, jstart, kstart, iend, jend, kend + CCTK_REAL dx,dy,dz,dt + +c Set up shorthands +c ----------------- + dx = cctk_delta_space(1) + dy = cctk_delta_space(2) + dz = cctk_delta_space(3) + dt = cctk_delta_time + + istart = 2 + jstart = 2 + kstart = 2 + + iend = cctk_lsh(1)-1 + jend = cctk_lsh(2)-1 + kend = cctk_lsh(3)-1 + +c Do the evolution +c ---------------- + do k = kstart, kend + do j = jstart, jend + do i = istart, iend + + phi_tmp(i,j,k) = + 1 2.0*(1.0 - (dt**2)*(1.0/dx**2 + + 2 1.0/dy**2 +1.0/dz**2))*phi(i,j,k) - + 3 phi_old(i,j,k) + (dt**2) * + 5 ((phi(i+1,j,k)+phi(i-1,j,k))/dx**2 + 6 +(phi(i,j+1,k)+phi(i,j-1,k))/dy**2 + 7 +(phi(i,j,k+1)+phi(i,j,k-1))/dz**2) + + end do + end do + end do + +c Update timeslices +c ----------------- + do k = 1, cctk_lsh(3) + do j = 1, cctk_lsh(2) + do i = 1, cctk_lsh(1) + + phi_old(i,j,k) = phi(i,j,k) + phi(i,j,k) = phi_tmp(i,j,k) + + end do + end do + end do + +c Apply boundary conditions +c ------------------------- + call WaveToyF77_Boundaries(CCTK_FARGUMENTS) + +c Synchronize +c ----------- + call CCTK_SyncGroup(cctkGH,"wavetoy::scalarfields") + + return + end + + +c -------------------------------------------------------------- + + + + + + + + diff --git a/src/make.code.defn b/src/make.code.defn new file mode 100644 index 0000000..9ae50a6 --- /dev/null +++ b/src/make.code.defn @@ -0,0 +1,9 @@ +# Main make.code.defn file for thorn WaveToyF77 +# $Header$ + +# Source files in this directory +SRCS = InitialData.F77 InitSymBound.F77 CheckParameters.F77 WaveToy.F77 Startup.c + +# Subdirectories containing source files +SUBDIRS = + -- cgit v1.2.3