Adding Mary Beth's blockLU clean-ups to the copy in the
release examples directory.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@12873 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

/* This file contains a block-LU solver function named blockLU() along
 * with its supporting functions and iterators.  It also contains a
 * main function that tests the blockLU function.
 *
 * The test matrix is read in from blockLU-Mat.dat by default, but a
 * different input file can be specified on the command line using
 * --inputfile=<filename>.  The default block size is 2, but this can
 * be overridden on the command line using --block=<blocksize>.
 *
 * This blockLU function is written for a single locale.  It uses an
 * iterator to define blocks of indices that make expressing the block
 * algorithm easier and less error-prone.  Array aliases are defined
 * with these block indices at each iteration, so that the submatrices
 * involved in the block factorization and in the subsequent updates
 * are easily referenced and modified.
 */

// configuration variables:
//   inputfile: a string representing the file containing matrix data
//   block:     the block size to use for the block-LU factorization

config const inputfile = "blockLU-Mat.dat";
config var block = 2;

// blockLU: Computes block-LU with pivoting.  The arguments are as follows:
//   A: the input array to be factored.  It must be 2D, square, and
//        its dimensions must be defined using identical ranges
//
//   blk: the blocking factor, which must be positive and less than or
//        equal to A's size.
//
//   piv: a vector used to store and output the permutations performed
//        by pivoting operations

def blockLU(A: [?D], blk, piv: [D.dim(1)]) where (D.rank == 2) {

  // Test that the domain of A is square with the same index set for
  // each dimension.
  if (D.dim(1) != D.dim(2)) then
    halt("blockLU requires square matrix with same dimensions");

  // Test that 0 < blk <= n, where n = length of one dimension of A.
  if (blk <= 0) || (blk > D.dim(1).length) then
    halt(blk," is an invalid block size passed to blockLU");

  [i in D.dim(1)] piv(i) = i;    // initialize the pivot vector

  // Main loop of block LU uses an iterator to compute three sets of
  // index ranges -- those that are unfactored, divided into those
  // currently being factored and those that remain.

  for (UnfactoredInds, CurrentBlockInds, TrailingBlockInds)
        in generateBlockLURanges(D, blk) {

    // Create array aliases for various submatrices of current block
    // iteration as follows:
    //
    //     |Factored    |   |Factored   |   |Factored   |
    //     |  _ _ _ _ _ |   |    _ _ _ _|   |    _ _ _ _|
    // A = | |Unfactored| = |   |A1 | A2| = |   |A11 A12|
    //     | |          |   |   |   |   |   |   |A21 A22|
    //
    // where A1 = |A11|
    //            |A21| is the current rectangular block that
    //                  is factored in this iteration
    //
    //       A2 = |A12|
    //            |A22| is updated after the LU factorization
    //                  of A1

    var A1  => A[UnfactoredInds, CurrentBlockInds],
        A2  => A[UnfactoredInds, TrailingBlockInds],
        A11 => A[CurrentBlockInds, CurrentBlockInds],
        A21 => A[TrailingBlockInds, CurrentBlockInds],
        A12 => A[CurrentBlockInds, TrailingBlockInds],
        A22 => A[TrailingBlockInds, TrailingBlockInds];

    // First compute the LU factorization of A1...
    //
    // We loop over the rows of A11, but we eliminate the
    // the full rectangular A1 block.

    for k in CurrentBlockInds {

      // Find pivot for kth column:
      //   identify largest magnitude element in kth column
      //   (pivot), from the diagonal element downward
      //   through all rows of A1
      const pivotRow = computePivotRow(A1[UnfactoredInds(k..), k..k]),
            pivot = A1[pivotRow, k];

      // If kth row is not row of pivot, swap rows:
      if (pivotRow != k) {

        // store row permutation in piv array
        piv(k) <=> piv(pivotRow);

        // swap values in rows k and pivotRow of the full
        // matrix A
        A[k, ..] <=> A[pivotRow, ..];
      }

      // If pivot is zero, halt.  Matrix is singular and
      // cannot be factored.
      if (pivot == 0) then halt("zero pivot encountered");

      // Compute the k-th elimination step:
      //   store multipliers...
      A1[UnfactoredInds(k+1..), k] /= pivot;

      //   ..and subtract scaled kth row from remaining
      //   unfactored rows of A1

      forall (i,j) in [UnfactoredInds(k+1..), CurrentBlockInds(k+1..)] do
        A1(i,j) -= A1(i,k) * A1(k,j);
    }

    // ... and now update A2.
    // First update A12.

    forall j in TrailingBlockInds do
      for k in CurrentBlockInds do
        forall i in CurrentBlockInds(k+1..) do
          A12(i,j) -= A1(i,k) * A12(k,j);

    // And then update A22 -= A21*A12.
    //
    // MMIterator is used to generate the indices for this
    // matrix-matrix multiplication step.  MMIterator can
    // be optimized (e.g., for the loop nesting order and loop
    // unrolling) separately from this blockLU routine.

    for (i,j,k1,k2) in MMIterator(A21.domain, A12.domain) do
      A22(i,j) -= A21(i,k1) * A12(k2,j);
  }
}

// The generateBlockLURanges iterator returns a 3-tuple of
// the ranges to be used in each iteration of block LU:
//   (UnfactoredInds, CurrentBlockInds, TrailingBlockInds).
// By defining these ranges, the blockLU code is cleaner. It
// eliminates the need to test for the last iteration where a full-sized
// block may not be possible and only the factorization step (and not
// the update step) is required.
//
// The range UnfactoredInds is equivalent to the range
// CurrentBlockInds concatenated with the range TrailingBlockInds.
//
// The range CurrentBlockInds has the length of blksize, except
// for the end case when the last block may not be of full size.
// This iterator takes care of this end case so that testing for
//  it is not necessary in the blockLU code itself.
//
// The range TrailingBlockInds will be an empty range for the
// the last block iteration.  When it is empty, the loops in
// the blockLU code will not execute, so testing for this case is
// not necessary.

def generateBlockLURanges(D:domain(2), blksize) {
  const end = D.dim(1).high;

  for i in D.dim(1) by blksize {
    const hi = min(i + blksize-1, end);
    yield (i..end, i..hi, hi+1..end);
  }
}

// The MMIterator generates indices for a matrix multiplication loop.
// This iterator can be tuned for loop nesting order or loop unrolling,
// isolating these optimizations from the blockLU code (or any other
// code in a complete linear algebra library that uses matrix-matrix
// multiplication).

def MMIterator(D1, D2) {
  for j in D2.dim(2) do
    for (k1, k2) in (D1.dim(2), D2.dim(1)) do
      for i in D1.dim(1) do
        yield (i,j,k1,k2);
}

// This function computes the pivot row for an LU pivoting operation
// by using Chapel's maxloc reduction on the absolute values in the
// matrix, dropping the maximum value on the floor using the
// underscore operator, and returning the row of the resulting index.

def computePivotRow(A:[?D]) {
   const (_, ind) = maxloc reduce (abs(A), D);
   return ind(1);
}

// The main function here provides a test harness for calling the
// blockLU routine

def main() {

  // Open the input file, read in the array size, ensure it's square
  var infile = file(inputfile, path='./', mode='r');
  infile.open();
  const m = infile.read(int),
        n = infile.read(int);
  if (m != n) then halt("Input matrix must be square");

  // Ensure the block size is appropriate.
  // It cannot be less than 1.  Reset to 1 if this happens.
  // It cannot exceed the size of n.  Reset to n if this happens.
  block = max(1, block);
  block = min(block, n);

  // declare a range A1D, 2D domain AD, and array (matrix) A
  const A1D = 1..n,
        AD = [A1D, A1D];
  var A: [AD] real;

  // Initialize A by reading values in from infile.
  for ij in AD do
    infile.read(A(ij));

  // close the input file
  infile.close();

  // declare the pivot permutation vector
  var piv: [A1D] int;

  // print out the initial matrix
  writeln("Unfactored Matrix:\n", A, "\n");

  // perform the blocking
  blockLU(A, block, piv);

  // print out the results
  writeln("Factored Matrix:\n", A, "\n");
  writeln("Pivot Vector:\n", piv);
}

/* This file contains a block-LU solver function named blockLU() along
 * with its supporting functions and iterators.  It also contains a
 * main function that tests the blockLU function.
 *
 * The test matrix is read in from blockLU-Mat.dat by default, but a
 * different input file can be specified on the command line using
 * --inputfile=<filename>.  The default block size is 2, but this can
 * be overridden on the command line using --block=<blocksize>.
 *
 * This blockLU function is written for a single locale.  It uses an
 * iterator to define blocks of indices that make expressing the block
 * algorithm easier and less error-prone.  Array aliases are defined
 * with these block indices at each iteration, so that the submatrices
 * involved in the block factorization and in the subsequent updates
 * are easily referenced and modified.
 */

// configuration variables:
//   inputfile: a string representing the file containing matrix data
//   block:     the block size to use for the block-LU factorization

config const inputfile = "blockLU-Mat.dat";
config var block = 2;

// blockLU: Computes block-LU with pivoting.  The arguments are as follows:
//   A: the input array to be factored.  It must be 2D, square, and
//        its dimensions must be defined using identical ranges
//
//   blk: the blocking factor, which must be positive and less than or
//        equal to A's size.
//
//   piv: a vector used to store and output the permutations performed
//        by pivoting operations

def blockLU(A: [?D], blk, piv: [D.dim(1)]) where (D.rank == 2) {

  // Test that the domain of A is square with the same index set for
  // each dimension.
  if (D.dim(1) != D.dim(2)) then
    halt("blockLU requires square matrix with same dimensions");

  // Test that 0 < blk <= n, where n = length of one dimension of A.
  if (blk <= 0) || (blk > D.dim(1).length) then
    halt(blk," is an invalid block size passed to blockLU");

  [i in D.dim(1)] piv(i) = i;    // initialize the pivot vector

  // Main loop of block LU uses an iterator to compute three sets of
  // index ranges -- those that are unfactored, divided into those
  // currently being factored and those that remain.

  for (UnfactoredInds, CurrentBlockInds, TrailingBlockInds)
        in generateBlockLURanges(D.dim(1), blk) {

    // Create array aliases for various submatrices of current block
    // iteration as follows:
    //
    //     |Factored    |   |Factored   |   |Factored   |
    //     |  _ _ _ _ _ |   |    _ _ _ _|   |    _ _ _ _|
    // A = | |Unfactored| = |   |A1 | A2| = |   |A11 A12|
    //     | |          |   |   |   |   |   |   |A21 A22|
    //
    // where A1 = |A11|
    //            |A21| is the current rectangular block that
    //                  is factored in this iteration
    //
    //       A2 = |A12|
    //            |A22| is updated after the LU factorization
    //                  of A1

    var A1  => A[UnfactoredInds, CurrentBlockInds],
        A2  => A[UnfactoredInds, TrailingBlockInds],
        A11 => A[CurrentBlockInds, CurrentBlockInds],
        A21 => A[TrailingBlockInds, CurrentBlockInds],
        A12 => A[CurrentBlockInds, TrailingBlockInds],
        A22 => A[TrailingBlockInds, TrailingBlockInds];

    // First compute the LU factorization of A1...
    //
    // We loop over the rows of A11, but we eliminate the
    // the full rectangular A1 block.

    for k in CurrentBlockInds {

      // Find pivot for kth column:
      //   identify largest magnitude element in kth column
      //   (pivot), from the diagonal element downward
      //   through all rows of A1
      const pivotRow = computePivotRow(A1[k.., k..k]),
            pivot = A1[pivotRow, k];

      // If kth row is not row of pivot, swap rows:
      if (pivotRow != k) {

        // store row permutation in piv array
        piv(k) <=> piv(pivotRow);

        // swap values in rows k and pivotRow of the full
        // matrix A
        A[k..k, ..] <=> A[pivotRow..pivotRow, ..];
      }

      // If pivot is zero, halt.  Matrix is singular and
      // cannot be factored.
      if (pivot == 0) then halt("zero pivot encountered");

      // Compute the k-th elimination step:
      //   store multipliers...
      if k+1 <= A1.domain.high(1) then
        A1[k+1.., k..k] /= pivot;

      //   ..and subtract scaled kth row from remaining
      //   unfactored rows of A1

      forall (i,j) in [UnfactoredInds(k+1..), CurrentBlockInds(k+1..)] do
        A1(i,j) -= A1(i,k) * A1(k,j);
    }

    // ... and now update A2.
    // First update A12.

    forall j in TrailingBlockInds do
      for k in CurrentBlockInds do
        forall i in CurrentBlockInds(k+1..) do
          A12(i,j) -= A1(i,k) * A12(k,j);

    // And then update A22 -= A21*A12.
    //
    // MMIterator is used to generate the indices for this
    // matrix-matrix multiplication step.  MMIterator can
    // be optimized (e.g., for the loop nesting order and loop
    // unrolling) separately from this blockLU routine.

    for (i,j,k1,k2) in MMIterator(A21.domain, A12.domain) do
      A22(i,j) -= A21(i,k1) * A12(k2,j);
  }
}

// The generateBlockLURanges iterator returns a 3-tuple of
// the ranges to be used in each iteration of block LU:
//   (UnfactoredInds, CurrentBlockInds, TrailingBlockInds).
// By defining these ranges, the blockLU code is cleaner. It
// eliminates the need to test for the last iteration where a full-sized
// block may not be possible and only the factorization step (and not
// the update step) is required.
//
// The range UnfactoredInds is equivalent to the range
// CurrentBlockInds concatenated with the range TrailingBlockInds.
//
// The range CurrentBlockInds has the length of blksize, except
// for the end case when the last block may not be of full size.
// This iterator takes care of this end case so that testing for
//  it is not necessary in the blockLU code itself.
//
// The range TrailingBlockInds will be an empty range for the
// the last block iteration.  When it is empty, the loops in
// the blockLU code will not execute, so testing for this case is
// not necessary.

def generateBlockLURanges(D:range, blksize) {
  const end = D.high;

  for i in D by blksize {
    const hi = min(i + blksize-1, end);
    yield (i..end, i..hi, hi+1..end);
  }
}

// The MMIterator generates indices for a matrix multiplication loop.
// This iterator can be tuned for loop nesting order or loop unrolling,
// isolating these optimizations from the blockLU code (or any other
// code in a complete linear algebra library that uses matrix-matrix
// multiplication).

def MMIterator(D1, D2) {
  for j in D2.dim(2) do
    for (k1, k2) in (D1.dim(2), D2.dim(1)) do
      for i in D1.dim(1) do
        yield (i,j,k1,k2);
}

// This function computes the pivot row for an LU pivoting operation
// by using Chapel's maxloc reduction on the absolute values in the
// matrix, dropping the maximum value on the floor using the
// underscore operator, and returning the row of the resulting index.

def computePivotRow(A:[?D]) {
   const (_, ind) = maxloc reduce (abs(A), D);
   return ind(1);
}

// The main function here provides a test harness for calling the
// blockLU routine

def main() {

  // Open the input file, read in the array size, ensure it's square
  var infile = file(inputfile, path='./', mode='r');
  infile.open();
  const m = infile.read(int),
        n = infile.read(int);
  if (m != n) then halt("Input matrix must be square");

  // Ensure the block size is appropriate.
  // It cannot be less than 1.  Reset to 1 if this happens.
  // It cannot exceed the size of n.  Reset to n if this happens.
  block = max(1, block);
  block = min(block, n);

  // declare a range A1D, 2D domain AD, and array (matrix) A
  const A1D = 1..n,
        AD = [A1D, A1D];
  var A: [AD] real;

  // Initialize A by reading values in from infile.
  for ij in AD do
    infile.read(A(ij));

  // close the input file
  infile.close();

  // declare the pivot permutation vector
  var piv: [A1D] int;

  // print out the initial matrix
  writeln("Unfactored Matrix:\n", A, "\n");

  // perform the blocking
  blockLU(A, block, piv);

  // print out the results
  writeln("Factored Matrix:\n", A, "\n");
  writeln("Pivot Vector:\n", piv);
}


Add a comment to the test file.

Add a comment to the test file.

Want it to be clear exactly what is being tested in it.

use FileSystem;

writeln(viewMode("blah")); // Blah should be all permissions, or 511 in decimal


Minor renaming of domain argument names

Minor renaming of domain argument names

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

// Wrapper for FFTW version 3.

/*
  FFT computations via key routines from FFTW (version 3)

  This module defines Chapel wrappers for key 64-bit routines from
  FFTW (http://www.fftw.org), version 3.  Over time, the intention is
  to expand this module to support additional routines, prioritizing
  based on requests and feedback from users.  Also, see the
  :mod:`FFTW_MT` module which provides support for calls to the
  multi-threaded FFTW implementation.

  To use this module:

  1. Ensure that FFTW (version 3) is installed on your system and that
     the header and library files (e.g., fftw3.h, libfftw3.*) are
     either installed in a standard system location or that your C
     compiler's environment variables are set up to find them.

  2. Add ``use FFTW;`` to your Chapel code.

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

  1. Create plan(s) using the :proc:`plan_dft* <plan_dft>` routines.

  2. Execute the plan(s) one or more times using :proc:`execute`.

  3. Destroy the plan(s) using :proc:`destroy_plan`.

  4. Call :proc:`cleanup`.

  Note that each of the Chapel :proc:`plan_dft* <plan_dft>` routines
  support both `in-place` and `out-of-place` versions of the
  transforms, where the former versions use a single array for both
  input and output, and the latter use two distinct arrays.

  In future versions of this module, we anticipate improving the
  plan_dft*() interfaces to make better use of Chapel features and
  move further away from C-isms (like the overloaded role of `flags`
  and the use of C-based types).  Such features are expected to take
  advantage of Chapel's support for default argument values and
  keyword-based argument passing.  We are also thinking about changing
  the interface for the in-place routines to use array slicing rather
  than separate arguments for the array and domain.
*/

// Possible TODOs:
//
// - How do we feel about FFTW_ALLCAPS names given that the routines
//   themselves don't have fftw_ prefixes, that they're defined as
//   c_int's, and that they're all-caps?  What if we were to replace
//   these with bool/enum arguments representing the separate planning
//   aspects that are overloaded into 'flags'?  This would also allow
//   us to move away from c_ints (which could be done in other ways
//   as well, such as safe-casting and providing our own versions of
//   the C variables).
//
// - It seems that rather than passing in a domain and an array for
//   the in-place cases, we could probably pass in an array slice
//   where the array's allocating domain reflected the padding and
//   the slicing domain reflected the area over which the FFT should
//   be performed.  Would this be cleaner?  Would the overhead be
//   significant?
//

module FFTW {

  use SysCTypes;
  use "fftw3.h", "-lfftw3";

  /*
    Disable execution-time array size checks in the FFTW
    :proc:`plan_dft` routine.
   */
  config param noFFTWsizeChecks = false;

  /*
    An opaque type used to store and reuse FFTW plans across multiple
    routines.
  */
  extern type fftw_plan; // opaque type

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref

  // TODO: Can we have the plan_dft() routine below take in native
  // Chapel types without changing the external C constants from
  // type c_int?  Probably given that Chapel's int will be >=
  // C's int for the forseeable future.  See also the TODO above
  // about whether we'd want to represent those constants using
  // more native Chapel types anyway.

  /*
    Creates a plan for an out-of-place complex-to-complex DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose size and shape must match the input array's
    :type output: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [?Din] complex(128), output: [?Dout] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..input.rank do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft()");

      if error then
        halt("Incorrect array sizes in plan_dft()");
    }

    return plan_dft_help(input, output, sign, flags);
  }

  /*
    Creates a plan for an in-place complex-to-complex DFT.

    :arg arr: The array to use as the in-place input/output array.
    :type arr: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(arr: [] complex(128), sign: c_int, flags: c_uint): fftw_plan {
    return plan_dft_help(arr, arr, sign, flags);
  }

  //
  // Though not strictly necessary, this helper routine is to avoid
  // doing the size check for the in-place case.  This is the kind
  // of thing we'd like to mark as "private" once we have that
  // capability.  I could move it into a sub-module for the time
  // being, but want to keep the diff with the previous version of
  // the code minimal.  -BLC
  //
  pragma "no doc"
  proc plan_dft_help(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    param rank = input.rank;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size.safeCast(c_int);

    return C_FFTW.fftw_plan_dft(rank.safeCast(c_int), dims, input,
                                     output, sign, flags);
  }

  // Real-to-complex and complex-to-real planning routines There are
  // two cases that we treat independently here : in-place and
  // out-of-place transforms

  /*
    Create a plan for a real-to-complex, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `real(64)`

    :arg output: The output array, whose size and shape must match the input array's, except for the leading dimension which should be n/2 + 1, where n is the size of the input array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type output: [] `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_r2c(input : [?Din] real(64), output : [?Dout] complex(128),
                    flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_r2c()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Din, Dout, "plan_dft_r2c()", "output ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_r2c()");
    }

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, input, output, flags);
  }

  // In-place routines, note that these take in the true leading dimension
  /*
    Create a plan for a real-to-complex, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(640` or `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_r2c(realDom : domain, arr : [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_r2c()", t == real) then
        halt("Incorrect array sizes in plan_dft_r2c()");

    param rank = realDom.rank: c_int;
    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, arr, arr, flags);
  }

  //
  // Error overload
  //
  pragma "no doc"
  proc plan_dft_r2c(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_r2c() is only supported for arrays of type real(64) and complex(128)");
  }

  /*
    Create a plan for a complex-to-real, out-of-place DFT.

    :arg input: The input array, whose size and shape must match the output array's, except for the leading dimension which should be n/2 + 1, where n is the size of the output array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type input: [] `complex(128)`

    :arg output: The output array
    :type output: [] `real(64)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_c2r(input : [?Din] complex(128), output : [?Dout] real(64),
                    flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_c2r()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Dout, Din, "plan_dft_c2r()", "input ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_c2r()");
    }

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = output.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, input, output, flags);
  }

  /*
    Create a plan for a complex-to-real, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(64)` or `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_c2r(realDom : domain, arr: [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_c2r()", t == real) then
        halt("Incorrect array sizes in plan_dft_c2r()");

    param rank = realDom.rank: c_int;
    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, arr, arr, flags);
  }

  pragma "no doc"
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_c2r() is only supported for arrays of type real(64) and complex(128)");
  }

  // Using plans

  /*
    Execute an FFTW plan.

    :arg plan: The plan to execute, as computed by a `plan_dft*()` routine.
    :type plan: fftw_plan
  */
  proc execute(const plan: fftw_plan) {
   C_FFTW.fftw_execute(plan);
  }

  /*
    Destroy an FFTW plan.

    :arg plan: The plan to destroy
    :type plan: fftw_plan
  */
  proc destroy_plan(plan: fftw_plan) {
    C_FFTW.fftw_destroy_plan(plan);
  }

  /*
    Clean up FFTW overall.
  */
  proc cleanup() {
    C_FFTW.fftw_cleanup();
  }

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"

  //
  // TODO: Is it weird that we use FFTW_ names here, but not in
  // the routines?  Should we wrap the external flags so that
  // they can be ints or enums and avoid the all-caps C scheme
  // or is the familiarity better?
  //

  // Direction flags

  /* Request a forward transform (i.e., use a negative exponent in the tranform). */
  extern const FFTW_FORWARD : c_int;
  /* Request a backward transform (i.e., use a positive exponent in the transofmr). */
  extern const FFTW_BACKWARD : c_int;

  // Planning-rigor flags

  /* Specify that a simple heuristic should be used to pick a plan
     quickly.  This will prevent the input/output arrays from being
     overwritten during planning. */
  extern const FFTW_ESTIMATE : c_uint;

  /* Specify that FFTW should try and find an optimized plan by
     computing several FFTs and measuring their execution time.
     This can consume some time.
  */
  // TODO: If/when we support defaults, might say something like: This
  // is the default planning option.
  extern const FFTW_MEASURE : c_uint;

  /* Specify that FFTW should expend a greater effort finding an
     optimized plan. */
  extern const FFTW_PATIENT : c_uint;

  /* Specify that FFTW should expend an even greater effort finding an
     optimized plan. */
  extern const FFTW_EXHAUSTIVE : c_uint;

  /* This is a special planning mode that is useful for querying
     whether wisdom is available.  When using it, the plan is only
     created when wisdom is available for the given problem; otherwise
     a `null plan` is returned.  This can be combined with other flags
     to create a plan if the wisdom available was created in that mode
     (e.g., ``FFTW_WISDOM_ONLY | FFW_PATIENT``).  For more details on
     this flag and the previous four, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual
  */
  extern const FFTW_WISDOM_ONLY : c_uint;

  // Algorithm-restriction flags

  /* Specify that an out-of-place transform is permitted to overwrite
     its input array with arbitrary data.  This permits more efficient
     algorithms to be used in some cases. */
  // TODO: When we're ready to mention defaults, add: "This is the default for
  // :proc:`plan_dft_c2r`. // NOTE: ...and hc2r once supported...
  extern const FFTW_DESTROY_INPUT : c_uint;

  /* Specify that an out-of-place transform cannot change its input
     array. */
  // TODO: When we're ready to mention defaults, add: This is the
  // default for :proc:`plan_dft` and :proc:`plan_dft_r2c`. */
  extern const FFTW_PRESERVE_INPUT : c_uint;

  /* Specify that the algorithm may not impose any unusual alignment
     requirements on the input/output arrays.  This flag should not be
     necessary for current Chapel use since the planner will
     automatically detect such cases.  For more details on this flag
     and the previous two, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual.
  */  // NOTE: But it will be if/when the new-array execute interface is supported
  extern const FFTW_UNALIGNED : c_uint;

  //
  // This is a helper module to give us a "private" notion.  Once we
  // have a private keyword, these could be hoisted to module scope
  // and labeled private.
  //
  pragma "no doc"
  module Private_FFTW {
    //
    // Check for a mismatch in size between two domain dimensions,
    // print an error if they don't, and return whether or not a
    // mismatch occurred.  Note that the 'inplace' argument is used to
    // customize the error message for in-place and out-of-place
    // cases.
    //
    proc checkDimMismatch(inDom, outDom, dim, fnname, inplace=false) {
      const inputDim = inDom.dim(dim).size;
      const outputDim = outDom.dim(dim).size;
      if (inputDim == outputDim) then
        return false;

      const first = if inplace then "domain" else "input";
      const second = if inplace then "array" else "output";

      writeln("Error: In ", fnname, ", the ", first, " and ", second,
              if !inplace then " arrays" else "",
              " don't have same size in dimension ", dim,
              " (", first, " = ", inputDim, ", ", second, " = ", outputDim,
              ")");
      return true;
    }

    //
    // Check for mismatches in the dimensions for an in-place
    // transform between the logical domain for a DFT and the
    // physical domain over which the array is allocated.
    //
    proc checkInPlaceDimMismatch(logDom, physDom, fnname, realElems) {
      var error = false;

      for i in 1..logDom.rank-1 do
        error |= checkDimMismatch(logDom, physDom, i, fnname, inplace=true);

      if realElems {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(logDom, physDom, fnname);
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(logDom, physDom, fnname);
      }
      return error;
    }

    //
    // Check for a mismatch in the proper size relationship between
    // two domain dimensions where the first describes a real array
    // and the second a complex array.  The 'cplxarrdesc' is used
    // to customize the error message for the role of the complex
    // domain.
    //
    proc checkRealCplxDimMismatch(realDom, complexDom, fnname, cplxarrdesc="") {
      const dim = realDom.rank;
      const realDim = realDom.dim(dim).size/2+1;
      const complexDim = complexDom.dim(dim).size;

      if (realDim == complexDim) then
        return false;

      writeln("Error: In ", fnname, ", the ", cplxarrdesc,
              "array's leading dimension is not the proper size (expected ", realDim,
              ", got ", complexDim, ")");
      return true;
    }

    //
    // Check for a mismatch in the proper size relationship between two
    // domain dimensions for an in-place transform on reals, where the
    // first describes the logical computation coordinates and the
    // second describes the domain describing the padded array allocation.
    //
    proc checkRealInPlaceDimMismatch(logDom, physDom, fnname) {
      const dim = logDom.rank;
      const arrDim = physDom.dim(dim).size;
      const domDim = 2*(logDom.dim(dim).size/2+1);
      if (arrDim == domDim) then
        return false;

      writeln("Error: In ", fnname,
              ", the array's leading dimension is not the proper size (expected ", domDim,
              ", got ", arrDim, ")");
      return true;
    }
  }

  pragma "no doc"
  module C_FFTW {
    extern proc fftw_plan_dft(rank: c_int,
                              n,  // BLC: having trouble being specific
                                  // This is a const int* in C
                              in1: [] complex(128),
                              out1: [] complex(128),
                              sign : c_int, c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_r2c(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

// Wrapper for FFTW version 3.

/*
  FFT computations via key routines from FFTW (version 3)

  This module defines Chapel wrappers for key 64-bit routines from
  FFTW (http://www.fftw.org), version 3.  Over time, the intention is
  to expand this module to support additional routines, prioritizing
  based on requests and feedback from users.  Also, see the
  :mod:`FFTW_MT` module which provides support for calls to the
  multi-threaded FFTW implementation.

  To use this module:

  1. Ensure that FFTW (version 3) is installed on your system and that
     the header and library files (e.g., fftw3.h, libfftw3.*) are
     either installed in a standard system location or that your C
     compiler's environment variables are set up to find them.

  2. Add ``use FFTW;`` to your Chapel code.

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

  1. Create plan(s) using the :proc:`plan_dft* <plan_dft>` routines.

  2. Execute the plan(s) one or more times using :proc:`execute`.

  3. Destroy the plan(s) using :proc:`destroy_plan`.

  4. Call :proc:`cleanup`.

  Note that each of the Chapel :proc:`plan_dft* <plan_dft>` routines
  support both `in-place` and `out-of-place` versions of the
  transforms, where the former versions use a single array for both
  input and output, and the latter use two distinct arrays.

  In future versions of this module, we anticipate improving the
  plan_dft*() interfaces to make better use of Chapel features and
  move further away from C-isms (like the overloaded role of `flags`
  and the use of C-based types).  Such features are expected to take
  advantage of Chapel's support for default argument values and
  keyword-based argument passing.  We are also thinking about changing
  the interface for the in-place routines to use array slicing rather
  than separate arguments for the array and domain.
*/

// Possible TODOs:
//
// - How do we feel about FFTW_ALLCAPS names given that the routines
//   themselves don't have fftw_ prefixes, that they're defined as
//   c_int's, and that they're all-caps?  What if we were to replace
//   these with bool/enum arguments representing the separate planning
//   aspects that are overloaded into 'flags'?  This would also allow
//   us to move away from c_ints (which could be done in other ways
//   as well, such as safe-casting and providing our own versions of
//   the C variables).
//
// - It seems that rather than passing in a domain and an array for
//   the in-place cases, we could probably pass in an array slice
//   where the array's allocating domain reflected the padding and
//   the slicing domain reflected the area over which the FFT should
//   be performed.  Would this be cleaner?  Would the overhead be
//   significant?
//

module FFTW {

  use SysCTypes;
  use "fftw3.h", "-lfftw3";

  /*
    Disable execution-time array size checks in the FFTW
    :proc:`plan_dft` routine.
   */
  config param noFFTWsizeChecks = false;

  /*
    An opaque type used to store and reuse FFTW plans across multiple
    routines.
  */
  extern type fftw_plan; // opaque type

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref

  // TODO: Can we have the plan_dft() routine below take in native
  // Chapel types without changing the external C constants from
  // type c_int?  Probably given that Chapel's int will be >=
  // C's int for the forseeable future.  See also the TODO above
  // about whether we'd want to represent those constants using
  // more native Chapel types anyway.

  /*
    Creates a plan for an out-of-place complex-to-complex DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose size and shape must match the input array's
    :type output: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [?Din] complex(128), output: [?Dout] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..input.rank do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft()");

      if error then
        halt("Incorrect array sizes in plan_dft()");
    }

    return plan_dft_help(input, output, sign, flags);
  }

  /*
    Creates a plan for an in-place complex-to-complex DFT.

    :arg arr: The array to use as the in-place input/output array.
    :type arr: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(arr: [] complex(128), sign: c_int, flags: c_uint): fftw_plan {
    return plan_dft_help(arr, arr, sign, flags);
  }

  //
  // Though not strictly necessary, this helper routine is to avoid
  // doing the size check for the in-place case.  This is the kind
  // of thing we'd like to mark as "private" once we have that
  // capability.  I could move it into a sub-module for the time
  // being, but want to keep the diff with the previous version of
  // the code minimal.  -BLC
  //
  pragma "no doc"
  proc plan_dft_help(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    param rank = input.rank;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size.safeCast(c_int);

    return C_FFTW.fftw_plan_dft(rank.safeCast(c_int), dims, input,
                                     output, sign, flags);
  }

  // Real-to-complex and complex-to-real planning routines There are
  // two cases that we treat independently here : in-place and
  // out-of-place transforms

  /*
    Create a plan for a real-to-complex, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `real(64)`

    :arg output: The output array, whose size and shape must match the input array's, except for the leading dimension which should be n/2 + 1, where n is the size of the input array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type output: [] `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_r2c(input : [?Din] real(64), output : [?Dout] complex(128),
                    flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_r2c()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Din, Dout, "plan_dft_r2c()", "output ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_r2c()");
    }

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, input, output, flags);
  }

  // In-place routines, note that these take in the true leading dimension
  /*
    Create a plan for a real-to-complex, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(640` or `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_r2c(realDom : domain, arr : [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_r2c()", t == real) then
        halt("Incorrect array sizes in plan_dft_r2c()");

    param rank = realDom.rank: c_int;
    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, arr, arr, flags);
  }

  //
  // Error overload
  //
  pragma "no doc"
  proc plan_dft_r2c(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_r2c() is only supported for arrays of type real(64) and complex(128)");
  }

  /*
    Create a plan for a complex-to-real, out-of-place DFT.

    :arg input: The input array, whose size and shape must match the output array's, except for the leading dimension which should be n/2 + 1, where n is the size of the output array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type input: [] `complex(128)`

    :arg output: The output array
    :type output: [] `real(64)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_c2r(input : [?Din] complex(128), output : [?Dout] real(64),
                    flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_c2r()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Dout, Din, "plan_dft_c2r()", "input ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_c2r()");
    }

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = output.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, input, output, flags);
  }

  /*
    Create a plan for a complex-to-real, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(64)` or `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_c2r(realDom : domain, arr: [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_c2r()", t == real) then
        halt("Incorrect array sizes in plan_dft_c2r()");

    param rank = realDom.rank: c_int;
    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, arr, arr, flags);
  }

  pragma "no doc"
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_c2r() is only supported for arrays of type real(64) and complex(128)");
  }

  // Using plans

  /*
    Execute an FFTW plan.

    :arg plan: The plan to execute, as computed by a `plan_dft*()` routine.
    :type plan: fftw_plan
  */
  proc execute(const plan: fftw_plan) {
   C_FFTW.fftw_execute(plan);
  }

  /*
    Destroy an FFTW plan.

    :arg plan: The plan to destroy
    :type plan: fftw_plan
  */
  proc destroy_plan(plan: fftw_plan) {
    C_FFTW.fftw_destroy_plan(plan);
  }

  /*
    Clean up FFTW overall.
  */
  proc cleanup() {
    C_FFTW.fftw_cleanup();
  }

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"

  //
  // TODO: Is it weird that we use FFTW_ names here, but not in
  // the routines?  Should we wrap the external flags so that
  // they can be ints or enums and avoid the all-caps C scheme
  // or is the familiarity better?
  //

  // Direction flags

  /* Request a forward transform (i.e., use a negative exponent in the tranform). */
  extern const FFTW_FORWARD : c_int;
  /* Request a backward transform (i.e., use a positive exponent in the transofmr). */
  extern const FFTW_BACKWARD : c_int;

  // Planning-rigor flags

  /* Specify that a simple heuristic should be used to pick a plan
     quickly.  This will prevent the input/output arrays from being
     overwritten during planning. */
  extern const FFTW_ESTIMATE : c_uint;

  /* Specify that FFTW should try and find an optimized plan by
     computing several FFTs and measuring their execution time.
     This can consume some time.
  */
  // TODO: If/when we support defaults, might say something like: This
  // is the default planning option.
  extern const FFTW_MEASURE : c_uint;

  /* Specify that FFTW should expend a greater effort finding an
     optimized plan. */
  extern const FFTW_PATIENT : c_uint;

  /* Specify that FFTW should expend an even greater effort finding an
     optimized plan. */
  extern const FFTW_EXHAUSTIVE : c_uint;

  /* This is a special planning mode that is useful for querying
     whether wisdom is available.  When using it, the plan is only
     created when wisdom is available for the given problem; otherwise
     a `null plan` is returned.  This can be combined with other flags
     to create a plan if the wisdom available was created in that mode
     (e.g., ``FFTW_WISDOM_ONLY | FFW_PATIENT``).  For more details on
     this flag and the previous four, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual
  */
  extern const FFTW_WISDOM_ONLY : c_uint;

  // Algorithm-restriction flags

  /* Specify that an out-of-place transform is permitted to overwrite
     its input array with arbitrary data.  This permits more efficient
     algorithms to be used in some cases. */
  // TODO: When we're ready to mention defaults, add: "This is the default for
  // :proc:`plan_dft_c2r`. // NOTE: ...and hc2r once supported...
  extern const FFTW_DESTROY_INPUT : c_uint;

  /* Specify that an out-of-place transform cannot change its input
     array. */
  // TODO: When we're ready to mention defaults, add: This is the
  // default for :proc:`plan_dft` and :proc:`plan_dft_r2c`. */
  extern const FFTW_PRESERVE_INPUT : c_uint;

  /* Specify that the algorithm may not impose any unusual alignment
     requirements on the input/output arrays.  This flag should not be
     necessary for current Chapel use since the planner will
     automatically detect such cases.  For more details on this flag
     and the previous two, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual.
  */  // NOTE: But it will be if/when the new-array execute interface is supported
  extern const FFTW_UNALIGNED : c_uint;

  //
  // This is a helper module to give us a "private" notion.  Once we
  // have a private keyword, these could be hoisted to module scope
  // and labeled private.
  //
  pragma "no doc"
  module Private_FFTW {
    //
    // Check for a mismatch in size between two domain dimensions,
    // print an error if they don't, and return whether or not a
    // mismatch occurred.  Note that the 'inplace' argument is used to
    // customize the error message for in-place and out-of-place
    // cases.
    //
    proc checkDimMismatch(inDom, outDom, dim, fnname, inplace=false) {
      const inputDim = inDom.dim(dim).size;
      const outputDim = outDom.dim(dim).size;
      if (inputDim == outputDim) then
        return false;

      const first = if inplace then "domain" else "input";
      const second = if inplace then "array" else "output";

      writeln("Error: In ", fnname, ", the ", first, " and ", second,
              if !inplace then " arrays" else "",
              " don't have same size in dimension ", dim,
              " (", first, " = ", inputDim, ", ", second, " = ", outputDim,
              ")");
      return true;
    }

    //
    // Check for mismatches in the dimensions for an in-place
    // transform between the logical domain for a DFT and the
    // physical domain over which the array is allocated.
    //
    proc checkInPlaceDimMismatch(logDom, physDom, fnname, realElems) {
      var error = false;

      for i in 1..logDom.rank-1 do
        error |= checkDimMismatch(logDom, physDom, i, fnname, inplace=true);

      if realElems {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(logDom, physDom, fnname);
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(logDom, physDom, fnname);
      }
      return error;
    }

    //
    // Check for a mismatch in the proper size relationship between
    // two domain dimensions where the first describes a real array
    // and the second a complex array.  The 'cplxarrdesc' is used
    // to customize the error message for the role of the complex
    // domain.
    //
    proc checkRealCplxDimMismatch(Dreal, Dcomplex, fnname, cplxarrdesc="") {
      const dim = Dreal.rank;
      const realDim = Dreal.dim(dim).size/2+1;
      const complexDim = Dcomplex.dim(dim).size;

      if (realDim == complexDim) then
        return false;

      writeln("Error: In ", fnname, ", the ", cplxarrdesc,
              "array's leading dimension is not the proper size (expected ", realDim,
              ", got ", complexDim, ")");
      return true;
    }

    //
    // Check for a mismatch in the proper size relationship between two
    // domain dimensions for an in-place transform on reals, where the
    // first describes the logical computation coordinates and the
    // second describes the domain describing the padded array allocation.
    //
    proc checkRealInPlaceDimMismatch(Dreal, Darr, fnname) {
      const dim = Dreal.rank;
      const arrDim = Darr.dim(dim).size;
      const domDim = 2*(Dreal.dim(dim).size/2+1);
      if (arrDim == domDim) then
        return false;

      writeln("Error: In ", fnname,
              ", the array's leading dimension is not the proper size (expected ", domDim,
              ", got ", arrDim, ")");
      return true;
    }
  }

  pragma "no doc"
  module C_FFTW {
    extern proc fftw_plan_dft(rank: c_int,
                              n,  // BLC: having trouble being specific
                                  // This is a const int* in C
                              in1: [] complex(128),
                              out1: [] complex(128),
                              sign : c_int, c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_r2c(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}


fixing for merge

fixing for merge

/** Git Intro!
 *
 * The Chapel team's intro to git version control. The core team members should
 * update their name tuple in the array below.
 */

// To play Chapel adlibs, fill out your tuple with a programming language, a
// feeling, and a verb.
//
// name
//         programming language
//                 feeling
//                         verb
const TheTeam = [
  ("Ben", "", "", ""),
  ("Brad", "xfig", "liberated", "begat"),
  ("David", "", "", ""),
  ("Greg", "", "", ""),
  ("Kyle", "C", "well", "like"),
  ("Lydia", "", "", ""),
  ("Michael", "", "", ""),
  ("Elliot", "", "", ""),
  ("Simon", "", "", ""),
  ("Sung", "", "", ""),
  ("Thomas", "Python", "ecstatic", "<3"),
  ("Tim", "C", "free", "sorta kinda like"),
  ("TMac", "", "", ""),
  ("Tom", "", "", ""),
  ("Vass", "", "", "")
];

// Prologue
writeln("Chapel Adlibs!");
writeln("--------------");
writeln();

// Print the adlibs!
for (name, lang, feeling, verb) in TheTeam {
  writef("My name is %s. I used to use %s for all my problems.\nNow, I use Chapel and feel %s! I %s Chapel.\n",
         name, lang, feeling, verb);
  writeln();
}

/** Git Intro!
 *
 * The Chapel team's intro to git version control. The core team members should
 * update their name tuple in the array below.
 */

// To play Chapel adlibs, fill out your tuple with a programming language, a
// feeling, and a verb.
//
// name
//         programming language
//                 feeling
//                         verb
const TheTeam = [
  ("Ben", "", "", ""),
  ("Brad", "xfig", "liberated", "begat"),
  ("David", "", "", ""),
  ("Greg", "", "", ""),
  ("Kyle", "C", "well", "like"),
  ("Lydia", "", "", ""),
  ("Michael", "", "", ""),
  ("Elliot", "", "", ""),
  ("Simon", "", "", ""),
  ("Sung", "", "", ""),
  ("Thomas", "Python", "ecstatic", "<3"),
  ("Tim", "", "", ""),
  ("TMac", "", "", ""),
  ("Tom", "", "", ""),
  ("Vass", "", "", "")
];

// Prologue
writeln("Chapel Adlibs!");
writeln("--------------");
writeln();

// Print the adlibs!
for (name, lang, feeling, verb) in TheTeam {
  writef("My name is %s. I used to use %s for all my problems.\nNow, I use Chapel and feel %s! I %s Chapel.\n",
         name, lang, feeling, verb);
  writeln();
}


update __index_vector to __index.

update __index_vector to __index.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@131 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

// Chapel Prelude

in system __name "system"; // system module

// builtin types

type symbol __name "symbol";
type function __name "function";
type module __name "module";
type continuation __name "continuation";
type any __name "any";
type vector __name "vector";
type tuple __name "tuple";
type void __name "void" : tuple;
type object __name "object" = { };
type list __name "list";
type ref __name "ref";

type catagory __name "catagory";
type set __name "set" : catagory;

type integer8 __name "int8";
type integer16 __name "int16";
type integer32 __name "int32";
type integer64 __name "int64";
type integer __name "int" = integer64;
type uinteger8 __name "uint8";
type uinteger16 __name "uint16";
type uinteger32 __name "uint32";
type uinteger64 __name "uint64";
type uinteger __name "uint" = uinteger32;
type anyinteger __name "anyint" =
  integer8 | integer16 | integer32 | integer64 |
  uinteger8 | uinteger16 | uinteger32 | uinteger64;

type float32 __name "float32";
type float64 __name "float64";
type float80 __name "float80";
type float128 __name "float128";
type float __name "float" = float64;
type anyfloat __name "anyfloat" =
  float32 | float64 | float80 | float128;

type anynum __name "anynum" = anyinteger | anyfloat;
type char __name "char" = uinteger8;
type complex __name "complex";
type size __name "size" = uinteger;
type bool __name "bool" = integer;
type string __name "string";
type enum_element __name "enum_element" = integer;

// builtin constants
0;

// builtin value

null __name "null" : ();

// global initialization function

__init__ __name "init" : 0;

//   public internal function
var reply = #reply __name "reply";

// builtin symbols
#__make_tuple __name "make_tuple";
#__make_list __name "make_list";
#__make_vector __name "make_vector";
#__make_set __name "make_set";
#__make_continuation __name "make_continuation";
#__primitive __name "primitive";
#__new __name "new";
#__index __name "index";
#__print __name "print";
#operator __name "operator";
#"&" __name "doref";

// overloadable primitive operators
function new(a:any) { #__new a; }
function operator(a:any, #".", b:symbol)	{ #__primitive a #"." b }
function operator(a:any, #"*.", b:symbol)	{ #__primitive a #"." b }
function operator(a:anynum, #"*", b:anynum)	{ #__primitive a #"*" b }
function operator(a:anynum, #"/", b:anynum)	{ #__primitive a #"/" b }
function operator(a:anynum, #"%", b:anynum)	{ #__primitive a #"%" b }
function operator(a:anynum, #"+", b:anynum)	{ #__primitive a #"+" b }
function operator(a:anynum, #"-", b:anynum)	{ #__primitive a #"-" b }
function operator(a:integer, #"<<", b:integer)	{ #__primitive a #"<<" b }
function operator(a:integer, #">>", b:integer)	{ #__primitive a #">>" b }
function operator(a:anynum, #"<", b:anynum)	{ #__primitive a #"<" b }
function operator(a:anynum, #"<=", b:anynum)	{ #__primitive a #"<=" b }
function operator(a:anynum, #">", b:anynum)	{ #__primitive a #">" b }
function operator(a:anynum, #">=", b:anynum)	{ #__primitive a #">=" b }
function operator(a:anynum, #"==", b:anynum)	{ #__primitive a #"==" b }
function operator(a:anynum, #"!=", b:anynum)	{ #__primitive a #"!=" b }
function operator(a:integer, #"&", b:integer)	{ #__primitive a #"&" b }
function operator(a:integer, #"^", b:integer)	{ #__primitive a #"^" b }
function operator(a:integer, #"|", b:integer)	{ #__primitive a #"|" b }
function operator(a:any, #"&&", b:any)		{ #__primitive a #"&&" b }
function operator(a:any, #"||", b:any)		{ #__primitive a #"||" b }
function operator(a:ref, #"=", b:any)		{ #__primitive a #"=" b; }
function operator(a:ref, #"*=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"*" b)
}
function operator(a:ref, #"/=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"/" b)
}
function operator(a:ref, #"%=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"%" b)
}
function operator(a:ref, #"+=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"+" b)
}
function operator(a:ref, #"-=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"-" b)
}
function operator(a:ref, #"<<=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"<<" b)
}
function operator(a:ref, #">>=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #">>" b)
}
function operator(a:ref, #"&=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"&" b)
}
function operator(a:ref, #"|=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"|" b)
}
function operator(a:ref, #"^=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"^" b)
}
function operator(a:any, #"->", b:symbol)	{ #__primitive (#__primitive #"*" a) #"." b }
function operator(a:any, #"->*", b:symbol)	{ #__primitive (#__primitive #"*" a) #"." b; }
function operator(a:anynum, #"^^", b:anynum)	{ #__primitive a #"^^" b }
function operator(#"++", a:ref)			{
   #__primitive a #"=" ((#__primitive #"*" a) #"+" 1)
}
function operator(#"--", a:ref)			{
   #__primitive a #"=" ((#__primitive #"*" a) #"-" 1)
}
function operator(#"+", a:anynum)		{ #__primitive #"+" a }
function operator(#"-", a:anynum)		{ #__primitive #"-" a }
function operator(#"~", a:anynum)		{ #__primitive #"~" a }
function operator(#"!", a:any)			{ #__primitive #"!" a }
function operator(#"*", a:any)			{ #__primitive #"*" a }
function operator(#"&", a:any)			{ #__primitive #"&" a }
function operator(a:anynum, #"|", b:anynum)	{ #__primitive a #"|" b }
function operator(#"(", a:symbol, b:any)	{ #__primitive #"(" a b }
function operator(a:ref, #"++")			{
   #__primitive a #"=" ((#__primitive #"*" a) #"+" 1)
}
function operator(a:ref, #"--")			{
   #__primitive a #"=" ((#__primitive #"*" a) #"-" 1)
}

// arrays

type sequence __name "sequence";
type domain __name "domain";
type array __name "array";
class locale {};

var Locales = new locale;

class distribution {
  type source_domain : domain;
  type destination_domain : domain;
  var source : source_domain;
  var destination : destination_domain;
  function local(i : sequence) : sequence;
  function offset(i : sequence) : sequence;
}

class cyclic implements distribution {
  var width : integer;
}

var block2 = new distribution;
function distribution::class(d:distribution, l:locale) { d }

class domain(rank, distribute, target) : vector {
  const rank : integer;
  const index : sequence;
  type target : domain;
  type distribute: distribution;
}

function domain::class(s1 : sequence) {
  var d = new domain;
  d.rank = 1;
  d.index = s1;
  return d;
}

function domain::class(s1 : sequence, s2 : sequence) {
  var d = new domain;
  d.rank = 2;
  d.index = new sequence;
  d.index.first = s1.first * s2.first;
  d.index.last = s1.last * s2.last;
  d.index.step = s1.step * s2.step;
  return d;
}

function domain::class(s : sequence, d : distribution) {
  domain(s)
}

class sequence {
  const first : tuple;
  const last : tuple;
  const step : tuple;
}

function sequence::class afirst alast astep {
  var s = new sequence;
  s.first = afirst;
  s.last = alast;
  s.step = astep;
  return s;
}

function operator(a:sequence, #"*", b:sequence) {
  new sequence
}

function vector::self s { #__index self s }
function domain::self s { new domain }

class array {
  var d : domain;
  var v : vector;
}

function array::self s { #__index self s }
function array::class dd e {
  var a = new array;
  a.d = dd;
  a.v = (#__make_vector dd.rank);
  (#__index a.v 0) = e;
  return a;
}

function operator(a:array, s:symbol, b:array) {
  operator(a.v(0), s, b.v(0));
}

function reshape(l:locale, s:sequence) { l }

function write(a) { 0 }
function print(a) { #__print a; }

/*
  David's old iterator and domain examples

// iterators

type iterator(a);
type iteratable = {
  type element_type;
  elements : iterator(element_type);
};

// domains

type domain;
type sequence __name "sequence";
type decomposition;
type arithmetic_domain(rank:symbol, distribute:decomposition, to:domain) : domain;
type opaque_domain(distribute:decomposition, to:domain) : domain;
type index(a:domain);
type subdomain(a:domain) = {
  size : integer;
  lbound : integer -> integer;
  ubound : integer -> integer;
};

type decomposition : catagory = {
  type source : domain, target : domain;
  locale : index(source) -> index(target);
};

type simple_block_decomposition : decomposition = {
  where source : arithmetic_domain(1), target : arithmetic_domain(1);
  s : source;
  t : target;
  chunk : integer;
  mod : integer;
};

simple_block_decomposition::local(i): {
  k : i / chunk;
  k : (i - s.lbound(1)) / chunk;
  if (k < mod)
    k += 1;
  k + t.lbound(1)
};

type map(d: domain, a) : iteratable = {
  elements : iterator(a);
  indexes : iterator(index(d));
  operator: #"[" * index(d) -> a &;
};

operator(a:map, #"[", b:index(map::d)): 0;
*/

// Chapel Prelude

in system __name "system"; // system module

// builtin types

type symbol __name "symbol";
type function __name "function";
type module __name "module";
type continuation __name "continuation";
type any __name "any";
type vector __name "vector";
type tuple __name "tuple";
type void __name "void" : tuple;
type object __name "object" = { };
type list __name "list";
type ref __name "ref";

type catagory __name "catagory";
type set __name "set" : catagory;

type integer8 __name "int8";
type integer16 __name "int16";
type integer32 __name "int32";
type integer64 __name "int64";
type integer __name "int" = integer64;
type uinteger8 __name "uint8";
type uinteger16 __name "uint16";
type uinteger32 __name "uint32";
type uinteger64 __name "uint64";
type uinteger __name "uint" = uinteger32;
type anyinteger __name "anyint" =
  integer8 | integer16 | integer32 | integer64 |
  uinteger8 | uinteger16 | uinteger32 | uinteger64;

type float32 __name "float32";
type float64 __name "float64";
type float80 __name "float80";
type float128 __name "float128";
type float __name "float" = float64;
type anyfloat __name "anyfloat" =
  float32 | float64 | float80 | float128;

type anynum __name "anynum" = anyinteger | anyfloat;
type char __name "char" = uinteger8;
type complex __name "complex";
type size __name "size" = uinteger;
type bool __name "bool" = integer;
type string __name "string";
type enum_element __name "enum_element" = integer;

// builtin constants
0;

// builtin value

null __name "null" : ();

// global initialization function

__init__ __name "init" : 0;

//   public internal function
var reply = #reply __name "reply";

// builtin symbols
#__make_tuple __name "make_tuple";
#__make_list __name "make_list";
#__make_vector __name "make_vector";
#__make_set __name "make_set";
#__make_continuation __name "make_continuation";
#__primitive __name "primitive";
#__new __name "new";
#__index __name "index";
#__print __name "print";
#operator __name "operator";
#"&" __name "doref";

// overloadable primitive operators
function new(a:any) { #__new a; }
function operator(a:any, #".", b:symbol)	{ #__primitive a #"." b }
function operator(a:any, #"*.", b:symbol)	{ #__primitive a #"." b }
function operator(a:anynum, #"*", b:anynum)	{ #__primitive a #"*" b }
function operator(a:anynum, #"/", b:anynum)	{ #__primitive a #"/" b }
function operator(a:anynum, #"%", b:anynum)	{ #__primitive a #"%" b }
function operator(a:anynum, #"+", b:anynum)	{ #__primitive a #"+" b }
function operator(a:anynum, #"-", b:anynum)	{ #__primitive a #"-" b }
function operator(a:integer, #"<<", b:integer)	{ #__primitive a #"<<" b }
function operator(a:integer, #">>", b:integer)	{ #__primitive a #">>" b }
function operator(a:anynum, #"<", b:anynum)	{ #__primitive a #"<" b }
function operator(a:anynum, #"<=", b:anynum)	{ #__primitive a #"<=" b }
function operator(a:anynum, #">", b:anynum)	{ #__primitive a #">" b }
function operator(a:anynum, #">=", b:anynum)	{ #__primitive a #">=" b }
function operator(a:anynum, #"==", b:anynum)	{ #__primitive a #"==" b }
function operator(a:anynum, #"!=", b:anynum)	{ #__primitive a #"!=" b }
function operator(a:integer, #"&", b:integer)	{ #__primitive a #"&" b }
function operator(a:integer, #"^", b:integer)	{ #__primitive a #"^" b }
function operator(a:integer, #"|", b:integer)	{ #__primitive a #"|" b }
function operator(a:any, #"&&", b:any)		{ #__primitive a #"&&" b }
function operator(a:any, #"||", b:any)		{ #__primitive a #"||" b }
function operator(a:ref, #"=", b:any)		{ #__primitive a #"=" b; }
function operator(a:ref, #"*=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"*" b)
}
function operator(a:ref, #"/=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"/" b)
}
function operator(a:ref, #"%=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"%" b)
}
function operator(a:ref, #"+=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"+" b)
}
function operator(a:ref, #"-=", b:anynum)	{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"-" b)
}
function operator(a:ref, #"<<=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"<<" b)
}
function operator(a:ref, #">>=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #">>" b)
}
function operator(a:ref, #"&=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"&" b)
}
function operator(a:ref, #"|=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"|" b)
}
function operator(a:ref, #"^=", b:integer)		{
  #__primitive a #"=" (#__primitive (#__primitive #"*" a) #"^" b)
}
function operator(a:any, #"->", b:symbol)	{ #__primitive (#__primitive #"*" a) #"." b }
function operator(a:any, #"->*", b:symbol)	{ #__primitive (#__primitive #"*" a) #"." b; }
function operator(a:anynum, #"^^", b:anynum)	{ #__primitive a #"^^" b }
function operator(#"++", a:ref)			{
   #__primitive a #"=" ((#__primitive #"*" a) #"+" 1)
}
function operator(#"--", a:ref)			{
   #__primitive a #"=" ((#__primitive #"*" a) #"-" 1)
}
function operator(#"+", a:anynum)		{ #__primitive #"+" a }
function operator(#"-", a:anynum)		{ #__primitive #"-" a }
function operator(#"~", a:anynum)		{ #__primitive #"~" a }
function operator(#"!", a:any)			{ #__primitive #"!" a }
function operator(#"*", a:any)			{ #__primitive #"*" a }
function operator(#"&", a:any)			{ #__primitive #"&" a }
function operator(a:anynum, #"|", b:anynum)	{ #__primitive a #"|" b }
function operator(#"(", a:symbol, b:any)	{ #__primitive #"(" a b }
function operator(a:ref, #"++")			{
   #__primitive a #"=" ((#__primitive #"*" a) #"+" 1)
}
function operator(a:ref, #"--")			{
   #__primitive a #"=" ((#__primitive #"*" a) #"-" 1)
}

// arrays

type sequence __name "sequence";
type domain __name "domain";
type array __name "array";
class locale {};

var Locales = new locale;

class distribution {
  type source_domain : domain;
  type destination_domain : domain;
  var source : source_domain;
  var destination : destination_domain;
  function local(i : sequence) : sequence;
  function offset(i : sequence) : sequence;
}

class cyclic implements distribution {
  var width : integer;
}

var block2 = new distribution;
function distribution::class(d:distribution, l:locale) { d }

class domain(rank, distribute, target) : vector {
  const rank : integer;
  const index : sequence;
  type target : domain;
  type distribute: distribution;
}

function domain::class(s1 : sequence) {
  var d = new domain;
  d.rank = 1;
  d.index = s1;
  return d;
}

function domain::class(s1 : sequence, s2 : sequence) {
  var d = new domain;
  d.rank = 2;
  d.index = new sequence;
  d.index.first = s1.first * s2.first;
  d.index.last = s1.last * s2.last;
  d.index.step = s1.step * s2.step;
  return d;
}

function domain::class(s : sequence, d : distribution) {
  domain(s)
}

class sequence {
  const first : tuple;
  const last : tuple;
  const step : tuple;
}

function sequence::class afirst alast astep {
  var s = new sequence;
  s.first = afirst;
  s.last = alast;
  s.step = astep;
  return s;
}

function operator(a:sequence, #"*", b:sequence) {
  new sequence
}

function vector::self s { #__index_vector self s }
function domain::self s { new domain }

class array {
  var d : domain;
  var v : vector;
}

function array::self s { #__index_vector self s }
function array::class dd e {
  var a = new array;
  a.d = dd;
  a.v = (#__make_vector dd.rank);
  (#__index_vector a.v 0) = e;
  return a;
}

function operator(a:array, s:symbol, b:array) {
  operator(a.v(0), s, b.v(0));
}

function reshape(l:locale, s:sequence) { l }

function write(a) { 0 }
function print(a) { #__print a; }

/*
  David's old iterator and domain examples

// iterators

type iterator(a);
type iteratable = {
  type element_type;
  elements : iterator(element_type);
};

// domains

type domain;
type sequence __name "sequence";
type decomposition;
type arithmetic_domain(rank:symbol, distribute:decomposition, to:domain) : domain;
type opaque_domain(distribute:decomposition, to:domain) : domain;
type index(a:domain);
type subdomain(a:domain) = {
  size : integer;
  lbound : integer -> integer;
  ubound : integer -> integer;
};

type decomposition : catagory = {
  type source : domain, target : domain;
  locale : index(source) -> index(target);
};

type simple_block_decomposition : decomposition = {
  where source : arithmetic_domain(1), target : arithmetic_domain(1);
  s : source;
  t : target;
  chunk : integer;
  mod : integer;
};

simple_block_decomposition::local(i): {
  k : i / chunk;
  k : (i - s.lbound(1)) / chunk;
  if (k < mod)
    k += 1;
  k + t.lbound(1)
};

type map(d: domain, a) : iteratable = {
  elements : iterator(a);
  indexes : iterator(index(d));
  operator: #"[" * index(d) -> a &;
};

operator(a:map, #"[", b:index(map::d)): 0;
*/


updating graph entropy to prune then grow as in the paper

/*
Behold, the Graph Entropy Module.  A nice introduction to this idea is
available from `Dr. Cho at Baylor University <http://web.ecs.baylor.edu/faculty/cho/Cho-Entropy.pdf>`_
*/
module GraphEntropy {
  use GraphUtils,
      Core;
  config const v = false;  // verbosity for logging

  /*
    Find the entropy of a given subgraph
   */
  proc subgraphEntropy(G: Graph, verts: domain) {
    var subgraph: [verts] G.Row.eltType,
       adjdom = verts,                         // Will hold the ids of all nodes adjacent to verts
       pints: [adjdom] real = 0,                // Internal edge weights per vertex
       pttls: [adjdom] real = 0,                // Total edge weight per vertex
       entropy: real = 0;

    /*
    Going to need to clean this up to one loop or so
    */
    for s in verts {
     var me = G.Row[s];
     var e = vertexLocalEntropy(me, verts);
     for nv in G.Row[s].neighborList {
       if !verts.member(nv[1]) && !adjdom.member(nv[1]) {
         // Don't calculate it again
         adjdom += nv[1];
         //writeln(" current adjdom: ", adjdom);
         var r = G.Row[nv[1]];
         // Break this out to its own variable for now to see if calcs are right
         var f = vertexLocalEntropy(r, verts);
         //writeln(" Vertex: ", nv[1], " Energy: ", e);
         e += f;
       }
     }
     //writeln(" Vertex: ", s, " Energy: ", e);
     entropy -= e;
    }
    return entropy;
  }

  /*
  Finds the entropy around a specific vertex by calculating the total weight of
  the interior and exterior edges, then applying a log multinomial

.. math::
  e = p_{interior} log (p_{interior}) + p_{exterior} log (p_{exterior})

   */
  proc vertexLocalEntropy(v: VertexData, interior: domain) {
    var interiorWeight:real = 0,
        totalWeight:real = 0;

    for n in v.neighborList {
      if interior.member(n[1]) {
        //writeln(" LOCALS ONLY, BRO! ", n, " -> ", n[1]);
        interiorWeight += n[2];
      }
      totalWeight += n[2];
    }
    return xlog2x(interiorWeight/totalWeight) + xlog2x(1-interiorWeight/totalWeight);
  }

  /*
    Try to find the smallest graph to express this set of nodes, eliminating ones that
    don't add entropy

    :param G: The parent Graph object
    :param interior: The vertex ids for the subgraph in question
   */
  proc minimalSubGraph(G: Graph, interior: domain) {
    var currentEntropy = subgraphEntropy(G, interior);
    var (entropy, minDom) = pruneBoundary(G, interior, currentEntropy);
    if v {
      writeln("  comming back from prune entropy=", entropy, " minDom=", minDom);
    }
    (entropy, minDom) = growBoundary(G, minDom, entropy);
    if v {
      writeln("  comming back from grow entropy=", entropy, " minDom=", minDom);
    }
    return (entropy, minDom);
  }

  proc pruneBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        //writeln("\tchecking ", n);
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Prune only
      for n in topDog.neighborList {
        var d = interior;

        if d.member(n[1]) {
          d -= n[1];
          var e = subgraphEntropy(G, d);
          //writeln("\t\tinterior: ", d, "  energy: ", e);
          if e < currentEntropy {
            if v {
              writeln("\t\tremoving ", n[1], " from interior lowers entropy to ", e);
            }
            minimalDomain -= n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

  proc growBoundary(G: Graph, interior: domain, entropy: real) {
    var currentEntropy = entropy,
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      // Grow only only
      for n in topDog.neighborList {
        var d = interior;

        if !d.member(n[1]) {
          d += n[1];
          var e = subgraphEntropy(G, d);
          if e < currentEntropy {
            if v {
              writeln("\t\tadding ", n[1], " to interior lowers entropy to ", e);
            }
            minimalDomain += n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;
    return (currentEntropy, minimalDomain);
  }

}

/*
Behold, the Graph Entropy Module.  A nice introduction to this idea is
available from `Dr. Cho at Baylor University <http://web.ecs.baylor.edu/faculty/cho/Cho-Entropy.pdf>`_
*/
module GraphEntropy {
  use GraphUtils,
      Core;
  config const v = false;  // verbosity for logging

  /*
    Find the entropy of a given subgraph
   */
  proc subgraphEntropy(G: Graph, verts: domain) {
    var subgraph: [verts] G.Row.eltType,
       adjdom = verts,                         // Will hold the ids of all nodes adjacent to verts
       pints: [adjdom] real = 0,                // Internal edge weights per vertex
       pttls: [adjdom] real = 0,                // Total edge weight per vertex
       entropy: real = 0;

    /*
    Going to need to clean this up to one loop or so
    */
    for s in verts {
     var me = G.Row[s];
     var e = vertexLocalEntropy(me, verts);
     for nv in G.Row[s].neighborList {
       if !verts.member(nv[1]) && !adjdom.member(nv[1]) {
         // Don't calculate it again
         adjdom += nv[1];
         //writeln(" current adjdom: ", adjdom);
         var r = G.Row[nv[1]];
         // Break this out to its own variable for now to see if calcs are right
         var f = vertexLocalEntropy(r, verts);
         //writeln(" Vertex: ", nv[1], " Energy: ", e);
         e += f;
       }
     }
     //writeln(" Vertex: ", s, " Energy: ", e);
     entropy -= e;
    }
    return entropy;
  }

  /*
  Finds the entropy around a specific vertex by calculating the total weight of
  the interior and exterior edges, then applying a log multinomial

.. math::
  e = p_{interior} log (p_{interior}) + p_{exterior} log (p_{exterior})

   */
  proc vertexLocalEntropy(v: VertexData, interior: domain) {
    var interiorWeight:real = 0,
        totalWeight:real = 0;

    for n in v.neighborList {
      if interior.member(n[1]) {
        //writeln(" LOCALS ONLY, BRO! ", n, " -> ", n[1]);
        interiorWeight += n[2];
      }
      totalWeight += n[2];
    }
    return xlog2x(interiorWeight/totalWeight) + xlog2x(1-interiorWeight/totalWeight);
  }

  /*
    Try to find the smallest graph to express this set of nodes, eliminating ones that
    don't add entropy

    :param G: The parent Graph object
    :param interior: The vertex ids for the subgraph in question
   */
  proc minimalSubGraph(G: Graph, interior: domain) {
    var currentEntropy = subgraphEntropy(G, interior),
        currentDomain = interior,
        minimalDomain = interior,
        initialNode = G.Row[interior.first];

    do {
      if v {
        writeln("   currentDomain, ", currentDomain);
      }
      var topDog = G.Row[currentDomain.first];
      for n in currentDomain {
        //writeln("\tchecking ", n);
        if G.Row[n].numNeighbors() > topDog.numNeighbors() {
          topDog = G.Row[n];
          if v {
            writeln("\tsetting pivot node to ", topDog.nid);
            writeln("\tvertex: ", n, " degree: ", topDog.numNeighbors());
          }
        }
      }

      for n in topDog.neighborList {
        var d = interior;
        // Switch the state of the neighbor
        //writeln("\t\tswitching ", n, " in ", d);
        if d.member(n[1]) {
          d -= n[1];
          var e = subgraphEntropy(G, d);
          //writeln("\t\tinterior: ", d, "  energy: ", e);
          if e < currentEntropy {
            if v {
              writeln("\t\tremoving ", n[1], " from interior lowers entropy to ", e);
            }
            minimalDomain -= n[1];
            currentEntropy = e;
          }
        } else {
          d += n[1];
          var e = subgraphEntropy(G, d);
          //writeln("\t\tinterior: ", d, "  energy: ", e);
          if e < currentEntropy {
            if v {
              writeln("\t\tadding ", n[1], " to interior lowers entropy to ", e);
            }
            minimalDomain += n[1];
            currentEntropy = e;
          }
        }
      }

      currentDomain -= topDog.nid;
    } while currentDomain.size > 0;

    return (currentEntropy, minimalDomain);
  }

}