small

darcs-hash:20010319203034-f6438-ab6a4b4cd4ff91f151ade70f9b3e2a813ee0503b.gz

7 files changed, 39 insertions, 32 deletions

diff --git a/CarpetExtra/HydroToy/src/HydroToy.F77 b/CarpetExtra/HydroToy/src/HydroToy.F77
index 890c9a0a3..7083133f8 100644
--- a/CarpetExtra/HydroToy/src/HydroToy.F77
+++ b/CarpetExtra/HydroToy/src/HydroToy.F77
@@ -1,5 +1,5 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/HydroToy/src/HydroToy.F77,v 1.1 2001/03/18 22:37:09 eschnett Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/HydroToy/src/HydroToy.F77,v 1.2 2001/03/19 21:30:34 eschnett Exp $
       
 #include "cctk.h" 
 #include "cctk_Parameters.h"
@@ -169,9 +169,9 @@ c     Apply boundary condition
       else
          call CCTK_WARN (0, "Internal error")
       end if
-c$$$      if (ierr .lt. 0)  then
-c$$$         call CCTK_WARN (0, "Error while applying boundary condition")
-c$$$      end if
+      if (ierr .lt. 0)  then
+         call CCTK_WARN (0, "Error while applying boundary condition")
+      end if
       
       call Cart3dSymGN (ierr, cctkGH, "hydrotoy::hydroevolve")
       if (ierr .lt. 0)  then
diff --git a/CarpetExtra/IDHydroToy/src/InitialData.F77 b/CarpetExtra/IDHydroToy/src/InitialData.F77
index 7c03722ad..5bbb98032 100644
--- a/CarpetExtra/IDHydroToy/src/InitialData.F77
+++ b/CarpetExtra/IDHydroToy/src/InitialData.F77
@@ -1,5 +1,5 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/InitialData.F77,v 1.1 2001/03/18 22:37:10 eschnett Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/InitialData.F77,v 1.2 2001/03/19 21:30:37 eschnett Exp $
       
 #include "cctk.h"
 #include "cctk_Parameters.h"
@@ -17,6 +17,11 @@ c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/Initial
       CCTK_REAL omega
       integer i,j,k
       
+      CCTK_REAL vr
+      
+      external erf
+      real*8 erf
+      
       pi = 4*atan(1.d0)
       
       omega = sqrt(kx**2+ky**2+kz**2)
@@ -44,12 +49,17 @@ c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/Initial
             do j=1,cctk_lsh(2)
                do i=1,cctk_lsh(1)
                   
-                  u(i,j,k) = amplitude
-     $                 * exp(- (spher3d_r(i,j,k) - radius + cctk_time)**2
-     $                 / sigma**2)
-                  vx(i,j,k) = u(i,j,k) * cart3d_x(i,j,k)/spher3d_r(i,j,k)
-                  vy(i,j,k) = u(i,j,k) * cart3d_y(i,j,k)/spher3d_r(i,j,k)
-                  vz(i,j,k) = u(i,j,k) * cart3d_z(i,j,k)/spher3d_r(i,j,k)
+                  u(i,j,k) = amplitude / spher3d_r(i,j,k)
+     $                 * exp(- (spher3d_r(i,j,k) - radius + cctk_time)**2 / sigma**2)
+
+c     vr = -1/2*A*(sqrt(Pi)*sigma*erf((t-r+R)/sigma)+2*exp(-(t-r+R)^2/(sigma^2))*r)/(r^2)
+                  vr = -0.5d0 * amplitude
+     $                 * (sqrt(pi) * sigma * erf((cctk_time - spher3d_r(i,j,k) + radius) / sigma)
+     $                    + 2*exp(-(cctk_time - spher3d_r(i,j,k) + radius)**2 / sigma**2) * spher3d_r(i,j,k))
+     $                 / spher3d_r(i,j,k)**2
+                  vx(i,j,k) = vr * cart3d_x(i,j,k)/spher3d_r(i,j,k)
+                  vy(i,j,k) = vr * cart3d_y(i,j,k)/spher3d_r(i,j,k)
+                  vz(i,j,k) = vr * cart3d_z(i,j,k)/spher3d_r(i,j,k)
                   
                end do
             end do
diff --git a/CarpetExtra/IDHydroToy/src/make.code.defn b/CarpetExtra/IDHydroToy/src/make.code.defn
index d766da22c..3b82fb82f 100644
--- a/CarpetExtra/IDHydroToy/src/make.code.defn
+++ b/CarpetExtra/IDHydroToy/src/make.code.defn
@@ -1,8 +1,8 @@
 # Main make.code.defn file for thorn IDHydroToy
-# $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/make.code.defn,v 1.1 2001/03/18 22:37:10 eschnett Exp $
+# $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDHydroToy/src/make.code.defn,v 1.2 2001/03/19 21:30:37 eschnett Exp $
 
 # Source files in this directory
-SRCS = InitialData.F77 Startup.F77
+SRCS = InitialData.F77 Startup.F77 erf.f gammln.f gammp.f gcf.f gser.f
 
 # Subdirectories containing source files
 SUBDIRS = 
diff --git a/CarpetExtra/IDScalarWave/src/InitialData.F77 b/CarpetExtra/IDScalarWave/src/InitialData.F77
index 0bb3d8082..f0a7790ba 100644
--- a/CarpetExtra/IDScalarWave/src/InitialData.F77
+++ b/CarpetExtra/IDScalarWave/src/InitialData.F77
@@ -71,10 +71,10 @@ c     call CCTK_INFO ("IDScalarWave_InitialData")
             do j=1, cctk_lsh(2)
                do i=1, cctk_lsh(1)
 
-                  phi(i,j,k) = amplitude
-     $                 * exp(- (spher3d_r(i,j,k) - radius)**2 / sigma**2)
-                  phi_p(i,j,k) = amplitude
-     $                 * exp(- (spher3d_r(i,j,k)**2 - radius - dt)**2 / sigma**2)
+                  phi(i,j,k) = amplitude / spher3d_r(i,j,k)
+     $                 * exp(- (spher3d_r(i,j,k) - radius - cctk_time)**2 / sigma**2)
+                  phi_p(i,j,k) = amplitude / spher3d_r(i,j,k)
+     $                 * exp(- (spher3d_r(i,j,k) - radius - (cctk_time - dt))**2 / sigma**2)
 
                end do
             end do
diff --git a/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77 b/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77
index ea770344b..e9c3fe215 100644
--- a/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77
+++ b/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77
@@ -1,5 +1,5 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77,v 1.1 2001/03/17 16:05:56 eschnett Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDSpaceTimeToy/src/InitialData.F77,v 1.2 2001/03/19 21:30:42 eschnett Exp $
       
 #include "cctk.h"
 #include "cctk_Parameters.h"
@@ -45,12 +45,10 @@ c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/IDSpaceTimeToy/src/Ini
             do j=1,cctk_lsh(2)
                do i=1,cctk_lsh(1)
                   
-                  phi(i,j,k) = amplitude
-     $                 * exp(- (spher3d_r(i,j,k) - radius + cctk_time)**2
-     $                 / sigma**2)
-                  psi(i,j,k) = - phi(i,j,k)
-     $                 * 2 * (spher3d_r(i,j,k) - radius + cctk_time)
-     $                 / sigma**2
+                  phi(i,j,k) = amplitude / spher3d_r(i,j,k)
+     $                 * exp(- (spher3d_r(i,j,k) - radius - cctk_time)**2 / sigma**2)
+                  psi(i,j,k) = phi(i,j,k)
+     $                 * 2 * (spher3d_r(i,j,k) - radius - cctk_time) / sigma**2
                   
                end do
             end do
diff --git a/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77 b/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77
index 1f3dbbed3..31c2868f9 100644
--- a/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77
+++ b/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77
@@ -1,5 +1,5 @@
 c     -*-Fortran-*-
-c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77,v 1.2 2001/03/18 22:37:10 eschnett Exp $
+c     $Header: /home/eschnett/C/carpet/Carpet/CarpetExtra/SpaceTimeToy/src/SpaceTimeToy.F77,v 1.3 2001/03/19 21:30:45 eschnett Exp $
       
 #include "cctk.h" 
 #include "cctk_Parameters.h"
@@ -141,9 +141,9 @@ c     Apply boundary condition
       else
          call CCTK_WARN (0, "Internal error")
       end if
-c$$$      if (ierr .lt. 0)  then
-c$$$         call CCTK_WARN (0, "Error while applying boundary condition")
-c$$$      end if
+      if (ierr .lt. 0)  then
+         call CCTK_WARN (0, "Error while applying boundary condition")
+      end if
       
       call Cart3dSymGN (ierr, cctkGH, "spacetimetoy::spacetimeevolve")
       if (ierr .lt. 0)  then
diff --git a/CarpetExtra/WaveToyF77/src/WaveToy.F77 b/CarpetExtra/WaveToyF77/src/WaveToy.F77
index fd82abd2e..f5ae091a1 100644
--- a/CarpetExtra/WaveToyF77/src/WaveToy.F77
+++ b/CarpetExtra/WaveToyF77/src/WaveToy.F77
@@ -150,10 +150,9 @@ c     -----------------------------------
       else
          call CCTK_WARN (0, "No boundary condition selected")
       end if
-      
-c$$$      if (ierr .lt. 0)  then
-c$$$        call CCTK_WARN (0, "Boundary conditions not applied - giving up!")
-c$$$      end if
+      if (ierr .lt. 0)  then
+        call CCTK_WARN (0, "Boundary conditions not applied - giving up!")
+      end if
       
 c     Apply the symmetry boundary conditions on any coordinate axes
 c     -------------------------------------------------------------