From bfaa5d313c22a7a146fc01a391ef8e0c1f00ae27 Mon Sep 17 00:00:00 2001 From: lanfer Date: Tue, 28 Sep 1999 19:59:31 +0000 Subject: renamed SourceData.F to .F77 git-svn-id: http://svn.cactuscode.org/arrangements/CactusWave/IDScalarWaveElliptic/trunk@9 41e88fdd-2190-4c69-9c84-4659c8cf322e --- src/SourceData.F | 121 ----------------------------------------------------- src/SourceData.F77 | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 121 insertions(+), 121 deletions(-) delete mode 100644 src/SourceData.F create mode 100644 src/SourceData.F77 diff --git a/src/SourceData.F b/src/SourceData.F deleted file mode 100644 index 43bfe34..0000000 --- a/src/SourceData.F +++ /dev/null @@ -1,121 +0,0 @@ - /*@@ - @file SourceData.F77 - @date - @author Gabrielle Allen - @desc - Elliptic initial data for wave equation - @enddesc - @@*/ - -#include "cctk.h" -#include "cctk_arguments.h" -#include "cctk_parameters.h" - - subroutine UniformCharge(CCTK_FARGUMENTS) - -c Find static field for a uniformly charge sphere -c -c That is, solve Nabla^2 phi = - 4 pi rho -c where rho = Q/(4/3 * Pi * R^3) -c where Q is the total charge and R is the sphere radius - - implicit none - - DECLARE_CCTK_FARGUMENTS - DECLARE_CCTK_PARAMETERS - - CCTK_REAL pi - CCTK_REAL AbsTol(3), RelTol(3) - - integer iphi,iMcoeff,iNcoeff - integer i,j,k,ierr - CCTK_REAL charge_factor - - pi = 4.0*atan(1.0) - - charge_factor = 4.0d0*pi*charge*3.0d0/(4.0d0*pi*radius**3) - - do k=1, cctk_lsh(3) - do j=1, cctk_lsh(2) - do i=1, cctk_lsh(1) - - Mcoeff(i,j,k) = 0.0d0 - - print *,r(i,j,k),radius - if (r(i,j,k) <= radius) then - Ncoeff(i,j,k) = charge_factor - print *,"Here" - else - Ncoeff(i,j,k) = 0d0 - end if - - end do - end do - end do - - phi(i,j,k) = 0.0d0 - - call CCTK_VarIndex (iMcoeff, "idscalarwaveelliptic::Mcoeff") - call CCTK_VarIndex (iNcoeff, "idscalarwaveelliptic::Ncoeff") - call CCTK_VarIndex (iphi,"wavetoy::phi") - - AbsTol(1)=1.0d-5 - AbsTol(2)=1.0d-5 - AbsTol(3)=1.0d-5 - - RelTol(1)=-1 - RelTol(2)=-1 - RelTol(3)=-1 - -c Call elliptic solver to fill out phi - - call Ell_LinFlatSolver(ierr,cctkGH, - & iphi, - & iMcoeff, iNcoeff, - & AbsTol, RelTol, - & "sor") - -c Set up last timestep ... assume time symmetry - - 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) - - end do - end do - end do - - -c Output exact solution if required - - if (output_tmp==1) then - do k=1, cctk_lsh(3) - do j=1, cctk_lsh(2) - do i=1, cctk_lsh(1) - - if (r(i,j,k) >= radius) then - temp(i,j,k) = charge/r(i,j,k) - else - temp(i,j,k) = charge/(2.0d0*radius**3)* - & (3.0d0*radius**2-r(i,j,k)**2) - end if - - end do - end do - end do - - call CCTK_OutputVarAsByMethod(ierr,cctkGH, - & "idscalarwaveelliptic::temp", - & "IOASCII_1D","phi_exact") - end if - - return - end - - - - - - diff --git a/src/SourceData.F77 b/src/SourceData.F77 new file mode 100644 index 0000000..43bfe34 --- /dev/null +++ b/src/SourceData.F77 @@ -0,0 +1,121 @@ + /*@@ + @file SourceData.F77 + @date + @author Gabrielle Allen + @desc + Elliptic initial data for wave equation + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_arguments.h" +#include "cctk_parameters.h" + + subroutine UniformCharge(CCTK_FARGUMENTS) + +c Find static field for a uniformly charge sphere +c +c That is, solve Nabla^2 phi = - 4 pi rho +c where rho = Q/(4/3 * Pi * R^3) +c where Q is the total charge and R is the sphere radius + + implicit none + + DECLARE_CCTK_FARGUMENTS + DECLARE_CCTK_PARAMETERS + + CCTK_REAL pi + CCTK_REAL AbsTol(3), RelTol(3) + + integer iphi,iMcoeff,iNcoeff + integer i,j,k,ierr + CCTK_REAL charge_factor + + pi = 4.0*atan(1.0) + + charge_factor = 4.0d0*pi*charge*3.0d0/(4.0d0*pi*radius**3) + + do k=1, cctk_lsh(3) + do j=1, cctk_lsh(2) + do i=1, cctk_lsh(1) + + Mcoeff(i,j,k) = 0.0d0 + + print *,r(i,j,k),radius + if (r(i,j,k) <= radius) then + Ncoeff(i,j,k) = charge_factor + print *,"Here" + else + Ncoeff(i,j,k) = 0d0 + end if + + end do + end do + end do + + phi(i,j,k) = 0.0d0 + + call CCTK_VarIndex (iMcoeff, "idscalarwaveelliptic::Mcoeff") + call CCTK_VarIndex (iNcoeff, "idscalarwaveelliptic::Ncoeff") + call CCTK_VarIndex (iphi,"wavetoy::phi") + + AbsTol(1)=1.0d-5 + AbsTol(2)=1.0d-5 + AbsTol(3)=1.0d-5 + + RelTol(1)=-1 + RelTol(2)=-1 + RelTol(3)=-1 + +c Call elliptic solver to fill out phi + + call Ell_LinFlatSolver(ierr,cctkGH, + & iphi, + & iMcoeff, iNcoeff, + & AbsTol, RelTol, + & "sor") + +c Set up last timestep ... assume time symmetry + + 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) + + end do + end do + end do + + +c Output exact solution if required + + if (output_tmp==1) then + do k=1, cctk_lsh(3) + do j=1, cctk_lsh(2) + do i=1, cctk_lsh(1) + + if (r(i,j,k) >= radius) then + temp(i,j,k) = charge/r(i,j,k) + else + temp(i,j,k) = charge/(2.0d0*radius**3)* + & (3.0d0*radius**2-r(i,j,k)**2) + end if + + end do + end do + end do + + call CCTK_OutputVarAsByMethod(ierr,cctkGH, + & "idscalarwaveelliptic::temp", + & "IOASCII_1D","phi_exact") + end if + + return + end + + + + + + -- cgit v1.2.3