Task: Implement LinearExtrapBnd.F for CactusExamples/SampleBoundary thorn

thorn_name: CactusExamples/SampleBoundary
src_filename: LinearExtrapBnd.F
interface: # Interface definition for thorn SampleBoundary
# $Header$

implements: LinExtrapBnd

CCTK_INT FUNCTION Boundary_RegisterPhysicalBC(CCTK_POINTER_TO_CONST IN GH, \
  CCTK_INT IN CCTK_FPOINTER function_pointer(CCTK_POINTER_TO_CONST IN GH, \
                                             CCTK_INT IN num_vars, \
                                             CCTK_INT ARRAY IN var_indices, \
                                             CCTK_INT ARRAY IN faces, \
                                             CCTK_INT ARRAY IN boundary_widths, \
                                             CCTK_INT ARRAY IN table_handles),\
  CCTK_STRING IN bc_name)
USES FUNCTION Boundary_RegisterPhysicalBC



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

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

schedule SampleBoundary_RegisterBCs at CCTK_BASEGRID
{
  lang: C
} "Register boundary conditions that this thorn provides"


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


context: Register.c:
```
 /*@@
   @file      Register.c
   @date      6 May 2003
   @author    David Rideout
   @desc 
              Register implemented boundary conditions.
   @enddesc 
   @version   $Header$
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "SampleBnd.h"

static const char *rcsid = "$Header$";

CCTK_FILEVERSION(CactusExamples_SampleBoundary_Register_c);

/********************************************************************
 *********************     Local Data Types   ***********************
 ********************************************************************/

/********************************************************************
 ********************* Local Routine Prototypes *********************
 ********************************************************************/

/********************************************************************
 ***************** Aliased Routine Prototypes ***********************
 ********************************************************************/

/********************************************************************
 ***************** Scheduled Routine Prototypes *********************
 ********************************************************************/

void SampleBoundary_RegisterBCs(CCTK_ARGUMENTS);

/********************************************************************
 ********************* Other Routine Prototypes *********************
 ********************************************************************/

/********************************************************************
 *********************     Local Data   *****************************
 ********************************************************************/

/********************************************************************
 *********************     Aliased Routines   ***********************
 ********************************************************************/

/********************************************************************
 *********************     Scheduled Routines   *********************
 ********************************************************************/

 /*@@
   @routine    SampleBoundary_RegisterBCs
   @date       6 May 2003
   @author     David Rideout
   @desc 
               Register all boundary conditions implemented by this thorn.
   @enddesc 
   @calls      
   @history 
   @endhistory
   @var        CCTK_ARGUMENTS
   @vdesc      Cactus argument list
   @vtype      CCTK_*
   @vio        in
   @endvar
   @returntype void
@@*/

void SampleBoundary_RegisterBCs(CCTK_ARGUMENTS)
{
  int err;  
  
  err = Boundary_RegisterPhysicalBC((CCTK_POINTER) cctkGH, 
                                    (phys_bc_fn_ptr) &BndLinExtrap,
                                    "LinExtrap");
  if (err)
  {
    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
               "Error %d when registering routine to handle \"LinExtrap\" "
                 "boundary condition", err);
  }
}

/********************************************************************
 *********************     Local Routines   *************************
 ********************************************************************/

```

SampleBnd.h:
```
 /*@@
   @file      SampleBnd.h
   @date      6 May 2003
   @author    David Rideout
   @desc
              Prototypes for boundary routines
   @enddesc
 @@*/


#ifndef _SAMPLEBND_H_
#define _SAMPLEBND_H_


#ifdef __cplusplus
extern "C"
{
#endif

/* data type for pointer to function which implements a physical boundary 
   condition: */
typedef CCTK_INT (*const phys_bc_fn_ptr)(const CCTK_POINTER_TO_CONST, const CCTK_INT, 
                                   const CCTK_INT *, const CCTK_INT *, 
                                   const CCTK_INT *, const CCTK_INT *);

/* prototype for routine registed as providing 'LinExtrap' boundary condition */
int BndLinExtrap (const CCTK_POINTER_TO_CONST GH, const CCTK_INT num_vars, 
                  const CCTK_INT *var_indices,  const CCTK_INT *faces, 
                  const CCTK_INT *widths, const CCTK_INT *table_handles);

#ifdef __cplusplus
}
#endif

#endif  /* _SAMPLEBND_H_ */

```

LinearExtrapBnd.c:
```
 /*@@
   @file      LinearExtrapBnd.c
   @date      24 Jan 2003
   @author    David Rideout
   @desc
              Function which is registered as handling Carsten Gundlach's 
              "linear_extrap_one_bndry" boundary condition
   @enddesc
   @history
   @hdate     
   @hauthor   
   @hdesc     
   @endhistory
   @version   $Id$
 @@*/

#include "cctk.h"

#include "util_Table.h"

/* the rcs ID and its dummy function to use it */
static const char *rcsid = "$Header$";
CCTK_FILEVERSION(CactusExamples_SampleBoundary_LinearExtrapBnd_c);

/* #define DEBUG */

/********************************************************************
 *********************     Local Data Types   ***********************
 ********************************************************************/

/********************************************************************
 ********************* External Routine Prototypes ******************
 ********************************************************************/

void CCTK_FCALL CCTK_FNAME(Linear_extrap_one_bndry)(int *doBC, const int *lsh, 
                                                    CCTK_REAL *var_ptr);

int BndLinExtrap (const cGH *GH, int num_vars, int *vars, int *faces, 
                  int *widths, int *tables);

/********************************************************************
 ********************    Scheduled Routines   ***********************
 ********************************************************************/


/********************************************************************
 ********************    External Routines   ************************
 ********************************************************************/

/*@@
   @routine    BndLinExtrap
   @date       24 Jan 2003
   @author     David Rideout
   @desc
               Apply linear extrapolation boundary condition to a
               group of grid functions given by their indices.
               This routine is registered to handle the linear
               extrapolation boundary condition.
               Can only handle 3D grid functions.

               All symmetries are ignored for now -- the symmetry bcs must 
               overwrite the output of this bc where necessary
   @enddesc

   @var        GH
   @vdesc      Pointer to CCTK grid hierarchy
   @vtype      const cGH *
   @vio        in
   @endvar
   @var        num_vars
   @vdesc      number of variables passed in through vars[]
   @vtype      int
   @vio        in
   @endvar
   @var        var_indices
   @vdesc      array of variable indicies to which to apply this boundary 
               condition
   @vtype      int *
   @vio        in
   @endvar
   @var        faces
   @vdesc      array of set of faces to which to apply the bc
   @vtype      int
   @vio        in
   @endvar
   @var        widths
   @vdesc      array of boundary widths for each variable
   @vtype      int
   @vio        in
   @endvar
   @var        table_handles
   @vdesc      array of table handles which hold extra arguments
   @vtype      int
   @vio        in
   @endvar

   @calls      CCTK_GroupIndexFromVarI
               CCTK_GroupDimI
               CCTK_VarTypeI

               Linear_extrap_one_bndry
   @history
   @hdate      
   @hauthor    
   @hdesc                     
   @endhistory

   @returntype int
   @returndesc
      each bit of return value indicates a possible error code, as follows:
       0  for success
      -1  invalid faces specification
      -2  unsupported staggering
      -4  boundary width != 1
      -8  potentially valid table handle
      -16 dimension is not supported
      -32 possibly called with a grid scalar
   @endreturndesc
@@*/

int BndLinExtrap (const cGH *GH, int num_vars, int *vars, int *faces, 
                  int *widths, int *tables)
{
  int i, j, gi, gtype, dim, retval, err;
  int doBC[6];
  const int *lsh, *bbox;
  CCTK_INT symtable;
  CCTK_INT symbnd[6];
  CCTK_INT is_physical[6];
  CCTK_REAL *var_ptr;
  cGroupDynamicData group_data;

  retval = 0;

#ifdef DEBUG
  printf("calling BndLinExtrap at iter %d\n", GH->cctk_iteration);
#endif

  /* loop through variables, one at a time (since this is all that 
     Linear_extrap_one_bndry can handle) */
  for (i=0; i<num_vars; ++i) {

    /* Check to see if faces specification is valid */
    if (faces[i] != CCTK_ALL_FACES)
    {
      CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
                 "Faces specification %d for LinExtrap boundary conditions on "
                 "%s is not implemented yet.  "
                 "Not applying bc.", faces[i],
                 CCTK_VarName(vars[i]));
      retval |= 1;
    }

    /* Check to see if the boundary width might be something other than one */
    if (widths[i] != 1)
    {
      CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
                 "LinExtrapBnd does not handle boundary widths other than one."
                 "  Assuming boundary width of one on all faces.");
      retval |= 4;
    }

    /* Ignore table handles */
    if (tables[i] >= 0) 
    {
      CCTK_VWarn (1, __LINE__, __FILE__, CCTK_THORNSTRING,
                  "Possibly valid table handle.  LinExtrapBnd ignores "
                  "information stored in tables.");
      retval |= 8;
    }

    /* Gather some important information about this grid variable */
    gi = CCTK_GroupIndexFromVarI(vars[i]);
    gtype = CCTK_GroupTypeI(gi);
    if (gtype==CCTK_GF)
    {
      dim = GH->cctk_dim;
      bbox = GH->cctk_bbox;
      lsh = GH->cctk_lsh;
    }
    else
    {
      err = CCTK_GroupDynamicData(GH, gi, &group_data);
      if (err)
      {
        CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING,
                   "Error getting group information for group %s.  "
                   "Perhaps it is a grid scalar?", CCTK_GroupName(gi));
        retval |= 32;
      }
      dim = group_data.dim;
      bbox = group_data.bbox;
      lsh = group_data.lsh;
    }
    var_ptr = GH->data[vars[i]][0];
#ifdef DEBUG
    printf("dim=%d bbox[0]=%d lsh[1]=%d\n", dim, bbox[0], lsh[1]);
    printf("var_ptr=%p\n", var_ptr);
#endif

    /* Check dimension */
    if (dim != 3)
    {
      CCTK_VWarn (1, __LINE__, __FILE__, CCTK_THORNSTRING,
                  "Variable dimension of %d not supported.  "
		  "Not applying bc.", dim);
      retval |= 16;
    }

    /* Decide on which faces the bc should be applied */
    for (j=0; j<2*dim; ++j)
    {
      doBC[j] = lsh[j/2] > widths[i]+2 && bbox[j];
    }

    /* see if we have a physical boundary */
    symtable = SymmetryTableHandleForGrid (GH);
    if (symtable < 0) CCTK_WARN (0, "internal error");
    err = Util_TableGetIntArray (symtable, 2 * dim, symbnd, "symmetry_handle");
    if (err != 2 * dim) CCTK_WARN (0, "internal error");
    for (j = 0; j < 2 * dim; j++)
    {
      is_physical[j] = symbnd[j] < 0;
    }

    /* Only do bc on faces without a symmetry bc */
    for (j=0; j<2*dim; ++j)
    {
      doBC[j] &= is_physical[i];
    }

    /* Apply the boundary condition */
    if( !( retval & ( 1 | 16 ) ) ) /* unless particularly bad errors */
      CCTK_FNAME(Linear_extrap_one_bndry)(doBC, lsh, var_ptr);
  }

  return -retval;
}

/********************************************************************
 ********************    Internal Routines   ************************
 ********************************************************************/

/********************************************************************
 *********************     Local Routines   *************************
 ********************************************************************/

```

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

# Source files in this directory
SRCS = Register.c LinearExtrapBnd.c LinearExtrapBnd.F

# Subdirectories containing source files
SUBDIRS = 

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn SampleBoundary
Author(s)    : Carsten Gundlach
               David Rideout
Maintainer(s): Cactus team
Licence      : LGPL
--------------------------------------------------------------------------

1. Purpose

This thorn provides a simple example of how to create and register a
physical boundary condition.  It implements a linear extrapolation
boundary condition in three dimensions.  


```

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

```tex
=== documentation.tex ===
\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}

\title{Sample (Physical) Boundary Condition}
\author{David Rideout}
\date{$ $Date$ $}

\maketitle

% Do not delete next line
% START CACTUS THORNGUIDE

\begin{abstract}
Provides a simple linear extrapolation boundary condition, to serve as
an example for people who wish to write their own physical boundary conditions.
\end{abstract}


\section{Introduction}

This thorn provides a linear extrapolation boundary condition in three
dimensions.  It is intended as an example for writing physical
boundary conditions.  (See the ThornGuide for
\texttt{CactusBase/Boundary} for details on Cactus boundary
conditions.)  It is registered under the name \texttt{LinearExtrap}.

The code which actually implements the boundary condition is written
in fixed form Fortran 90, in the file \texttt{LinearExtrapBnd.F}.
This code was written by Carsten Gundlach, and is taken directly from
the thorn \texttt{AEIThorns/Exact}.  As such it illustrates a simple
way to properly implement a boundary condition using Fortran code
which was written long before the current boundary implementation
specification.

\section{Obtaining This Thorn}

This thorn is provided within the \texttt{CactusExamples} arrangement,
in the standard Cactus distribution.

\section{Some Details}

The \texttt{LinearExtrap} boundary condition registered by this thorn
only works in three dimensions.  The value on a boundary face is
determined by fitting a straight line through the two points 'inside'
of the boundary point.  For the edges and corners, two points along
the diagonal are used to determine the line.  In this way the thorn
also provides an example of how to handle edges and corners, though
only in a dimension specific way.

\section{Using This Thorn}

To use this thorn, simply activate it in your parameter file, select
some variables for the \texttt{LinearExtrap} boundary condition, and
be sure that \texttt{ApplyBCs} (as e.g. \texttt{MyThorn\_ApplyBCs}) is
scheduled at an appropriate point.

%\section{Numerical Implementation}
%\subsection{Special Behaviour}
%\subsection{Interaction With Other Thorns}
%\subsection{Examples}
%\subsection{Support and Feedback}
%\subsection{Thorn Source Code}
%\subsection{Thorn Documentation}
%\subsection{Acknowledgements}
%\begin{thebibliography}{9}
%\end{thebibliography}
%\section{History}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}
% LocalWords:  LinearExtrap LinearExtrapBnd MyThorn

```



Reference solution:
src_code: c This subroutine linearly extrapolates one Cactus variable
c on one boundary of the Cactus grid box.
C $Header$

#include "cctk.h"


      subroutine Linear_extrap_one_bndry(doBC, lsh, var)

      implicit none

      integer doBC(6)
      integer lsh(3)
      CCTK_REAL var(lsh(1),lsh(2),lsh(3))

      integer nx,ny,nz

C     Grid parameters.

      nx = lsh(1)
      ny = lsh(2)
      nz = lsh(3)

C     Linear extrapolation from the interiors to the boundaries.
C     Does not support octant or quadrant.

C     6 faces.

      if (doBC(1).eq.1) then 
         var(1,:,:) = 2.d0 * var(2,:,:) - var(3,:,:)
      endif
      if (doBC(3).eq.1) then 
         var(:,1,:) = 2.d0 * var(:,2,:) - var(:,3,:)
      endif
      if (doBC(5).eq.1) then 
         var(:,:,1) = 2.d0 * var(:,:,2) - var(:,:,3)
      endif
      if (doBC(2).eq.1) then 
         var(nx,:,:) = 2.d0 * var(nx-1,:,:) - var(nx-2,:,:)
      endif
      if (doBC(4).eq.1) then 
         var(:,ny,:) = 2.d0 * var(:,ny-1,:) - var(:,ny-2,:)
      endif
      if (doBC(6).eq.1) then 
         var(:,:,nz) = 2.d0 * var(:,:,nz-1) - var(:,:,nz-2)
      endif

C     12 edges.
C     4 round face x=min.
      if ( doBC(1).eq.1
     $     .and. doBC(3).eq.1) then 
         var(1,1,:) = 2.d0 * var(2,2,:) - var(3,3,:)
      end if

      if ( doBC(1).eq.1
     $     .and. doBC(4).eq.1) then 
         var(1,ny,:) = 2.d0 * var(2,ny-1,:) - var(2,ny-2,:)
      end if

      if ( doBC(1).eq.1
     $     .and. doBC(5).eq.1) then 
         var(1,:,1) = 2.d0 * var(2,:,2) - var(3,:,3)
      end if

      if ( doBC(1).eq.1
     $     .and. doBC(6).eq.1) then 
         var(1,:,nz) = 2.d0 * var(2,:,nz-1) - var(3,:,nz-2)
      end if

C     4 around face x=max.
      if ( doBC(2).eq.1
     $     .and. doBC(3).eq.1) then 
         var(nx,1,:) = 2.d0 * var(nx-1,2,:) - var(nx-2,3,:)
      end if

      if ( doBC(2).eq.1
     $     .and. doBC(4).eq.1) then 
         var(nx,ny,:) = 2.d0 * var(nx-1,ny-1,:) - var(nx-2,ny-2,:)
      end if

      if ( doBC(2).eq.1
     $     .and. doBC(5).eq.1) then 
         var(nx,:,1) = 2.d0 * var(nx-1,:,2) - var(nx-2,:,3)
      end if

      if ( doBC(2).eq.1
     $     .and. doBC(6).eq.1) then 
         var(nx,:,nz) = 2.d0 * var(nx-1,:,nz-1) - var(nx-2,:,nz-2)
      end if

C     Remaining 2 in y=min.
      if ( doBC(3).eq.1 .and. ny.ge.4
     $     .and. doBC(5).eq.1) then
         var(:,1,1) = 2.d0 * var(:,2,2) - var(:,3,3)
      end if

      if ( doBC(3).eq.1 .and. ny.ge.4
     $     .and. doBC(6).eq.1) then 
         var(:,1,nz) = 2.d0 * var(:,2,nz-1) - var(:,2,nz-2)
      end if

C     Remaining 2 in y=ymax.      
      if ( doBC(4).eq.1 .and. ny.ge.4
     $     .and. doBC(5).eq.1) then
         var(:,ny,1) = 2.d0 * var(:,ny-1,2) - var(:,ny-2,3)  
      end if

      if ( doBC(4).eq.1 .and. ny.ge.4
     $     .and. doBC(6).eq.1) then 
         var(:,ny,nz) = 2.d0 * var(:,ny-1,nz-1) - var(:,ny-2,nz-2)
      end if

C     8 corners.

      if (doBC(1).eq.1 .and. doBC(3).eq.1 .and. doBC(5).eq.1) then
         var(1,1,1) = 2.d0*var(2,2,2) - var(3,3,3)
      end if
      if (doBC(1).eq.1 .and. doBC(3).eq.1 .and. doBC(6).eq.1) then
         var(1,1,nz) = 2.d0*var(2,2,nz-1) - var(3,3,nz-2)
      end if
      if (doBC(1).eq.1 .and. doBC(4).eq.1 .and. doBC(5).eq.1) then
         var(1,ny,1) = 2.d0*var(2,ny-1,2) - var(3,ny-2,3)
      end if
      if (doBC(1).eq.1 .and. doBC(4).eq.1 .and. doBC(6).eq.1) then
         var(1,ny,nz) = 2.d0*var(2,ny-1,nz-1) - var(3,ny-2,nz-2)
      end if
      if (doBC(2).eq.1 .and. doBC(3).eq.1 .and. doBC(5).eq.1) then
         var(nx,1,1) = 2.d0*var(nx-1,2,2) - var(nx-2,3,3)
      end if
      if (doBC(2).eq.1 .and. doBC(3).eq.1 .and. doBC(6).eq.1) then
         var(nx,1,nz) = 2.d0*var(nx-1,2,nz-1) - var(nx-2,3,nz-2)
      end if
      if (doBC(2).eq.1 .and. doBC(4).eq.1 .and. doBC(5).eq.1) then
         var(nx,ny,1) = 2.d0*var(nx-1,ny-1,2) - var(nx-2,ny-2,3)
      end if
      if (doBC(2).eq.1 .and. doBC(4).eq.1 .and. doBC(6).eq.1) then
         var(nx,ny,nz) = 2.d0*var(nx-1,ny-1,nz-1) - var(nx-2,ny-2,nz-2)
      end if
      
      return
      end