Slight spacing change to minimize diff.

Slight spacing change to minimize diff.

/*
 * 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 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 interface, we anticipate replacing
  C-oriented arguments in the `plan_dft*()` routines (like `flags`)
  with more precise arguments that take advantage of Chapel's support
  for default argument values and keyword-based argument passing.
*/

//
// - 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?
//
// - Related question about fftw_ types taking type c_int, though
//   maybe we don't care that much (as compared to other interfaces)
//   since symbolic values are taken in? (i.e., we won't run into
//   32- vs. 64-bit issues...)
//

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: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks then
      for i in 1..input.rank do
        if (input.domain.dim(i).size != output.domain.dim(i).size) then
          halt("In plan_dft(), input and output arrays don't have same size in dimension ", i);

    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.
  //
  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 rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the corresponding dimension of the real aray.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ 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 : [] real(64), output : [] complex(128), flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    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
  // TODO : We should put in checks to see that the sizes are consistent
  // TODO : We should check on types...
  /*
    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 number of elements in 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/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :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 : [] ?t, flags : c_uint) : fftw_plan
  {
    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);
  }

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

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

    :arg output: The output array, whose rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the corresponding dimension of the real aray.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :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 : [] complex(128), output : [] real(64), flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    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 number of elements in 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/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :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: [] ?t, flags : c_uint) : fftw_plan
  {
    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);
  }

  // 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;

  pragma "no doc"
  module C_FFTW {
    extern proc fftw_plan_dft(rank: c_int,
                              n,  // BLC: having trouble being specific
                              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
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                  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);
  }
}


Update GitIntro

Update GitIntro

Add text for my (Kyle) line in GitIntro

/** 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", "", "", ""),
  ("David", "", "", ""),
  ("Greg", "", "", ""),
  ("Kyle", "C", "well", "like"),
  ("Lydia", "", "", ""),
  ("Michael", "", "", ""),
  ("Elliot", "", "", ""),
  ("Simon", "", "", ""),
  ("Sung", "", "", ""),
  ("Thomas", "", "", ""),
  ("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();
}

/** 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", "", "", ""),
  ("David", "", "", ""),
  ("Greg", "", "", ""),
  ("Kyle", "", "", ""),
  ("Lydia", "", "", ""),
  ("Michael", "", "", ""),
  ("Elliot", "", "", ""),
  ("Simon", "", "", ""),
  ("Sung", "", "", ""),
  ("Thomas", "", "", ""),
  ("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();
}


Oops, shouldn't have committed this on master

config const debug = false;

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false, followlinks=false): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  proc direntptr.isDir() {
    extern proc chpl_rt_direntptr_isDir(d: direntptr): bool;

    return chpl_rt_direntptr_isDir(this);
  }

  if (topdown) then
    yield path;

  if (depth) {
    var dir: DIRptr;
    var ent: direntptr;
    if debug then
      writeln("***Trying ", path);
    dir = opendir(path:c_string);
    if (!is_c_nil(dir)) {
      ent = readdir(dir);
      while (!is_c_nil(ent)) {
        const filename = ent.d_name();
        if (ent.isDir() && filename != "." && filename != "..") {
          if debug then
            writeln("***It's a dir!");
          if (dotfiles || filename.substring(1) != '.') {
            const fullpath = path + "/" + filename;
            //
            // feature request: This is a nice place for a yieldall concept
            //
            for dirname in walkdirs(fullpath, topdown, depth-1, dotfiles, followlinks) do
              yield dirname;
          }
        }
        ent = readdir(dir);
      }
    } else {
      extern proc perror(s: c_string);
      perror("error in walkdirs(): ");
    }
    closedir(dir);
  }

  if (!topdown) then
    yield path;
}

iter sorted(x) {
  use Sort;

  var y = x;
  QuickSort(y);
  for i in y do
    yield i;
}

config const startdir = "subdir";
config const topdown = true;
config const depth = max(int);
config const dotfiles = false;
config const followlinks = false;

config const sort = true;
config const defaults = false;

if defaults then
  if sort then
    for filename in sorted(walkdirs()) do
      writeln(filename);
 else
   for filename in walkdirs() do
     writeln(filename);
else
  if sort then
    for filename in sorted(walkdirs(startdir, topdown, depth, dotfiles, followlinks)) do
      writeln(filename);
 else
   for filename in walkdirs(startdir, topdown, depth, dotfiles, followlinks) do
     writeln(filename);


Modify the test users/ferguson/err_tmp.chpl

This test exercises a runtime function that is used by SysBasic.  I have made
that extern function definition private to SysBasic (because it isn't really
intended for users), but the test of its functionality is useful so add a
similar extern definition to the relevant portion of the test.

use SysBasic;

proc doDebugWrite(x, y):err_t {
  extern proc qio_int_to_err(a:int(32)):syserr;

  writeln("Debug Write: ", x, y);
  return qio_int_to_err(1);
}

proc test(arg:string, out error:err_t):bool {
  error = ENOERR;
  on Locales[0] {
    if ! error {
      error = doDebugWrite("test ", arg);
    }
  }
  return error==ENOERR;
}

var e:err_t = ENOERR;
test("hello", e);

use SysBasic;

proc doDebugWrite(x, y):err_t {
  writeln("Debug Write: ", x, y);
  return qio_int_to_err(1);
}

proc test(arg:string, out error:err_t):bool {
  error = ENOERR;
  on Locales[0] {
    if ! error {
      error = doDebugWrite("test ", arg);
    }
  }
  return error==ENOERR;
}

var e:err_t = ENOERR;
test("hello", e);


Removed one user temp from the fft benchmark, but this code will
require some form of garbage collection to run fast in order to handle
excess array alias classes (via slices) and domain classes via domain
creations in inner loops.

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

use BitOps;
use Random;
use Time;

use HPCCProblemSize;

param radix = 4;

param numVectors = 2;
type elemType = complex(128);

config const n = computeProblemSize(elemType, numVectors, returnLog2 = true);
const m = 2**n;

config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.clockMS else 314159265;

config const printParams = true,
             printArrays = false,
             printStats = true;

def main() {
  printConfiguration();

  const TwiddleDom: domain(1) distributed(Block) = [0..m/4);
  var Twiddles: [TwiddleDom] elemType;

  const ProblemDom: domain(1) distributed(Block) = [0..m);
  var Z, z: [ProblemDom] elemType;

  initVectors(Twiddles, z);

  const startTime = getCurrentTime();

  Z = conjg(z);
  bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  const execTime = getCurrentTime() - startTime;

  const validAnswer = verifyResults(z, Z, Twiddles);
  printResults(validAnswer, execTime);
}

def printConfiguration() {
  if (printParams) then printProblemSize(elemType, numVectors, m);
}

def initVectors(Twiddles, z) {
  computeTwiddles(Twiddles);
  bitReverseShuffle(Twiddles);

  fillRandom(z, seed);

  if (printArrays) {
    writeln("After initialization, Twiddles is: ", Twiddles, "\n");
    writeln("z is: ", z, "\n");
  }
}

def computeTwiddles(Twiddles) {
  const numTwdls = Twiddles.numElements,
        delta = 2.0 * atan(1.0) / numTwdls;

  Twiddles(0) = 1.0;
  Twiddles(numTwdls/2) = let x = cos(delta * numTwdls/2)
                          in (x, x):elemType;
  forall i in [1..numTwdls/2) {
    const x = cos(delta*i),
          y = sin(delta*i);
    Twiddles(i)            = (x, y):elemType;
    Twiddles(numTwdls - i) = (y, x):elemType;
  }
}

def bitReverseShuffle(Vect: [?Dom]) {
  const numBits = log2(Vect.numElements),
        Perm: [i in Dom] Vect.eltType = Vect(bitReverse(i, revBits=numBits));
  Vect = Perm;
}

def bitReverse(val: ?valType, revBits = 64) {
  param mask = 0x0102040810204080;
  const valReverse64 = bitMatMultOr(mask, bitMatMultOr(val:uint(64), mask)),
        valReverse = bitRotLeft(valReverse64, revBits);
  return valReverse: valType;
}

def dfft(A: [?ADom], W) {
  const numElements = A.numElements;
  var span = 1;

  for i in [2..log2(numElements)) by 2 {
    const m = radix*span,
          m2 = 2*m;

    forall (k,k1) in (ADom by m2, 0..) {
      var wk2 = W(k1),
          wk1 = W(2*k1),
          wk3 = (wk1.re - 2 * wk2.im * wk1.im,
                 2 * wk2.im * wk1.re - wk1.im):elemType;

      forall j in [k..k+span) do
        butterfly(wk1, wk2, wk3, A[j..j+3*span by span]);

      wk1 = W(2*k1+1);
      wk3 = (wk1.re - 2 * wk2.re * wk1.im,
             2 * wk2.re * wk1.re - wk1.im):elemType;
      wk2 *= 1.0i;

      forall j in [k+m..k+m+span) do
        butterfly(wk1, wk2, wk3, A[j..j+3*span by span]);
    }
    span *= radix;
  }

  if ((span*radix) == numElements) then
    forall j in [0..span) do
      butterfly(1.0, 1.0, 1.0, A[j..j+3*span by span]);
  else
    forall j in [0..span) {
      const a = A(j),
            b = A(j+span);
      A(j)      = a + b;
      A(j+span) = a - b;
    }
}

def butterfly(wk1, wk2, wk3, inout A:[1..radix]) {
  var x0 = A(1) + A(2),
      x1 = A(1) - A(2),
      x2 = A(3) + A(4),
      x3rot = (A(3) - A(4))*1.0i;

  A(1) = x0 + x2;
  x0 -= x2;
  A(3) = wk2 * x0;
  x0 = x1 + x3rot;
  A(2) = wk1 * x0;
  x0 = x1 - x3rot;
  A(4) = wk3 * x0;
}

def verifyResults(z, Z, Twiddles) {
  if (printArrays) then writeln("After FFT, Z is: ", Z, "\n");

  Z = conjg(Z) / m;
  bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  if (printArrays) then writeln("After inverse FFT, Z is: ", Z, "\n");

  var maxerr = max reduce sqrt((z.re - Z.re)**2 + (z.im - Z.im)**2);
  maxerr /= (epsilon * n);
  if (printStats) then writeln("error = ", maxerr);

  return (maxerr < threshold);
}

def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (Gflop/s) = ", 5.0 * (m * n) / execTime / 1.0e-9);
  }
}

use BitOps;
use Random;
use Time;

use HPCCProblemSize;

param radix = 4;

param numVectors = 2;
type elemType = complex(128);

config const n = computeProblemSize(elemType, numVectors, returnLog2 = true);
const m = 2**n;

config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.clockMS else 314159265;

config const printParams = true,
             printArrays = false,
             printStats = true;

def main() {
  printConfiguration();

  const TwiddleDom: domain(1) distributed(Block) = [0..m/4);
  var Twiddles: [TwiddleDom] elemType;

  const ProblemDom: domain(1) distributed(Block) = [0..m);
  var Z, z: [ProblemDom] elemType;

  initVectors(Twiddles, z);

  const startTime = getCurrentTime();

  Z = conjg(z);
  bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  const execTime = getCurrentTime() - startTime;

  const validAnswer = verifyResults(z, Z, Twiddles);
  printResults(validAnswer, execTime);
}

def printConfiguration() {
  if (printParams) then printProblemSize(elemType, numVectors, m);
}

def initVectors(Twiddles, z) {
  computeTwiddles(Twiddles);
  bitReverseShuffle(Twiddles);

  fillRandom(z, seed);

  if (printArrays) {
    writeln("After initialization, Twiddles is: ", Twiddles, "\n");
    writeln("z is: ", z, "\n");
  }
}

def computeTwiddles(Twiddles) {
  const numTwdls = Twiddles.numElements,
        delta = 2.0 * atan(1.0) / numTwdls;

  Twiddles(0) = 1.0;
  Twiddles(numTwdls/2) = let x = cos(delta * numTwdls/2)
                          in (x, x):elemType;
  forall i in [1..numTwdls/2) {
    const x = cos(delta*i),
          y = sin(delta*i);
    Twiddles(i)            = (x, y):elemType;
    Twiddles(numTwdls - i) = (y, x):elemType;
  }
}

def bitReverseShuffle(Vect: [?Dom]) {
  const numBits = log2(Vect.numElements),
        Perm: [i in Dom] index(Dom) = bitReverse(i, revBits = numBits),
        Temp = Vect(Perm);
  Vect = Temp;
}

def bitReverse(val: ?valType, revBits = 64) {
  param mask = 0x0102040810204080;
  const valReverse64 = bitMatMultOr(mask, bitMatMultOr(val:uint(64), mask)),
        valReverse = bitRotLeft(valReverse64, revBits);
  return valReverse: valType;
}

def dfft(A: [?ADom], W) {
  const numElements = A.numElements;
  var span = 1;

  for i in [2..log2(numElements)) by 2 {
    const m = radix*span,
          m2 = 2*m;

    forall (k,k1) in (ADom by m2, 0..) {
      var wk2 = W(k1),
          wk1 = W(2*k1),
          wk3 = (wk1.re - 2 * wk2.im * wk1.im,
                 2 * wk2.im * wk1.re - wk1.im):elemType;

      forall j in [k..k+span) do
        butterfly(wk1, wk2, wk3, A[j..j+3*span by span]);

      wk1 = W(2*k1+1);
      wk3 = (wk1.re - 2 * wk2.re * wk1.im,
             2 * wk2.re * wk1.re - wk1.im):elemType;
      wk2 *= 1.0i;

      forall j in [k+m..k+m+span) do
        butterfly(wk1, wk2, wk3, A[j..j+3*span by span]);
    }
    span *= radix;
  }

  if ((span*radix) == numElements) then
    forall j in [0..span) do
      butterfly(1.0, 1.0, 1.0, A[j..j+3*span by span]);
  else
    forall j in [0..span) {
      const a = A(j),
            b = A(j+span);
      A(j)      = a + b;
      A(j+span) = a - b;
    }
}

def butterfly(wk1, wk2, wk3, inout A:[1..radix]) {
  var x0 = A(1) + A(2),
      x1 = A(1) - A(2),
      x2 = A(3) + A(4),
      x3rot = (A(3) - A(4))*1.0i;

  A(1) = x0 + x2;
  x0 -= x2;
  A(3) = wk2 * x0;
  x0 = x1 + x3rot;
  A(2) = wk1 * x0;
  x0 = x1 - x3rot;
  A(4) = wk3 * x0;
}

def verifyResults(z, Z, Twiddles) {
  if (printArrays) then writeln("After FFT, Z is: ", Z, "\n");

  Z = conjg(Z) / m;
  bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  if (printArrays) then writeln("After inverse FFT, Z is: ", Z, "\n");

  var maxerr = max reduce sqrt((z.re - Z.re)**2 + (z.im - Z.im)**2);
  maxerr /= (epsilon * n);
  if (printStats) then writeln("error = ", maxerr);

  return (maxerr < threshold);
}

def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (Gflop/s) = ", 5.0 * (m * n) / execTime / 1.0e-9);
  }
}


Add comments to the reductions example look more like the other examples.

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

//
// An example use of the maxloc and minloc reductions.  An array is filled
// with random values and the locations of the maximum and minum are found.
//
use Random; // For random number generation

config const seed = 31415; // Random generation seed
config const size = 5;     // The size of each side of the array

var A: [1..size, 1..size] real; // The 2D work array

//
// Fill A with random real values between 0 and 1.
//
fillRandom(A, seed);

//
// Apply minloc and maxloc reductions. Capture the results into
// the maxVal, maxLoc, minVal, minLoc variables.
//
var (maxVal, maxLoc) = maxloc reduce (A, A.domain);
var (minVal, minLoc) = minloc reduce (A, A.domain);

//
// Print array and the results of the reductions
//
writeln("A is:"); writeln(A);
writeln("The maximum value in A is: A", maxLoc, " = ", maxVal);
writeln("The minimum value in A is: A", minLoc, " = ", minVal);
writeln("The difference is: ", maxVal - minVal);

use Random;

config const seed = 31415, size = 5;

var A: [1..size, 1..size] real;

fillRandom(A, seed);

var (maxVal, maxLoc) = maxloc reduce (A, A.domain);
var (minVal, minLoc) = minloc reduce (A, A.domain);

writeln("A is:"); writeln(A);
writeln("The maximum value in A is: A", maxLoc, " = ", maxVal);
writeln("The minimum value in A is: A", minLoc, " = ", minVal);
writeln("The difference is: ", maxVal - minVal);