Initial revision

7 files changed, 243 insertions, 0 deletions

diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/interface.ccl b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/interface.ccl
new file mode 100644
index 0000000..8a9294b
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/interface.ccl
@@ -0,0 +1,8 @@
+# file produced by user shusa, 31/3/2004
+
+# $Id$
+
+implements: Ceiling
+
+inherits: Grid 
+
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/param.ccl b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/param.ccl
new file mode 100644
index 0000000..a6dc073
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/param.ccl
@@ -0,0 +1,32 @@
+# file produced by user shusa, 31/3/2004
+# Produced with Mathematica Version 5.0 for Linux (June 9, 2003)
+
+# Mathematica script written by Ian Hinder and Sascha Husa
+
+# $Id$
+
+private:
+BOOLEAN check_active "whether to check ceiling values"
+{
+} "false"
+
+REAL ceiling_value "what value we use for the ceiling"
+{
+*:* :: "with negative values no cutoff is set"
+} -1
+
+KEYWORD type "what type of checking to apply"
+{
+  "absolute" :: "check for absolute value of GF"
+  "differential" :: "check for difference between min & max"
+} "absolute"
+
+STRING vars "List of evolved grid functions that should have dissipation added" STEERABLE=always
+{
+  .* :: "must be a valid list of grid functions"
+} ""
+
+BOOLEAN verbose "produce log output" STEERABLE=always
+{
+} "no"
+
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/schedule.ccl b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/schedule.ccl
new file mode 100644
index 0000000..b9d167c
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/schedule.ccl
@@ -0,0 +1,21 @@
+# file produced by user shusa, 31/3/2004
+# Produced with Mathematica Version 5.0 for Linux (June 9, 2003)
+
+# Mathematica script written by Ian Hinder and Sascha Husa
+
+# $Id$
+
+
+schedule Ceiling_Startup at startup
+{
+LANG: C
+} "ceiling startup message" 
+
+if (check_active)
+{
+  schedule check_ceiling at PostStep
+  {
+    LANG: C
+    
+  } "check ceiling"
+}
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Ceiling.F90 b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Ceiling.F90
new file mode 100644
index 0000000..9e1d2c1
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Ceiling.F90
@@ -0,0 +1,68 @@
+! file written by s. husa, 5/6/2004
+
+! $Id$
+
+#include "cctk.h"
+
+subroutine apply_check_abs(var, ni, nj, nk, ceiling_value)
+
+implicit none
+
+CCTK_INT,                          intent(in) :: ni, nj, nk
+CCTK_REAL, dimension (ni, nj, nk), intent(in) :: var(ni, nj, nk)
+CCTK_REAL,                         intent(in) :: ceiling_value
+
+CCTK_REAL       :: criterion
+CCTK_REAL, save :: initial_value
+
+CCTK_INT,  save :: counter
+
+counter   = counter + 1
+criterion = maxval(abs(var) + epsilon(1.0d0))
+
+if (counter == 1) then
+  initial_value = criterion
+  write (*,*) "<<<<<< using ceiling initial value", initial_value
+else
+  criterion = criterion / initial_value
+  if ((ceiling_value > 0).AND.(criterion > ceiling_value)) then
+          
+               call CCTK_INFO("Ceiling thorn terminates evolution")
+               call CCTK_TerminateNext(var)
+  endif
+endif
+
+end subroutine apply_check_abs
+
+
+subroutine apply_check_diff(var, ni, nj, nk, ceiling_value)
+
+implicit none
+
+CCTK_INT,                          intent(in) :: ni, nj, nk
+CCTK_REAL, dimension (ni, nj, nk), intent(in) :: var(ni, nj, nk)
+CCTK_REAL,                         intent(in) :: ceiling_value
+
+CCTK_REAL       :: criterion
+CCTK_REAL, save :: initial_value
+
+CCTK_INT,  save :: counter
+
+counter   = counter + 1
+
+criterion = maxval(var) - minval(var)
+
+if (counter == 1) then
+  initial_value = criterion
+  write (*,*) "<<<<<< using ceiling initial value", initial_value
+else
+  criterion = criterion / initial_value
+  if ((ceiling_value > 0).AND.(criterion > ceiling_value)) then
+
+               call CCTK_INFO("Ceiling thorn terminates evolution.")
+               call CCTK_TerminateNext (var)
+  endif
+endif
+
+end subroutine apply_check_diff
+
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Startup.c b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Startup.c
new file mode 100644
index 0000000..b42b2a1
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/Startup.c
@@ -0,0 +1,15 @@
+/*  file produced by user shusa, 31/3/2004 */
+/*  Produced with Mathematica Version 5.0 for Linux (June 9, 2003) */
+
+/*  Mathematica script written by Ian Hinder and Sascha Husa */
+
+/*  $Id$ */
+
+#include "cctk.h"
+
+int Ceiling_Startup(void)
+{
+  const char * banner = "Ceiling: abort when solution grows through the roof";
+  CCTK_RegisterBanner(banner);
+  return 0;
+}
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/make.code.defn b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/make.code.defn
new file mode 100644
index 0000000..dd1377a
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/make.code.defn
@@ -0,0 +1,8 @@
+# file produced by user shusa, 31/3/2004
+# Produced with Mathematica Version 5.0 for Linux (June 9, 2003)
+
+# Mathematica script written by Ian Hinder and Sascha Husa
+
+# $Id$
+
+SRCS = Startup.c Ceiling.F90 selectGFs.c
diff --git a/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/selectGFs.c b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/selectGFs.c
new file mode 100644
index 0000000..73edeb3
--- /dev/null
+++ b/Auxiliary/Cactus/KrancNumericalTools/Ceiling/src/selectGFs.c
@@ -0,0 +1,91 @@
+/* $Header$ */
+
+/* this code is based on Erik Schnetter's dissipation thorn */
+
+#include <assert.h>
+#include <stdlib.h>
+
+#include "cctk.h"
+#include "cctk_Arguments.h"
+#include "cctk_Parameters.h"
+
+void CCTK_FCALL
+CCTK_FNAME(apply_check_abs) (CCTK_REAL const * const var,
+                             int       const * const ni,
+                             int       const * const nj,
+                             int       const * const nk,
+                             CCTK_REAL const * const ceiling_value);
+
+
+void CCTK_FCALL
+CCTK_FNAME(apply_check_diff) (CCTK_REAL const * const var,
+                              int       const * const ni,
+                              int       const * const nj,
+                              int       const * const nk,
+                              CCTK_REAL const * const ceiling_value);
+
+static void
+call_apply_check (int const varindex, char const * const optstring, void * const arg);
+
+void
+check_ceiling (CCTK_ARGUMENTS)
+{
+  DECLARE_CCTK_ARGUMENTS;
+  DECLARE_CCTK_PARAMETERS;
+
+  CCTK_TraverseString (vars, call_apply_check, cctkGH, CCTK_GROUP_OR_VAR);
+}
+
+
+void
+call_apply_check (int const varindex, char const * const optstring, void * const arg)
+{
+  cGH const * const cctkGH = (cGH const *) arg;
+  DECLARE_CCTK_ARGUMENTS;
+  DECLARE_CCTK_PARAMETERS;
+
+  int vargroup;
+  cGroup vardata;
+
+  CCTK_REAL const * varptr;
+  int ierr /* , terminate */ ;
+
+  assert (varindex >= 0);
+
+  if (verbose) {
+    char * const fullvarname = CCTK_FullName (varindex);
+    assert (fullvarname);
+    CCTK_VInfo (CCTK_THORNSTRING,
+                "Applying ceiling check to \"%s\" ",
+                fullvarname);
+    free (fullvarname);
+  }
+
+  vargroup = CCTK_GroupIndexFromVarI (varindex);
+  assert (vargroup >= 0);
+
+  ierr = CCTK_GroupData (vargroup, &vardata);
+  assert (!ierr);
+
+  assert (vardata.grouptype == CCTK_GF);
+  assert (vardata.vartype == CCTK_VARIABLE_REAL);
+  assert (vardata.dim == cctk_dim);
+
+  varptr = CCTK_VarDataPtrI (cctkGH, 0, varindex);
+  assert (varptr);
+
+  if (type == "absolute")
+  {
+  CCTK_FNAME(apply_check_abs)
+    (varptr, &cctk_lsh[0], &cctk_lsh[1], &cctk_lsh[2], &ceiling_value);
+  } else if (type == "differential")
+  {
+  CCTK_FNAME(apply_check_diff)
+    (varptr, &cctk_lsh[0], &cctk_lsh[1], &cctk_lsh[2], &ceiling_value);
+  } else {
+  CCTK_INFO("keyword ceiling::type only allows values 'absolute' and 'differential'");
+  }
+
+  /* if (terminate > 0) {CCTK_TerminateNext (cctkGH);}  */
+}
+