Task: Implement init.F90 for Carpet/CarpetProlongateTest thorn

thorn_name: Carpet/CarpetProlongateTest
src_filename: init.F90
interface: # Interface definition for thorn CarpetProlongateTest

IMPLEMENTS: CarpetProlongateTest

INHERITS: grid



CCTK_REAL scalar TYPE=gf TIMELEVELS=3 TAGS='ProlongationParameter="CarpetProlongateTest::prolongation"'
{
  u
} "Grid function"

CCTK_REAL scaled TYPE=gf TIMELEVELS=3
{
  uscaled
} "Scaled grid function"

CCTK_REAL difference TYPE=gf TIMELEVELS=3
{
  u0 du
} "Error in grid function"



CCTK_REAL interp_difference TYPE=array DIM=3 SIZE=interp_nx,interp_ny,interp_nz DISTRIB=default
{
  interp_x interp_y interp_z
  interp_u
  interp_u0 interp_du
} "Error in interpolated grid array"



CCTK_REAL errornorm TYPE=scalar "Norm of error in grid function"
CCTK_REAL interp_errornorm TYPE=scalar "Norm of error in interpolated grid array"

schedule: # Schedule definitions for thorn CarpetProlongateTest

STORAGE: scalar[3] scaled[3] difference[3]
STORAGE: interp_difference
STORAGE: errornorm interp_errornorm



SCHEDULE CarpetProlongateTest_Init AT initial
{
  LANG: Fortran
  SYNC: scalar scaled
} "Set up initial data"

SCHEDULE CarpetProlongateTest_Init AT evol
{
  LANG: Fortran
  SYNC: scalar scaled
} "Set up initial data"

SCHEDULE CarpetProlongateTest_Diff IN MoL_PostStep
{
  LANG: Fortran
} "Test data"



SCHEDULE CarpetProlongateTest_InterpInit AT initial
{
  LANG: Fortran
  OPTIONS: global-late
} "Set up interpolation"

SCHEDULE CarpetProlongateTest_Interp IN MoL_PostStep
{
  LANG: Fortran
  OPTIONS: global-late
} "Interpolate"

SCHEDULE CarpetProlongateTest_InterpDiff IN MoL_PostStep AFTER CarpetProlongateTest_Interp
{
  LANG: Fortran
  OPTIONS: global-late
} "Test interpolated data"



SCHEDULE CarpetProlongateTest_NormInit IN MoL_PostStep AFTER (CarpetProlongateTest_Diff CarpetProlongateTest_InterpDiff)
{
  LANG: Fortran
  OPTIONS: global-late
} "Calculate error norm"

SCHEDULE CarpetProlongateTest_NormCalc IN MoL_PostStep AFTER CarpetProlongateTest_NormInit
{
  LANG: Fortran
  OPTIONS: global-late loop-local
} "Calculate error norm"

SCHEDULE CarpetProlongateTest_NormReduce IN MoL_PostStep AFTER CarpetProlongateTest_NormCalc
{
  LANG: Fortran
  OPTIONS: global-late
} "Calculate error norm"

param: # Parameter definitions for thorn CarpetProlongateTest

CCTK_INT power_x "Polynomial power of x coordinate"
{
  *:* :: ""
} 0

CCTK_INT power_y "Polynomial power of y coordinate"
{
  *:* :: ""
} 0

CCTK_INT power_z "Polynomial power of z coordinate"
{
  *:* :: ""
} 0

CCTK_INT power_t "Polynomial power of t coordinate"
{
  *:* :: ""
} 0



KEYWORD prolongation "The prolongation operator to use" STEERABLE=recover
{
  "Lagrange"          :: ""
  "ENO"               :: ""
  "WENO"              :: ""
  "TVD"               :: ""
  "Lagrange_monotone" :: ""
} "Lagrange"

STRING interpolator "The interpolator to use" STEERABLE=always
{
  "" :: "must be a registered interpolator"
} "Lagrange polynomial interpolation"

STRING interpolator_options "Options for the interpolator" STEERABLE=always
{
  "" :: "must be a valid options specification"
} "order=2"

CCTK_INT interp_nx "number of points for interpolated region"
{
  0:* :: ""
} 4
CCTK_INT interp_ny "number of points for interpolated region"
{
  0:* :: ""
} 4
CCTK_INT interp_nz "number of points for interpolated region"
{
  0:* :: ""
} 4

CCTK_REAL interp_xmin "xmin for interpolated region"
{
  *:* :: ""
} -0.5
CCTK_REAL interp_ymin "ymin for interpolated region"
{
  *:* :: ""
} -0.5
CCTK_REAL interp_zmin "zmin for interpolated region"
{
  *:* :: ""
} -0.5

CCTK_REAL interp_xmax "xmax for interpolated region"
{
  *:* :: ""
} +0.5
CCTK_REAL interp_ymax "ymax for interpolated region"
{
  *:* :: ""
} +0.5
CCTK_REAL interp_zmax "zmax for interpolated region"
{
  *:* :: ""
} +0.5

configuration: # Configuration definition for thorn CarpetProlongateTest

REQUIRES Fortran

context: make.code.defn:
```
# Main make.code.defn file for thorn CarpetProlongateTest

# Source files in this directory
SRCS = init.F90

# Subdirectories containing source files
SUBDIRS = 

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn CarpetProlongateTest
Author(s)    : Erik Schnetter <schnetter@cct.lsu.edu>
Maintainer(s): Erik Schnetter <schnetter@cct.lsu.edu>
Licence      : GPL
--------------------------------------------------------------------------

1. Purpose

Test prolongation in Carpet.

The basic idea is to set up a grid function containing a polynomial of
a certain order of the coordinates. Prolongation (interpolation) with
sufficiently high order must preserve these polynomials exactly (up to
floating-point round-off).

We test restriction as well, but the restriction operators are not
high-order accurate. Since restriction is first order accurate, and we
disable the restriction tests for the higher orders.

```

## 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@cct.lsu.edu\textgreater}

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

% the date your document was last changed, if your document is in CVS,
% please use:
%    \date{$ $Date: 2004-01-07 14:12:39 -0600 (Wed, 07 Jan 2004) $ $}
\date{July 10 2010}

\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}

\end{abstract}

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

\section{Introduction}

\section{Physical System}

\section{Numerical Implementation}

\section{Using This Thorn}

\subsection{Obtaining This Thorn}

\subsection{Basic Usage}

\subsection{Special Behaviour}

\subsection{Interaction With Other Thorns}

\subsection{Examples}

\subsection{Support and Feedback}

\section{History}

\subsection{Thorn Source Code}

\subsection{Thorn Documentation}

\subsection{Acknowledgements}


\begin{thebibliography}{9}

\end{thebibliography}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference answer:
src_code: #include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "cctk_Parameters.h"



module CarpetProlongateTest
  implicit none
  
contains
  
  ! Set the time scaling factor to a sum of powers, ensuring that the
  ! scaling factor is not zero for t=0. Also, for power_t=0, the
  ! scaling factor is 1 and has no effect.
  function density_time_scale (tt) result (tscale)
    DECLARE_CCTK_PARAMETERS
    CCTK_REAL, intent(in) :: tt
    CCTK_REAL :: tscale
    integer   :: n
    
    tscale = 1
    do n = 1, power_t
       tscale = tscale + tt ** n
    end do
  end function density_time_scale
  
  elemental function density_sum (xx, yy, zz) result (res)
    DECLARE_CCTK_PARAMETERS
    CCTK_INT, parameter :: izero = 0
    CCTK_REAL, intent(in) :: xx, yy, zz
    CCTK_REAL :: res
    
    res = 0 + &
         1 * density(xx,yy,zz, power_x,izero  ,izero  ) + &
         2 * density(xx,yy,zz, izero  ,power_y,izero  ) + &
         3 * density(xx,yy,zz, izero  ,izero  ,power_z) + &
         4 * density(xx,yy,zz, power_x,power_y,izero  ) + &
         5 * density(xx,yy,zz, power_x,izero  ,power_z) + &
         6 * density(xx,yy,zz, izero  ,power_y,power_z) + &
         7 * density(xx,yy,zz, power_x,power_y,power_z)
  end function density_sum
  
  ! Calculate an integrand that is polynomial in the coordinates
  ! (xx,yy,zz), and which is zero if integrated over [0,2]^3
  elemental function density (xx, yy, zz, px, py, pz) result (res)
    CCTK_REAL, intent(in) :: xx, yy, zz
    CCTK_INT,  intent(in) :: px, py, pz
    CCTK_REAL :: res
    
    CCTK_REAL, parameter :: xmin = 0
    CCTK_REAL, parameter :: ymin = 0
    CCTK_REAL, parameter :: zmin = 0
    CCTK_REAL, parameter :: xmax = 2
    CCTK_REAL, parameter :: ymax = 2
    CCTK_REAL, parameter :: zmax = 2
    
    CCTK_REAL :: integral, volume
    
    integral = &
         (xmax**(px+1) - xmin**(px+1)) / (px+1) * &
         (ymax**(py+1) - ymin**(py+1)) / (py+1) * &
         (zmax**(pz+1) - zmin**(pz+1)) / (pz+1)
    volume = (xmax - xmin) * (ymax - ymin) * (zmax - zmin)
    
    res = xx**px * yy**py * zz**pz - integral / volume
  end function density
  
end module CarpetProlongateTest



subroutine CarpetProlongateTest_Init (CCTK_ARGUMENTS)
  use CarpetProlongateTest
  implicit none
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  
!!$  print '("CarpetProlongateTest_Init it=",i0," t=",g0.6, " rl=",i0)', &
!!$       cctk_iteration, cctk_time, nint(log(dble(cctk_levfac(1)))/log(2.0d0))
  
  ! Add +1 to coordinates so that the domain is not symmetric about
  ! the origin (which may accidentally cancel out some errors)
  u = density_time_scale(cctk_time) * density_sum(x+1,y+1,z+1)
  
  uscaled = u * product(cctk_delta_space(:))
end subroutine CarpetProlongateTest_Init



subroutine CarpetProlongateTest_Diff (CCTK_ARGUMENTS)
  use CarpetProlongateTest
  implicit none
  DECLARE_CCTK_ARGUMENTS
  
  u0 = density_time_scale(cctk_time) * density_sum(x+1,y+1,z+1)
  du = u - u0
end subroutine CarpetProlongateTest_Diff



subroutine CarpetProlongateTest_InterpInit (CCTK_ARGUMENTS)
  implicit none
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  
  CCTK_REAL :: dx, dy, dz
  integer   :: lbnd(3), lsh(3), gsh(3)
  integer   :: i,j,k
  integer   :: ierr
  
!!$  print '("CarpetProlongateTest_InterpInit it=",i0," t=",g0.6, " rl=",i0)', &
!!$       cctk_iteration, cctk_time, nint(log(dble(cctk_levfac(1)))/log(2.0d0))
  
  call CCTK_GrouplbndGN (ierr, cctkGH, 3, lbnd, "CarpetProlongateTest::interp_difference")
  if (ierr/=0) call CCTK_WARN (0, "internal error")
  call CCTK_GrouplshGN  (ierr, cctkGH, 3, lsh , "CarpetProlongateTest::interp_difference")
  if (ierr/=0) call CCTK_WARN (0, "internal error")
  call CCTK_GroupgshGN  (ierr, cctkGH, 3, gsh , "CarpetProlongateTest::interp_difference")
  if (ierr/=0) call CCTK_WARN (0, "internal error")
  
  dx = (interp_xmax - interp_xmin) / (gsh(1)-1)
  dy = (interp_ymax - interp_ymin) / (gsh(2)-1)
  dz = (interp_zmax - interp_zmin) / (gsh(3)-1)
  
  do k=1,lsh(3)
     do j=1,lsh(2)
        do i=1,lsh(1)
           interp_x(i,j,k) = interp_xmin + (lbnd(1)+i-1) * dx
           interp_y(i,j,k) = interp_ymin + (lbnd(2)+j-1) * dy
           interp_z(i,j,k) = interp_zmin + (lbnd(3)+k-1) * dz
        end do
     end do
  end do
end subroutine CarpetProlongateTest_InterpInit

subroutine CarpetProlongateTest_Interp (CCTK_ARGUMENTS)
  use cctk
  implicit none
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  DECLARE_CCTK_PARAMETERS
  
  integer :: lsh(3)
  
  integer   :: len_interpolator
  integer   :: len_interpolator_options
  character :: fort_interpolator*100
  character :: fort_interpolator_options*1000
  integer   :: coord_handle
  integer   :: interp_handle
  integer   :: options_table
  
  integer      :: coord_type
  CCTK_POINTER :: coords(3)
  integer      :: ninputs
  CCTK_INT     :: inputs(1)
  integer      :: input ! CCTK_VarIndex needs an integer target

  integer      :: noutputs
  CCTK_INT     :: output_types(1)
  CCTK_POINTER :: outputs(1)
  integer      :: npoints
  
  integer :: ierr
  
!!$  print '("CarpetProlongateTest_Interp it=",i0," t=",g0.6, " rl=",i0)', &
!!$       cctk_iteration, cctk_time, nint(log(dble(cctk_levfac(1)))/log(2.0d0))
  
  call CCTK_GrouplshGN (ierr, cctkGH, 3, lsh, "CarpetProlongateTest::interp_difference")
  if (ierr/=0) call CCTK_WARN (0, "internal error")
  
  ! Get coordinate system
  call CCTK_CoordSystemHandle (coord_handle, "cart3d")
  if (coord_handle<0) then
     call CCTK_WARN (0, "Could not obtain coordinate system handle")
  end if
  
  ! Get interpolator
  call CCTK_FortranString &
       (len_interpolator, interpolator, fort_interpolator)
  call CCTK_InterpHandle (interp_handle, fort_interpolator)
  if (interp_handle<0) then
     call CCTK_WARN (0, "Could not obtain interpolator handle")
  end if
  
  ! Get interpolator options
  call CCTK_FortranString &
       (len_interpolator_options, interpolator_options, fort_interpolator_options)
  call Util_TableCreateFromString (options_table, fort_interpolator_options)
  if (options_table<0) then
     call CCTK_WARN (0, "Could not create interpolator option table")
  end if
  
  npoints = product(lsh)
  
  coord_type = CCTK_VARIABLE_REAL
  coords = (/ CCTK_PointerTo(interp_x), CCTK_PointerTo(interp_y), CCTK_PointerTo(interp_z) /)
  
  ninputs = 1
  call CCTK_VarIndex(input, "CarpetProlongateTest::u")
  inputs(1) = input
  if (any(inputs<0)) then
     call CCTK_WARN (0, "Could not obtain interpolation variable index")
  end if
  
  noutputs     = 1
  output_types = (/ CCTK_VARIABLE_REAL /)
  outputs      = (/ CCTK_PointerTo(interp_u) /)
  
  call CCTK_InterpGridArrays &
       (ierr, cctkGH, 3, &
       interp_handle, options_table, coord_handle, &
       npoints, coord_type, coords, &
       ninputs, inputs, &
       noutputs, output_types, outputs)
  
  if (ierr/=0) then
     call CCTK_WARN (0, "Interpolator error")
  end if
end subroutine CarpetProlongateTest_Interp

subroutine CarpetProlongateTest_InterpDiff (CCTK_ARGUMENTS)
  use CarpetProlongateTest
  implicit none
  DECLARE_CCTK_ARGUMENTS
  
!!$  print '("CarpetProlongateTest_InterpDiff it=",i0," t=",g0.6, " rl=",i0)', &
!!$       cctk_iteration, cctk_time, nint(log(dble(cctk_levfac(1)))/log(2.0d0))
  
  interp_u0 = &
       density_time_scale(cctk_time) * &
       density_sum(interp_x+1,interp_y+1,interp_z+1)
  interp_du = interp_u - interp_u0
end subroutine CarpetProlongateTest_InterpDiff



subroutine CarpetProlongateTest_NormInit (CCTK_ARGUMENTS)
  implicit none
  DECLARE_CCTK_ARGUMENTS
  
  errornorm = 0
  interp_errornorm = 0
end subroutine CarpetProlongateTest_NormInit

subroutine CarpetProlongateTest_NormCalc (CCTK_ARGUMENTS)
  implicit none
  DECLARE_CCTK_ARGUMENTS
  
  errornorm = max (errornorm, maxval(abs(du)))
  interp_errornorm = max (interp_errornorm, maxval(abs(interp_du)))
end subroutine CarpetProlongateTest_NormCalc

subroutine CarpetProlongateTest_NormReduce (CCTK_ARGUMENTS)
  implicit none
  DECLARE_CCTK_ARGUMENTS
  
  integer   :: max_handle
  integer   :: ierr
  CCTK_REAL :: tmp
  
  call CCTK_ReductionArrayHandle (max_handle, "maximum")
  if (max_handle < 0) then
     call CCTK_WARN (CCTK_WARN_ABORT, "Could not obtain norm handle")
  end if
  
  call CCTK_ReduceLocScalar &
       (ierr, cctkGH, -1, max_handle, errornorm, tmp, CCTK_VARIABLE_REAL)
  if (ierr/=0) then
     call CCTK_WARN (CCTK_WARN_ABORT, "Could not evaluate norm")
  end if
  errornorm = tmp
  
  call CCTK_ReduceLocScalar &
       (ierr, cctkGH, -1, max_handle, interp_errornorm, tmp, CCTK_VARIABLE_REAL)
  if (ierr/=0) then
     call CCTK_WARN (CCTK_WARN_ABORT, "Could not evaluate norm")
  end if
  interp_errornorm = tmp
end subroutine CarpetProlongateTest_NormReduce