Task: Implement apply_dissipation.F77 for CactusNumerical/Dissipation thorn

thorn_name: CactusNumerical/Dissipation
src_filename: apply_dissipation.F77
interface: # Interface definition for thorn Dissipation
# $Header$

IMPLEMENTS: Dissipation

INHERITS: grid SphericalSurface SpaceMask

CCTK_INT FUNCTION MoLQueryEvolvedRHS (CCTK_INT IN EvolvedIndex)
REQUIRES FUNCTION MoLQueryEvolvedRHS

CCTK_INT FUNCTION \
    SymmetryTableHandleForGrid (CCTK_POINTER_TO_CONST IN cctkGH)
USES FUNCTION SymmetryTableHandleForGrid

CCTK_INT FUNCTION HorizonRadiusInDirection                              \
   (CCTK_INT IN horizon_number,                                         \
    CCTK_INT IN N_points,                                               \
    CCTK_REAL IN ARRAY x, CCTK_REAL IN ARRAY y, CCTK_REAL IN ARRAY z,   \
    CCTK_REAL OUT ARRAY radius)
USES FUNCTION HorizonRadiusInDirection



PRIVATE:

REAL epsdisA_group TYPE=gf TAGS='Checkpoint="no" Prolongation="none"'
{
  epsdisA
} "dissipation array for spatially different dissipation"

schedule: # Schedule definitions for thorn Dissipation
# $Header$

STORAGE: epsdisA_group

SCHEDULE dissipation_paramcheck AT paramcheck
{
  LANG: C
} "Check dissipation parameters for consistency"

SCHEDULE dissipation_basegrid AT basegrid
{
  LANG: C
} "Ensure that there are enough ghost zones"

SCHEDULE setup_epsdis AT cctk_poststep after SphericalSurface_HasBeenSet
{
  LANG: C
  SYNC: epsdisA_group
} "Setup spatially varying dissipation"

SCHEDULE setup_epsdis AT cctk_postregridinitial
{
  LANG: C
  SYNC: epsdisA_group
} "Setup spatially varying dissipation"

SCHEDULE setup_epsdis AT cctk_postregrid
{
  LANG: C
  SYNC: epsdisA_group
} "Setup spatially varying dissipation"

SCHEDULE dissipation_add IN MoL_PostRHS
{
  LANG: C
} "Add Kreiss-Oliger dissipation to the right hand sides"

param: # Parameter definitions for thorn Dissipation
# $Header$

restricted:

BOOLEAN verbose "produce log output" STEERABLE=always
{
} "no"

INT order "Dissipation order" STEERABLE=always
{
  1 :: "first order accurate dissipation (using a second derivative)"
  3 :: "third order accurate dissipation (using a fourth derivative)"
  5 :: "fifth order accurate dissipation (using a sixth derivative)"
  7 :: "seventh order accurate dissipation (using an eighth derivative)"
  9 :: "ninth order accurate dissipation (using a tenth derivative)"
} 3

REAL epsdis "Dissipation strength" STEERABLE=always
{
  *:* :: "0 for no dissipation.  Unstable for epsdis<0 and epsdis>1/3"
} 0.2

STRING vars "List of evolved grid functions that should have dissipation added" STEERABLE=always
{
  .* :: "must be a valid list of grid functions"
} ""

REAL epsdis_for_level[32] "Alternate epsdis for a specific refinement level" \
  STEERABLE=always
{
  : :: "Negative indicates use default"
} -1.0

# No dissipation near excision boundary

BOOLEAN use_dissipation_near_excision "Apply excision near the excision boundary (does not work for high orders)"
{
} "yes"



# Extra dissipation in horizons

BOOLEAN extra_dissipation_in_horizons "extra dissipation in horizons" STEERABLE=always
{
} "no"

INT update_ah_every "how often to update the AH information for dissipation" STEERABLE=always
{
  0:* :: "positive iteration number"
} 1

REAL ah_slope "Slope inside AH" STEERABLE=always
{
  *:* :: "Slope from the outside value to the inside value in AHs"
} 0.2

REAL ah_radius_offset "Offset to the distance from the AH." STEERABLE=always
{
  *:* :: "negative values shift inwards, positive outwards"
} 0.0

REAL ah_max_epsdis "maximal epsdis" STEERABLE=always
{
  *:* :: "<0 for 'off', >=0 for maximal epsdis in horizon"
} -1.0

INT surface_number[100] "horizon number for extra dissipation in horizons -- SphericalSurface number" STEERABLE=always
{
  -1  :: "do not use a spherical surface"
  0:* :: "surface number (from SphericalSurface); starts from 0"
} -1

INT horizon_number[100] "horizon number for extra dissipation in horizons -- AHFinderDirect number" STEERABLE=always
{
  -1  :: "do not use a horizon"
  1:* :: "horizon number (from AHFinderDirect); starts from 1"
} -1

BOOLEAN respect_emask "respect excision mask" STEERABLE=always
{
} "no"



# Extra dissipation at outer boundary

BOOLEAN extra_dissipation_at_outerbound "increase dissipation at outer boundary" STEERABLE=always
{
} "no"

INT outer_bound_npoints "number of points in which dissipation should be increased" STEERABLE=always
{
  0:* :: "positive number"
} 3

REAL ob_slope "slope at outer boundary" STEERABLE=always
{
  0:* :: "increase dissipation"
} 5

REAL outer_boundary_max_epsdis "maximal epsdis" STEERABLE=always
{
  *:* :: "<0 for 'off', >=0 for maximal epsdis at the outer boundary"
} -1.0



shares: SpaceMask

USES BOOLEAN use_mask

configuration: # Configuration definition for thorn Dissipation
# $Header$

REQUIRES THORNS: SphericalSurface

context: paramcheck.c:
```
/* $Header$ */

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

void
dissipation_paramcheck (CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  int i;
  int want_horizon;
  
  if (extra_dissipation_in_horizons)
  {
    want_horizon = 0;
    for (i=0; i<100; ++i)
    {
      want_horizon = want_horizon | (horizon_number[i] >= 0);
    }
    
    if (want_horizon && ! CCTK_IsFunctionAliased ("HorizonRadiusInDirection"))
    {
      CCTK_PARAMWARN ("The aliased function \"HorizonRadiusInDirection\" must be defined when the parameter \"extra_dissipation_in_horizons\" is set and one of the sources is AHFinderDirect");
    }
  }
  if (respect_emask && !use_mask)
  {
    CCTK_PARAMWARN ("You can only respect the emask if it is used (use_mask)");
  }
}

```

basegrid.c:
```
/* $Header$ */

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

void dissipation_basegrid (CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  int d;
  
  if (cctk_dim != 3) {
    CCTK_WARN (0, "This thorn supports only dim=3");
  }
  
  for (d=0; d<cctk_dim; ++d) {
    if (cctk_nghostzones[d] < (order+1)/2) {
      CCTK_WARN (0, "This thorn requires at least (order+1)/2 ghost zones");
    }
  }

  for (d=0;d<cctk_ash[0]*cctk_ash[1]*cctk_ash[2];d++) {
    epsdisA[d]=epsdis;
  }
}

```

make.code.defn:
```
# Main make.code.defn file for thorn Dissipation
# $Header$

# Source files in this directory
SRCS = apply_dissipation.F77 basegrid.c dissipation.c paramcheck.c setup_epsdis.c

# Subdirectories containing source files
SUBDIRS = 

```

dissipation.c:
```
/* $Header$ */

#include <assert.h>
#include <stdlib.h>
#include <stdio.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

void CCTK_FCALL
CCTK_FNAME(apply_dissipation) (CCTK_REAL const * const var,
                               CCTK_REAL       * const rhs,
                               int       const * const ni,
                               int       const * const nj,
                               int       const * const nk,
                               CCTK_REAL const * const dx,
                               CCTK_INT  const * const order,
                               CCTK_REAL const * const epsdis);

static void
apply (int const varindex, char const * const optstring, void * const arg);

void
dissipation_add (CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  CCTK_TraverseString (vars, apply, cctkGH, CCTK_GROUP_OR_VAR);
}

void
apply (int const varindex, char const * const optstring, void * const arg)
{
  cGH const * const cctkGH = (cGH const *) arg;
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  int rhsindex;
  int vargroup, rhsgroup;
  cGroup vardata, rhsdata;
  CCTK_REAL const * varptr;
  CCTK_REAL       * rhsptr;
  CCTK_REAL dx[3];
  int d;
  int ierr;
  
  assert (varindex >= 0);
  
  for (d=0; d<cctk_dim; ++d) {
    if (cctk_nghostzones[d] < (order+1)/2) {
      CCTK_WARN (0, "This thorn requires at least (order+1)/2 ghost zones");
    }
  }
  
  for (d=0; d<3; ++d) {
    dx[d] = CCTK_DELTA_SPACE(d);
  }
  
  rhsindex = MoLQueryEvolvedRHS (varindex);
  if (rhsindex < 0) {
    char * const fullvarname = CCTK_FullName (varindex);
    assert (fullvarname);
    CCTK_VWarn (0, __LINE__, __FILE__, CCTK_THORNSTRING,
                "There is no RHS variable registered with MoL for the evolved variable \"%s\"",
                fullvarname);
    free (fullvarname);
  }
  assert (rhsindex >= 0);
  
  if (verbose) {
    char * const fullvarname = CCTK_FullName (varindex);
    char * const fullrhsname = CCTK_FullName (rhsindex);
    assert (fullvarname);
    assert (fullrhsname);
    CCTK_VInfo (CCTK_THORNSTRING,
                "Applying dissipation to \"%s\" (RHS \"%s\")",
                fullvarname, fullrhsname);
    free (fullvarname);
    free (fullrhsname);
  }
  
  vargroup = CCTK_GroupIndexFromVarI (varindex);
  assert (vargroup >= 0);
  rhsgroup = CCTK_GroupIndexFromVarI (rhsindex);
  assert (rhsgroup >= 0);

  ierr = CCTK_GroupData (vargroup, &vardata);
  assert (!ierr);
  ierr = CCTK_GroupData (rhsgroup, &rhsdata);
  assert (!ierr);

  assert (vardata.grouptype == CCTK_GF);
  assert (vardata.vartype == CCTK_VARIABLE_REAL);
  assert (vardata.dim == cctk_dim);
  assert (rhsdata.grouptype == CCTK_GF);
  assert (rhsdata.vartype == CCTK_VARIABLE_REAL);
  assert (rhsdata.dim == cctk_dim);

  varptr = CCTK_VarDataPtrI (cctkGH, 0, varindex);
  assert (varptr);
  rhsptr = CCTK_VarDataPtrI (cctkGH, 0, rhsindex);
  assert (rhsptr);

  CCTK_FNAME(apply_dissipation)
    (varptr, rhsptr, &cctk_lsh[0], &cctk_lsh[1], &cctk_lsh[2],
     dx, &order, epsdisA);
}

```

setup_epsdis.c:
```
/* $Header$ */

#include <assert.h>
#include <math.h>
#include <stdlib.h>
#include <stdio.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "util_ErrorCodes.h"
#include "util_Table.h"

#define MAXDIM 3
#define REFLEVEL (ilogb(cctk_levfac[0]))

void
setup_epsdis (CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  int ai,aj,ak;
  int ni,nj,nk;
  int i,j,k,s,l,m;
  int index,indexP;
  int ierr;
  int npts;
  CCTK_INT *inds;
  CCTK_REAL *xa,*ya,*za,*rads;
  CCTK_REAL maxrad;
  CCTK_REAL xmin,xmax, ymin,ymax, zmin,zmax;
  CCTK_REAL odx,ody,odz;
  CCTK_REAL radp;
  const CCTK_INT  MAXSURFNUM=100; /* XXX hard limit */
  CCTK_INT doBC[2*MAXDIM],symbnd[2*MAXDIM];  
  CCTK_INT symtable;
  int reflvl = REFLEVEL;

  if (verbose) {
    CCTK_VInfo(CCTK_THORNSTRING,"Setting up spatially varying dissipation at T=%g",
               (double)cctk_time);
  }

  ai=cctk_ash[0];
  aj=cctk_ash[1];
  ak=cctk_ash[2];
  ni=cctk_lsh[0];
  nj=cctk_lsh[1];
  nk=cctk_lsh[2];

  if (epsdis_for_level[reflvl] > 0.0)
    for (i=0; i<ai*aj*ak; ++i)
      epsdisA[i] = epsdis_for_level[reflvl];
  else
    for (i=0;i<ai*aj*ak;i++)
      epsdisA[i]=epsdis;

  if (extra_dissipation_at_outerbound) 
  {
    symtable = SymmetryTableHandleForGrid (cctkGH);
    if (symtable < 0) CCTK_WARN (1, "unable to get symmetry table");
    ierr=Util_TableGetIntArray(symtable, 6, symbnd, "symmetry_handle");
    if (ierr != 6) CCTK_WARN (1, "unable to get symmetry handle");
    for (i = 0; i < 6; i++) {
      doBC[i] = cctk_bbox[i]!=0 && symbnd[i] < 0;
    }

    if(doBC[0]) {
      for (k=0;k<nk;k++) {
        for (j=0;j<nj;j++) {
          for (i=0;i<outer_bound_npoints;i++) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,outer_bound_npoints,j,k); 
            epsdisA[index]=epsdis+ob_slope*fabs(x[index]-x[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
          }
        }
      }
    }
    if(doBC[1]) {
      for (k=0;k<nk;k++) {
        for (j=0;j<nj;j++) {
          for (i=ni-1;i>=ni-outer_bound_npoints;i--) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,ni-outer_bound_npoints-1,j,k); 
	    epsdisA[index]=epsdis+ob_slope*fabs(x[index]-x[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
          }
        }
      }
    }
    if(doBC[2]) {
      for (k=0;k<nk;k++) {
        for (j=0;j<outer_bound_npoints;j++) {
          for (i=0;i<ni;i++) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,i,outer_bound_npoints,k); 
            epsdisA[index]=epsdis+ob_slope*fabs(y[index]-y[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
          }
        }
      }
    }
    if(doBC[3]) {
      for (k=0;k<nk;k++) {
        for (j=nj-1;j>=nj-outer_bound_npoints;j--) {
          for (i=0;i<ni;i++) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,i,nj-outer_bound_npoints-1,k); 
            epsdisA[index]=epsdis+ob_slope*fabs(y[index]-y[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
	  }
	}
      }
    }

    if(doBC[4]) {
      for (k=0;k<outer_bound_npoints;k++) {
        for (j=0;j<nj;j++) {
          for (i=0;i<ni;i++) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,i,j,outer_bound_npoints); 
            epsdisA[index]=epsdis+ob_slope*fabs(z[index]-z[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
          }
        }
      }
    }
    if(doBC[5]) {
      for (k=nk-1;k>=nk-outer_bound_npoints;k--) {
        for (j=0;j<nj;j++) {
          for (i=0;i<ni;i++) {
            index = CCTK_GFINDEX3D(cctkGH,i,j,k);
            indexP= CCTK_GFINDEX3D(cctkGH,i,j,nk-outer_bound_npoints-1); 
            epsdisA[index]=epsdis+ob_slope*fabs(z[index]-z[indexP]);
	    if (outer_boundary_max_epsdis >= 0 && epsdisA[index] > outer_boundary_max_epsdis) {
	      epsdisA[index] = outer_boundary_max_epsdis;
	    }
          }
        }
      }
    }
  }

  if (extra_dissipation_in_horizons && cctk_iteration%update_ah_every == 0)
  {
    if (verbose) {
      CCTK_INFO("Linear Interpolation into AH surfaces");
    }

    for (s=0;s<MAXSURFNUM;s++)
    {
      if (surface_number[s]==-1 && horizon_number[s]==-1) {
        continue;
      }
      
      if (surface_number[s]<0 || horizon_number[s]<=0) {
        CCTK_VWarn (1, __LINE__, __FILE__, CCTK_THORNSTRING,
                    "Invalid specification for horizon %d", s);
        continue;
      }
      
      if (! sf_valid[surface_number[s]]) {
        if (verbose) {
          CCTK_VInfo(CCTK_THORNSTRING,
                     "Invalid Surface: s=%d, sf_va=%d, surf_no=%d, ah_no=%d",
                     s,(int)sf_valid[surface_number[s]],
                     (int)surface_number[s],(int)horizon_number[s]);
        }
        continue;
      }
      
      if (! CCTK_IsFunctionAliased ("HorizonRadiusInDirection"))
      {
        CCTK_WARN (1, "The aliased function \"HorizonRadiusInDirection\" must be defined when the parameter \"extra_dissipation_in_horizons\" is set and one of the sources is AHFinderDirect");
        continue;
      }

      maxrad=sf_max_radius[surface_number[s]];
      odx=sf_origin_x[surface_number[s]];
      ody=sf_origin_y[surface_number[s]];
      odz=sf_origin_z[surface_number[s]];
      xmin=odx-maxrad;
      xmax=odx+maxrad;
      ymin=ody-maxrad;
      ymax=ody+maxrad;
      zmin=odz-maxrad;
      zmax=odz+maxrad;

      assert (cctk_nghostzones[0]>=2);
      assert (cctk_nghostzones[1]>=2);
      assert (cctk_nghostzones[2]>=2);

      npts=0;
      for (i=2;i<ni-2;i++)
       for (j=2;j<nj-2;j++)
        for (k=2;k<nk-2;k++) {
          m=CCTK_GFINDEX3D(cctkGH,i,j,k);
          if ((  x[m]<=xmax&&x[m]>=xmin
               &&y[m]<=ymax&&y[m]>=ymin
               &&z[m]<=zmax&&z[m]>=zmin) &&
              (!respect_emask || (
               (emask[CCTK_GFINDEX3D(cctkGH,i-1,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i-2,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i+1,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i+2,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j-1,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j-2,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j+1,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j+2,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k-1)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k-2)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k+1)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k+2)]>0.4)
              ))
             )
          {
            npts++;
          }
        }

      xa=(CCTK_REAL *)   malloc(npts*sizeof(CCTK_REAL));
      ya=(CCTK_REAL *)   malloc(npts*sizeof(CCTK_REAL));
      za=(CCTK_REAL *)   malloc(npts*sizeof(CCTK_REAL));
      rads=(CCTK_REAL *) malloc(npts*sizeof(CCTK_REAL));
      inds=(CCTK_INT *)  malloc(npts*sizeof(CCTK_INT));

      for (i=0;i<npts;i++) {
        rads[i]=0;
        inds[i]=0;
      }

      l=0;
      for (i=2;i<ni-2;i++)
       for (j=2;j<nj-2;j++)
        for (k=2;k<nk-2;k++) {
          m=CCTK_GFINDEX3D(cctkGH,i,j,k);
          if ((  x[m]<=xmax&&x[m]>=xmin
               &&y[m]<=ymax&&y[m]>=ymin
               &&z[m]<=zmax&&z[m]>=zmin) &&
              (!respect_emask || (
               (emask[CCTK_GFINDEX3D(cctkGH,i-1,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i-2,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i+1,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i+2,j,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j-1,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j-2,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j+1,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j+2,k)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k-1)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k-2)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k+1)]>0.4) &&
               (emask[CCTK_GFINDEX3D(cctkGH,i,j,k+2)]>0.4)
              ))
             )
          {
            xa[l]=x[m];
            ya[l]=y[m];
            za[l]=z[m];
            inds[l]=m;
            l++;
          }
        }

      ierr=HorizonRadiusInDirection(horizon_number[s],
                                    npts,
                                    xa, ya, za,  rads);
      assert(!ierr);

      for (i=0;i<npts;i++) {
        radp=sqrt((xa[i]-odx)*(xa[i]-odx)+(ya[i]-ody)*(ya[i]-ody)+
                  (za[i]-odz)*(za[i]-odz));
        if (radp<=rads[i]+ah_radius_offset) {
          epsdisA[inds[i]]=epsdis+ ah_slope*(rads[i]+ah_radius_offset-radp);
          if (ah_max_epsdis >= 0 && epsdisA[inds[i]] > ah_max_epsdis) {
            epsdisA[inds[i]] = ah_max_epsdis;
          }
        }
      }

      free(xa);
      free(ya);
      free(za);
      free(rads);
      free(inds);
    }
  }

}

```


combined_doc_context: ## README (README):
```
CVS info   : $Header$

Cactus Code Thorn Dissipation
Thorn Author(s)     : Erik Schnetter <schnetter@aei.mpg.de>
Thorn Maintainer(s) : Erik Schnetter <schnetter@aei.mpg.de>
--------------------------------------------------------------------------

Purpose of the thorn:

Add fourth order Kreiss-Oliger dissipation to the right hand side of
evolution equations.  This thorn works only for time evolutions that
use MoL.  I thank Scott Hawley who wrote a very similar thorn
HawleyThorns/Dissipation for evolutions that do not use MoL; this
thorn here is modelled after his.

For a description of the artificial dissipation, see H. Kreiss and
J. Oliger, "Methods for the Approximate Solution of Time Dependent
Problems", vol. 10 of Global Atmospheric Research Programme (GARP):
GARP Publication Series (GARP Publication, 1973).

```

## Documentation (.tex files):
Files: documentation.tex

```tex
=== documentation.tex ===
% *======================================================================*
%  Cactus Thorn template for ThornGuide documentation
%  Author: Ian Kelley
%  Date: Sun Jun 02, 2002
%  $Header$                                                             
%
%  Thorn documentation in the latex file doc/documentation.tex 
%  will be included in ThornGuides built with the Cactus make system.
%  The scripts employed by the make system automatically include 
%  pages about variables, parameters and scheduling parsed from the 
%  relevant thorn CCL files.
%  
%  This template contains guidelines which help to assure that your     
%  documentation will be correctly added to ThornGuides. More 
%  information is available in the Cactus UsersGuide.
%                                                    
%  Guidelines:
%   - Do not change anything before the line
%       % START CACTUS THORNGUIDE",
%     except for filling in the title, author, date, etc. fields.
%        - Each of these fields should only be on ONE line.
%        - Author names should be separated with a \\ or a comma.
%   - You can define your own macros, but they must appear after
%     the START CACTUS THORNGUIDE line, and must not redefine standard 
%     latex commands.
%   - To avoid name clashes with other thorns, 'labels', 'citations', 
%     'references', and 'image' names should conform to the following 
%     convention:          
%       ARRANGEMENT_THORN_LABEL
%     For example, an image wave.eps in the arrangement CactusWave and 
%     thorn WaveToyC should be renamed to CactusWave_WaveToyC_wave.eps
%   - Graphics should only be included using the graphicx package. 
%     More specifically, with the "\includegraphics" command.  Do
%     not specify any graphic file extensions in your .tex file. This 
%     will allow us to create a PDF version of the ThornGuide
%     via pdflatex.
%   - References should be included with the latex "\bibitem" command. 
%   - Use \begin{abstract}...\end{abstract} instead of \abstract{...}
%   - Do not use \appendix, instead include any appendices you need as 
%     standard sections. 
%   - For the benefit of our Perl scripts, and for future extensions, 
%     please use simple latex.     
%
% *======================================================================* 
% 
% Example of including a graphic image:
%    \begin{figure}[ht]
% 	\begin{center}
%    	   \includegraphics[width=6cm]{MyArrangement_MyThorn_MyFigure}
% 	\end{center}
% 	\caption{Illustration of this and that}
% 	\label{MyArrangement_MyThorn_MyLabel}
%    \end{figure}
%
% Example of using a label:
%   \label{MyArrangement_MyThorn_MyLabel}
%
% Example of a citation:
%    \cite{MyArrangement_MyThorn_Author99}
%
% Example of including a reference
%   \bibitem{MyArrangement_MyThorn_Author99}
%   {J. Author, {\em The Title of the Book, Journal, or periodical}, 1 (1999), 
%   1--16. {\tt http://www.nowhere.com/}}
%
% *======================================================================* 

% If you are using CVS use this line to give version information
% $Header$

\documentclass{article}

% Use the Cactus ThornGuide style file
% (Automatically used from Cactus distribution, if you have a 
%  thorn without the Cactus Flesh download this from the Cactus
%  homepage at www.cactuscode.org)
\usepackage{../../../../doc/latex/cactus}

\begin{document}

% The author of the documentation
\author{Erik Schnetter \textless schnetter@aei.mpg.de\textgreater, Bernard Kelly \textless bernard.j.kelly@nasa.gov\textgreater}

% The title of the document (not necessarily the name of the Thorn)
\title{Dissipation}

% the date your document was last changed, if your document is in CVS, 
% please use:
\date{$ $Date$ $}

\maketitle

% Do not delete next line
% START CACTUS THORNGUIDE

% Add all definitions used in this documentation here 
%   \def\mydef etc

% Add an abstract for this thorn's documentation
\begin{abstract}
Add $n$th-order Kreiss-Oliger dissipation to the right hand side of
evolution equations.  This thorn is intended for time evolutions that
use MoL.
\end{abstract}

% The following sections are suggestive only.
% Remove them or add your own.

\section{Physical System}
For a description of Kreiss-Oliger artificial dissipation, see \cite{kreiss-oliger}.

The additional dissipation terms appear as follows, for a general grid function $U$. Here, the
tensor character of the field is irrelevant: each component of, say, $\tilde{\gamma}_{ij}$ is
treated as an independent field for dissipation purposes.
%
\begin{eqnarray*}
\partial_t U &=& \partial_t U + (-1)^{(p+3)/2} \epsilon \frac{1}{2^{p+1}} \left( h_x^{p} \frac{\partial^{(p+1)}}{\partial x^{(p+1)}} + h_y^{p} \frac{\partial^{(p+1)}}{\partial y^{(p+1)}} +
h_z^{p} \frac{\partial^{(p+1)}}{\partial z^{(p+1)}}\right) U, \\
             &=& \partial_t U + (-1)^{(p+3)/2} \epsilon \frac{h^{p}}{2^{p+1}} \left( \frac{\partial^{(p+1)}}{\partial x^{(p+1)}} + \frac{\partial^{(p+1)}}{\partial y^{(p+1)}} +
\frac{\partial^{(p+1)}}{\partial z^{(p+1)}}\right) U,
\end{eqnarray*}
%
where $h_x$, $h_y$, and $h_z$ are the local grid spacings in each Cartesian direction, and the
second equality holds in the usual situation where the three are equal: $h_x = h_y = h_z = h$.

\section{Implementation in Cactus}

The \texttt{Dissipation} thorn's dissipation rate is controlled by a small number of parameters:
%
\begin{itemize}
  \item \texttt{order} is the order $p$ of the dissipation, implying the use of the $(p+1)$-st spatial derivatives;
  \item \texttt{epsdiss} is the overall dissipation strength $\epsilon$.
\end{itemize}

Currently available values of \texttt{order} are $p \in \{1, 3, 5, 7, 9\}$. To apply dissipation at
order $p$ requires that we have at least $(p+1)/2$ ghostzones --- $\{1, 2, 3, 4, 5\}$, respectively.

The list of fields to be dissipated is specified in the parameter \texttt{vars}. The thorn does
not allow for individually tuned dissipation strengths for different fields. However, the
dissipation strength $\epsilon$ can be varied according to refinement level, using the parameter
array \texttt{epsdis\_for\_level}, which overrides \texttt{epsdiss} if set.

The thorn also allows for enhanced dissipation within the apparent horizons, triggered by the
boolean parameter \texttt{extra\_dissipation\_in\_horizons}, and near the outer boundary,
triggered by the boolean parameter \texttt{extra\_dissipation\_at\_outerbound}. Both of these
default to ``no''.

\subsection{Acknowledgements}
I thank Scott Hawley who wrote a very similar thorn
\texttt{HawleyThorns/Dissipation} for evolutions that do not use MoL;
this thorn here is modelled after his.

\begin{thebibliography}{9}
\bibitem{kreiss-oliger}
H. Kreiss and J. Oliger, \emph{Methods for the Approximate Solution of
Time Dependent Problems}, vol.\ 10 of Global Atmospheric Research
Programme (GARP): GARP Publication Series (GARP Publication, 1973)
\end{thebibliography}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference answer:
src_code: c     $Header$

#include "cctk.h"

      subroutine apply_dissipation (var, rhs, ni, nj, nk, dx, order, epsdis)
      implicit none
      
      integer   ni, nj, nk
      CCTK_REAL var(ni,nj,nk), rhs(ni,nj,nk)
      CCTK_REAL dx(3), idx(3)
      CCTK_INT  order
      CCTK_REAL epsdis(ni,nj,nk)
      
      integer   i, j, k
      
      idx(1) = 1 / dx(1)
      idx(2) = 1 / dx(2)
      idx(3) = 1 / dx(3)
      
      if (order .eq. 1) then
         
c$omp parallel do private(i,j,k)
         do k = 2, nk-1
            do j = 2, nj-1
               do i = 2, ni-1
                  rhs(i,j,k) = rhs(i,j,k) + epsdis(i,j,k)
     $                 * (+ (var(i-1,j,k) - 2*var(i,j,k) + var(i+1,j,k)) * idx(1)
     $                    + (var(i,j-1,k) - 2*var(i,j,k) + var(i,j+1,k)) * idx(2)
     $                    + (var(i,j,k-1) - 2*var(i,j,k) + var(i,j,k+1)) * idx(3))
                  
               end do
            end do
         end do
         
      else if (order .eq. 3) then
         
c$omp parallel do private(i,j,k)
         do k = 3, nk-2
            do j = 3, nj-2
               do i = 3, ni-2
                  
                  rhs(i,j,k) = rhs(i,j,k) - epsdis(i,j,k) / 16
     $                 * (+ (var(i-2,j,k) - 4*var(i-1,j,k) + 6*var(i,j,k) - 4*var(i+1,j,k) + var(i+2,j,k)) * idx(1)
     $                    + (var(i,j-2,k) - 4*var(i,j-1,k) + 6*var(i,j,k) - 4*var(i,j+1,k) + var(i,j+2,k)) * idx(2)
     $                    + (var(i,j,k-2) - 4*var(i,j,k-1) + 6*var(i,j,k) - 4*var(i,j,k+1) + var(i,j,k+2)) * idx(3))
                  
               end do
            end do
         end do
         
      else if (order .eq. 5) then
         
c$omp parallel do private(i,j,k)
        do k = 4, nk-3
          do j = 4, nj-3
            do i = 4, ni-3
               
              rhs(i,j,k) = rhs(i,j,k) + epsdis(i,j,k) / 64
     $           * (+ (var(i-3,j,k) - 6*var(i-2,j,k) + 15*var(i-1,j,k) - 20*var(i,j,k) + 15*var(i+1,j,k) - 6*var(i+2,j,k) + var(i+3,j,k)) * idx(1)
     $              + (var(i,j-3,k) - 6*var(i,j-2,k) + 15*var(i,j-1,k) - 20*var(i,j,k) + 15*var(i,j+1,k) - 6*var(i,j+2,k) + var(i,j+3,k) ) * idx(2)
     $              + (var(i,j,k-3) - 6*var(i,j,k-2) + 15*var(i,j,k-1) - 20*var(i,j,k) + 15*var(i,j,k+1) - 6*var(i,j,k+2) + var(i,j,k+3) ) * idx(3))
              
            end do
          end do
        end do
        
      else if (order .eq. 7) then
         
c$omp parallel do private(i,j,k)
        do k = 5, nk-4
          do j = 5, nj-4
            do i = 5, ni-4
               
              rhs(i,j,k) = rhs(i,j,k) - epsdis(i,j,k) / 256
     $           * (+ (var(i-4,j,k) - 8*var(i-3,j,k) + 28*var(i-2,j,k) - 56*var(i-1,j,k) + 70*var(i,j,k) - 56*var(i+1,j,k) + 28*var(i+2,j,k) - 8*var(i+3,j,k) + var(i+4,j,k)) * idx(1)
     $              + (var(i,j-4,k) - 8*var(i,j-3,k) + 28*var(i,j-2,k) - 56*var(i,j-1,k) + 70*var(i,j,k) - 56*var(i,j+1,k) + 28*var(i,j+2,k) - 8*var(i,j+3,k) + var(i,j+4,k)) * idx(2)
     $              + (var(i,j,k-4) - 8*var(i,j,k-3) + 28*var(i,j,k-2) - 56*var(i,j,k-1) + 70*var(i,j,k) - 56*var(i,j,k+1) + 28*var(i,j,k+2) - 8*var(i,j,k+3) + var(i,j,k+4)) * idx(3))
              
            end do
          end do
        end do
        
      else if (order .eq. 9) then
         
c$omp parallel do private(i,j,k)
        do k = 6, nk-5
          do j = 6, nj-5
            do i = 6, ni-5
               
              rhs(i,j,k) = rhs(i,j,k) + epsdis(i,j,k) / 1024
     $           * (+ (var(i-5,j,k) - 10*var(i-4,j,k) + 45*var(i-3,j,k) - 120*var(i-2,j,k) + 210*var(i-1,j,k) - 252*var(i,j,k) + 210*var(i+1,j,k) - 120*var(i+2,j,k) + 45*var(i+3,j,k) - 10*var(i+4,j,k) + var(i+5,j,k)) * idx(1)
     $              + (var(i,j-5,k) - 10*var(i,j-4,k) + 45*var(i,j-3,k) - 120*var(i,j-2,k) + 210*var(i,j-1,k) - 252*var(i,j,k) + 210*var(i,j+1,k) - 120*var(i,j+2,k) + 45*var(i,j+3,k) - 10*var(i,j+4,k) + var(i,j+5,k)) * idx(2)
     $              + (var(i,j,k-5) - 10*var(i,j,k-4) + 45*var(i,j,k-3) - 120*var(i,j,k-2) + 210*var(i,j,k-1) - 252*var(i,j,k) + 210*var(i,j,k+1) - 120*var(i,j,k+2) + 45*var(i,j,k+3) - 10*var(i,j,k+4) + var(i,j,k+5)) * idx(3))
              
            end do
          end do
        end do
        
      else
         
         call CCTK_WARN (0, "internal error")
         
      end if
      
      end