Flipped routines right-side-up and started 80-columnizing docs

But will need to continue the latter during doc freeze

/*

Example usage of the FFTW module in Chapel. This particular file
demonstrates the single-threaded version of the code.

To compile this code :

   chpl testFFTW.chpl

If FFTW is not on your include/library paths, you can do

   chpl testFFTW.chpl -I$FFTW_DIR/include -L$FFTW_DIR/lib

where $FFTW_DIR points to your FFTW installation.

Note that you do not need to explicitly include the header or library
files; the module uses an experimental feature of the Chapel compiler
to automatically include these.

The FFTW module uses the FFTW3 API, and currently just implements the
basic, double-precision interface.  We will assume that the reader is
familiar with using FFTW; more details are at http://www.fftw.org.

The code computes a series of 1,2 and 3D transforms, exercising the
complex <-> complex, and real<->complex transforms (both in and out of
place). The output of the code should be a series of small numbers (
<= 10^-13); see testFFTW.good for example values (it is possible that
your values might differ).

The data for these tests is in arr{1,2,3}d.dat. The format of these
files is documented below.
*/

use FFTW;

// Do the tests and then cleanup.
proc main() {
  testAllDims();
  cleanup();
}

// A helper function that calls all the tests.
proc testAllDims() {
  writeln("1D");
  runtest(1, "arr1d.dat");
  writeln("2D");
  runtest(2, "arr2d.dat");
  writeln("3D");
  runtest(3, "arr3d.dat");
}

/* This is main test code, parametrized on the number of dimensions ndim.
   fn is the file that contains the test data.
*/
proc runtest(param ndim : int, fn : string) {
  var dims : ndim*int(32);

  /* We define a number of different domains below, corresponding to complex input/output arrays,
     real (input) -> complex (output) out-of-place arrays, and real <-> complex in-place arrays.

     The domains are :
     * D : for complex <-> complex transforms. This domain is also used for the real array in
           a real->complex out-of-place transform.
     * cD : for the complex array in a real <-> complex out-of-place transform.
     * rD : for the real array in a real <-> complex in-place transform. This includes the padding needed
            by the in-place transform. D is a sub-domain of this, and can be used to extract the real array,
            without padding.
     * reD, imD : Utility domains that access the real/complex parts of the complex array in a real<->complex in-place transform.
  */
  var D : domain(ndim);
  var rD,cD,reD,imD : domain(ndim,int,true);

  /* Read in the arrays from the file below. A,B are the arrays that will be used in the FFTW calls,
     goodA and goodB store the true values.

     Note that goodA is all real, allowing us to reuse the same array for the real<->complex tests.

     The file format is as follows (all little-endian):
        [ndim] int32 : dimensions of the array
        [narr] real64 : the real components of A (imaginary components are all zero). narr = N_1*N_2*..*N_ndim (product of dimensions)
        [narr] complex128 : the components of B (stored as real-imaginary pairs).

        The arrays are all stored in C (row-major) order.
  */
  var A,B,goodA,goodB : [D] complex(128);
  {
    var f = open(fn,iomode.r).reader(kind=iokind.little);
    // Read in dimensions
    for ii in 1..ndim {
      f.read(dims(ii));
    }
    /* The code below sets the domain D handling the different rank cases */
    select ndim {
      when 1 do D = 0.. #dims(1);
      when 2 do D = {0.. #dims(1), 0.. #dims(2)};
      when 3 do D = {0.. #dims(1), 0.. #dims(2), 0.. #dims(3)};
    }

    // Read in the arrays
    for val in goodA {
      f.read(val.re);
      val.im = 0;
    }
    for val in goodB {
      f.read(val);
    }
    f.close();
    writeln("Data read...");
  }

  /* Now set the remaining domains.

     The reader is referred to the FFTW documentation on the storage order for the in-place
     transforms (Sec 2.4 and 4.3.4).
  */
  select ndim {
    when 1 {
      var ldim = dims(1)/2 + 1;
      // Domains for real FFT
      rD = 0.. #(2*ldim); // Padding to do in place transforms
      cD = 0.. #ldim;
      // Define domains to extract the real and imaginary parts for inplace transforms
      reD = rD[0..(2*ldim-1) by 2];
      imD = rD[1..(2*ldim-1) by 2];
    }
    when 2 {
      // Domains for real FFT
      var ldim = dims(2)/2+1;
      rD = {0.. #dims(1),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,0..(2*ldim-1) by 2];
      imD = rD[..,1..(2*ldim-1) by 2];
    }
    when 3 {
      // Domains for real FFT
      var ldim = dims(3)/2+1;
      rD = {0.. #dims(1),0.. #dims(2),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #dims(2),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,..,0..(2*ldim-1) by 2];
      imD = rD[..,..,1..(2*ldim-1) by 2];
    }
  }

  // FFTW does not normalize inverse transform, so just compute the normalization constant.
  var norm = * reduce dims;

  /* We start the FFT tests below. The structure is the same :
      * Define plans for forward and reverse transforms.
      * Execute forward transform A -> B.
      * Compare with goodB.
      * Execute reverse transform B -> A and normalize.
      * Compare with goodA.
      * Cleanup plans
  */

  /* Complex <-> complex out-of-place transform.

     Unlike the basic FFTW interface, we do not have specific 1,2,3d planner routines.
     For the complex <-> complex case, the dimensions of the array are inferred automatically.

  */
	var fwd = plan_dft(A, B, FFTW_FORWARD, FFTW_ESTIMATE);
	var rev = plan_dft(B, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(B,goodB);
	execute(rev);
	A /= norm;
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Complex <-> complex in-place transform.

     This is the same calling sequence as above, but using the
     in-place versions of the routine.
  */
	fwd = plan_dft(A, FFTW_FORWARD, FFTW_ESTIMATE);
	rev = plan_dft(A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(A,goodB);
	execute(rev);
	A /= norm; // FFTW does an unnormalized transform
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Real <-> complex out-of-place transform

     As with FFTW, these use an r2c and c2r suffix to define the direction of the transform.

     plan_dft_r2c/plan_dft_c2r are overloaded; for the out-of-place transforms, they infer the
     dimensions from the sizes of the arrays passed in.
  */
  var rA : [D] real(64); // No padding for an out-of place transform
  var cB : [cD] complex(128);
  fwd = plan_dft_r2c(rA,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(cB,rA,FFTW_ESTIMATE);
  rA[D] = goodA.re;
  execute(fwd);
  printcmp(cB,goodB[cD]);
  execute(rev);
  rA /= norm;
  printcmp(rA[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     In this case, the first argument to the planning routines is the domain of the *real*
     array WITHOUT padding (in both r2c and c2r cases). This breaks the ambiguity of whether the leading
     dimension of the real array is even or odd.

     This design decision was motivated by the fact that the user has likely already defined a
     domain to extract the unpadded real array from the fully padded array (or that such a domain
     is intrinsically useful).

     For both the r2c and c2r transforms, a real array is passed in.

  */
  var rA2 : [rD] real(64);
  fwd = plan_dft_r2c(D,rA2,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,rA2,FFTW_ESTIMATE);
  rA2[D] = goodA.re;
  execute(fwd);
  printcmp(rA2[reD],goodB[cD].re); // Check the real and complex parts separately.
  printcmp(rA2[imD],goodB[cD].im);
  execute(rev);
  rA2 /= norm;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     This is similar to the previous case, except that we pass in a complex array, instead
     of a real array. This can get a little ugly, so we just reverse engineer the previous case.

     Note that we reuse the rA2 and cB arrays, since they're the correct sizes.
  */
  fwd = plan_dft_r2c(D,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,cB,FFTW_ESTIMATE);
  // Zero out rA2 to ensure that anything extraneous in the padding doesn't get passed in.
  rA2 = 0.0;
  rA2[D] = goodA.re;
  cB.re = rA2[reD]; // Fill the complex array
  cB.im = rA2[imD];
  execute(fwd);
  printcmp(cB.re,goodB[cD].re); // Check the real and complex parts separately.
  printcmp(cB.im,goodB[cD].im);
  execute(rev);
  cB /= norm;
  // Pull everything back out to the real array for simplicity
  rA2 = 0.0;
  rA2[reD] = cB.re;
  rA2[imD] = cB.im;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

}

/* Utility function to print the maximum absolute deviation between
   values computed by this code, and "truth". The true values are
   computed using Mathematica v10 */

proc printcmp(x, y) {
  var err = max reduce abs(x-y);
  writeln(err);
}

/*
Example usage of the FFTW module in Chapel. This particular file demonstrates the single-threaded version of
the code.

To compile this code :
   chpl testFFTW.chpl
If FFTW is not on your include/library paths, you can do
   chpl testFFTW.chpl -I$FFTW_DIR/include -L$FFTW_DIR/lib
where $FFTW_DIR points to your FFTW installation.

Note that you do not need to explicitly include the header or library files; the module uses an experimental
feature of the Chapel compiler to automatically include these.

The FFTW module uses the FFTW3 API, and currently just implements the basic, double-precision interface.
We will assume that the reader is familiar with using FFTW; more
details are at http://www.fftw.org.

The code computes a series of 1,2 and 3D transforms, exercising the complex <-> complex, and real<->complex
transforms (both in and out of place). The output of the code should be a series of small numbers ( <= 10^-13);
see testFFTW.good for example values (it is possible that your values might differ).

The data for these tests is in arr{1,2,3}d.dat. The format of these files is documented below.
*/
use FFTW;

/* Utility function to print the maximum absolute deviation between values computed by this code,
   and "truth". The true values are computed using Mathematica v10 */
proc printcmp(x, y) {
  var err = max reduce abs(x-y);
  writeln(err);
}

/* This is main test code, parametrized on the number of dimensions ndim.
  fn is the file that contains the test data.
*/
proc runtest(param ndim : int, fn : string) {
  var dims : ndim*int(32);

  /* We define a number of different domains below, corresponding to complex input/output arrays,
     real (input) -> complex (output) out-of-place arrays, and real <-> complex in-place arrays.

     The domains are :
     * D : for complex <-> complex transforms. This domain is also used for the real array in
           a real->complex out-of-place transform.
     * cD : for the complex array in a real <-> complex out-of-place transform.
     * rD : for the real array in a real <-> complex in-place transform. This includes the padding needed
            by the in-place transform. D is a sub-domain of this, and can be used to extract the real array,
            without padding.
     * reD, imD : Utility domains that access the real/complex parts of the complex array in a real<->complex in-place transform.
  */
  var D : domain(ndim);
  var rD,cD,reD,imD : domain(ndim,int,true);

  /* Read in the arrays from the file below. A,B are the arrays that will be used in the FFTW calls,
     goodA and goodB store the true values.

     Note that goodA is all real, allowing us to reuse the same array for the real<->complex tests.

     The file format is as follows (all little-endian):
        [ndim] int32 : dimensions of the array
        [narr] real64 : the real components of A (imaginary components are all zero). narr = N_1*N_2*..*N_ndim (product of dimensions)
        [narr] complex128 : the components of B (stored as real-imaginary pairs).

        The arrays are all stored in C (row-major) order.
  */
  var A,B,goodA,goodB : [D] complex(128);
  {
    var f = open(fn,iomode.r).reader(kind=iokind.little);
    // Read in dimensions
    for ii in 1..ndim {
      f.read(dims(ii));
    }
    /* The code below sets the domain D handling the different rank cases */
    select ndim {
      when 1 do D = 0.. #dims(1);
      when 2 do D = {0.. #dims(1), 0.. #dims(2)};
      when 3 do D = {0.. #dims(1), 0.. #dims(2), 0.. #dims(3)};
    }

    // Read in the arrays
    for val in goodA {
      f.read(val.re);
      val.im = 0;
    }
    for val in goodB {
      f.read(val);
    }
    f.close();
    writeln("Data read...");
  }

  /* Now set the remaining domains.

     The reader is referred to the FFTW documentation on the storage order for the in-place
     transforms (Sec 2.4 and 4.3.4).
  */
  select ndim {
    when 1 {
      var ldim = dims(1)/2 + 1;
      // Domains for real FFT
      rD = 0.. #(2*ldim); // Padding to do in place transforms
      cD = 0.. #ldim;
      // Define domains to extract the real and imaginary parts for inplace transforms
      reD = rD[0..(2*ldim-1) by 2];
      imD = rD[1..(2*ldim-1) by 2];
    }
    when 2 {
      // Domains for real FFT
      var ldim = dims(2)/2+1;
      rD = {0.. #dims(1),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,0..(2*ldim-1) by 2];
      imD = rD[..,1..(2*ldim-1) by 2];
    }
    when 3 {
      // Domains for real FFT
      var ldim = dims(3)/2+1;
      rD = {0.. #dims(1),0.. #dims(2),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #dims(2),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,..,0..(2*ldim-1) by 2];
      imD = rD[..,..,1..(2*ldim-1) by 2];
    }
  }

  // FFTW does not normalize inverse transform, so just compute the normalization constant.
  var norm = * reduce dims;

  /* We start the FFT tests below. The structure is the same :
      * Define plans for forward and reverse transforms.
      * Execute forward transform A -> B.
      * Compare with goodB.
      * Execute reverse transform B -> A and normalize.
      * Compare with goodA.
      * Cleanup plans
  */

  /* Complex <-> complex out-of-place transform.

     Unlike the basic FFTW interface, we do not have specific 1,2,3d planner routines.
     For the complex <-> complex case, the dimensions of the array are inferred automatically.

  */
	var fwd = plan_dft(A, B, FFTW_FORWARD, FFTW_ESTIMATE);
	var rev = plan_dft(B, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(B,goodB);
	execute(rev);
	A /= norm;
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Complex <-> complex in-place transform.

     This is the same calling sequence as above, but using the
     in-place versions of the routine.
  */
	fwd = plan_dft(A, FFTW_FORWARD, FFTW_ESTIMATE);
	rev = plan_dft(A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(A,goodB);
	execute(rev);
	A /= norm; // FFTW does an unnormalized transform
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Real <-> complex out-of-place transform

     As with FFTW, these use an r2c and c2r suffix to define the direction of the transform.

     plan_dft_r2c/plan_dft_c2r are overloaded; for the out-of-place transforms, they infer the
     dimensions from the sizes of the arrays passed in.
  */
  var rA : [D] real(64); // No padding for an out-of place transform
  var cB : [cD] complex(128);
  fwd = plan_dft_r2c(rA,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(cB,rA,FFTW_ESTIMATE);
  rA[D] = goodA.re;
  execute(fwd);
  printcmp(cB,goodB[cD]);
  execute(rev);
  rA /= norm;
  printcmp(rA[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     In this case, the first argument to the planning routines is the domain of the *real*
     array WITHOUT padding (in both r2c and c2r cases). This breaks the ambiguity of whether the leading
     dimension of the real array is even or odd.

     This design decision was motivated by the fact that the user has likely already defined a
     domain to extract the unpadded real array from the fully padded array (or that such a domain
     is intrinsically useful).

     For both the r2c and c2r transforms, a real array is passed in.

  */
  var rA2 : [rD] real(64);
  fwd = plan_dft_r2c(D,rA2,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,rA2,FFTW_ESTIMATE);
  rA2[D] = goodA.re;
  execute(fwd);
  printcmp(rA2[reD],goodB[cD].re); // Check the real and complex parts separately.
  printcmp(rA2[imD],goodB[cD].im);
  execute(rev);
  rA2 /= norm;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     This is similar to the previous case, except that we pass in a complex array, instead
     of a real array. This can get a little ugly, so we just reverse engineer the previous case.

     Note that we reuse the rA2 and cB arrays, since they're the correct sizes.
  */
  fwd = plan_dft_r2c(D,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,cB,FFTW_ESTIMATE);
  // Zero out rA2 to ensure that anything extraneous in the padding doesn't get passed in.
  rA2 = 0.0;
  rA2[D] = goodA.re;
  cB.re = rA2[reD]; // Fill the complex array
  cB.im = rA2[imD];
  execute(fwd);
  printcmp(cB.re,goodB[cD].re); // Check the real and complex parts separately.
  printcmp(cB.im,goodB[cD].im);
  execute(rev);
  cB /= norm;
  // Pull everything back out to the real array for simplicity
  rA2 = 0.0;
  rA2[reD] = cB.re;
  rA2[imD] = cB.im;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

}

// A helper function that calls all the tests.
proc testAllDims() {
  writeln("1D");
  runtest(1, "arr1d.dat");
  writeln("2D");
  runtest(2, "arr2d.dat");
  writeln("3D");
  runtest(3, "arr3d.dat");
}

// Do the tests and then cleanup.
proc main() {
  testAllDims();
  cleanup();
}


Changing a couple of vars to consts after reviewing the barrier code.

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

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();
      var heaviest_edge_weight$ : sync int = 0;

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      //       heaviest_edge_weight = max reduce [ s in G.vertices ]
      //        	                         [ w in G.edge_weight (s) ] w;

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in ( G.Neighbors (s), G.edge_weight (s) ) do

	  // should be forall, requires a custom parallel iterator in the
	  // random graph case and zippering for associative domains may
	  // also present a problem

	  if w == heaviest_edge_weight$.readXX () then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ",
		  heaviest_edge_weight$ . readFF ());
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in (G.Neighbors (s), G.edge_weight (s) ) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do { // eventually, will be forall

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      // min_distance must have been set by some thread by now

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteSpace, but aliasing is not supported
  const PrivateSpace = [LocaleSpace] dmapped Block(boundingBox=[LocaleSpace]);

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Had to change declaration below
      //    type Sparse_Vertex_List = sparse subdomain ( G.vertices );
      // to accommodate block distribution of G.vertices

      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      forall l in localePrivate do {
        l = new localePrivateData(vertex_domain);
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.children_list[v].nd = [1..G.n_Neighbors[v]];
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do {

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var depend => lp.get_depend(tid);
        var min_distance  => lp.get_min_distance(tid);
        var path_count$   => lp.get_path_count(tid);
        var children_list => lp.get_children_list(tid);
        forall v in vertex_domain do {
          depend[v] = 0.0;
          min_distance[v].write(-1);
          path_count$[v].writeXF(0.0);
          children_list[v].child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable, if
        //  such a thing existed
        //
        var Active_Remaining => lp.get_Active_Remaining(tid);
        Active_Remaining = true;
        var remaining = true;

        // Replicated level sets
        //
        // sungeun: 8/2011
        // Added replicated level sets
        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        var Active_Level => lp.get_Active_Level(tid);
        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            Active_Level[here.id].Members.add(s);
            min_distance[s].write(0);
            path_count$[s].writeXF(1);
          }
        }

	var current_distance : int = 0;

	// establish the initial level sets for the
	// breadth-first traversal from s

	while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            var barrier = new Barrier(numLocales);

            // sungeun: 8/2011
            // Copy this value to a constant to enable remote value
            // forwarding optimization.
            const current_distance_c = current_distance;
            coforall loc in Locales do on loc {
             forall u in Active_Level[here.id].Members do { // sparse

               forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do on vertex_domain.dist.idxToLocale(v) {
		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING then
		  if  min_distance[v].compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// thread will have set  min_distance$ (v) by the
		// time this code is reached, whether  v  lies in
		// the previous, the current or the next level.
		// ------------------------------------------------

		if min_distance[v].read() == current_distance_c {
                  path_count$[v] += path_count$[u].readFF();
                  children_list(u).add_child (v);
                }

	      }
	    };

            // sungeun: 8/2011
            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level
            barrier.notify();
            // do some work while we wait
            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            barrier.wait();

            Active_Level[here.id] = Active_Level[here.id].next;
            Active_Remaining[here.id] =
              Active_Level[here.id].Members.numIndices:bool;

          }

          remaining = || reduce Active_Remaining;

	};  // end forward pass

	if VALIDATE_BC then
	  Sum_Min_Dist$ += Lcl_Sum_Min_Dist;

	// -------------------------------------------------------------
	// compute the dependencies recursively, traversing the vertices
	// of the graph in non-increasing order of distance (reverse
	// ordering from the initial traversal)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

        // to simplify synchronization between multiple barriers
        var barrier: [2..graph_diameter] Barrier;
        [2..graph_diameter] barrier.reset(numLocales);

        coforall loc in Locales do on loc {
          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
              depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
                ( path_count$[u].readFF() /
                  path_count$[v].readFF() )      *
                ( 1.0 + depend (v) );
              Between_Cent$ (u) += depend (u);
            }
            // sungeun: 8/2011
            // This barrier is needed to insure all updates to depend are
            // complete before the next pass.
            barrier[current_distance].barrier();
          }
        }

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      forall l in localePrivate do on l {
          for i in l.r {
            var al  => l.temps[i].Active_Level;
            coforall loc in Locales do on loc {
                var level = al[here.id];
                while level != nil {
                    var l2 = level.next;
                    delete level;
                    level = l2;
                }
            }
            delete l.temps[i];
          }
          delete l;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ============================================================
  // generic class structure must be defined outside of
  // generic procedure.  used by Betweenness Centrality kernel 4.
  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards pass
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    var tid$           : sync chpl_taskID_t = chpl_nullTaskID;
    var min_distance   : [vertex_domain] atomic int;
    var path_count$    : [vertex_domain] sync real(64);
    var depend         : [vertex_domain] real;
    var children_list  : [vertex_domain] child_struct(index(vertex_domain));
    var Active_Remaining: [PrivateSpace] bool;
    var Active_Level   : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = [0..#numTasks];
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      // This code assumes that chpl_taskID_t is an integral type
      extern proc chpl_task_getId(): chpl_taskID_t;
      var mytid = chpl_task_getId();
      var slot = (mytid:uint % (numTasks:uint)):int;
      // Would be nice to have CAS
      var tid: chpl_taskID_t = temps[slot].tid$; // lock
      while ((tid != chpl_nullTaskID) && (tid != mytid)) {
        temps[slot].tid$ = tid;                  // unlock
        slot = (slot+1)%numTasks;
        tid = temps[slot].tid$;                  // lock
      }
      temps[slot].tid$ = mytid;                  // unlock
      return slot;
    }
    inline proc get_min_distance(tid=get_tid()) return temps[tid].min_distance;
    inline proc get_path_count(tid=get_tid()) return temps[tid].path_count$;
    inline proc get_depend(tid=get_tid()) return temps[tid].depend;
    inline proc get_children_list(tid=get_tid()) return temps[tid].children_list;
    inline proc get_Active_Remaining(tid=get_tid()) return temps[tid].Active_Remaining;
    inline proc get_Active_Level(tid=get_tid()) return temps[tid].Active_Level;
  }

  //
  // simple barrier implementation
  //
  extern proc chpl_task_yield();
  record Barrier {
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(n: int) {
      reset(n);
    }

    inline proc reset(n: int) {
      on this {
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
        } else {
          wait();
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier_notify()");
        }
      }
    }

    inline proc wait() {
      on this do
        while !done.read() do chpl_task_yield();
    }

    inline proc try() {
      return done.read();
    }
  }

}

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();
      var heaviest_edge_weight$ : sync int = 0;

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      //       heaviest_edge_weight = max reduce [ s in G.vertices ]
      //        	                         [ w in G.edge_weight (s) ] w;

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in ( G.Neighbors (s), G.edge_weight (s) ) do

	  // should be forall, requires a custom parallel iterator in the
	  // random graph case and zippering for associative domains may
	  // also present a problem

	  if w == heaviest_edge_weight$.readXX () then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ",
		  heaviest_edge_weight$ . readFF ());
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in (G.Neighbors (s), G.edge_weight (s) ) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do { // eventually, will be forall

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      // min_distance must have been set by some thread by now

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteSpace, but aliasing is not supported
  const PrivateSpace = [LocaleSpace] dmapped Block(boundingBox=[LocaleSpace]);

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Had to change declaration below
      //    type Sparse_Vertex_List = sparse subdomain ( G.vertices );
      // to accommodate block distribution of G.vertices

      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      forall l in localePrivate do {
        l = new localePrivateData(vertex_domain);
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.children_list[v].nd = [1..G.n_Neighbors[v]];
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do {

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var depend => lp.get_depend(tid);
        var min_distance  => lp.get_min_distance(tid);
        var path_count$   => lp.get_path_count(tid);
        var children_list => lp.get_children_list(tid);
        forall v in vertex_domain do {
          depend[v] = 0.0;
          min_distance[v].write(-1);
          path_count$[v].writeXF(0.0);
          children_list[v].child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable, if
        //  such a thing existed
        //
        var Active_Remaining => lp.get_Active_Remaining(tid);
        Active_Remaining = true;
        var remaining = true;

        // Replicated level sets
        //
        // sungeun: 8/2011
        // Added replicated level sets
        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        var Active_Level => lp.get_Active_Level(tid);
        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            Active_Level[here.id].Members.add(s);
            min_distance[s].write(0);
            path_count$[s].writeXF(1);
          }
        }

	var current_distance : int = 0;

	// establish the initial level sets for the
	// breadth-first traversal from s

	while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            var barrier = new Barrier(numLocales);

            // sungeun: 8/2011
            // Copy this value to a constant to enable remote value
            // forwarding optimization.
            const current_distance_c = current_distance;
            coforall loc in Locales do on loc {
             forall u in Active_Level[here.id].Members do { // sparse

               forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do on vertex_domain.dist.idxToLocale(v) {
		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING then
		  if  min_distance[v].compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// thread will have set  min_distance$ (v) by the
		// time this code is reached, whether  v  lies in
		// the previous, the current or the next level.
		// ------------------------------------------------

		if min_distance[v].read() == current_distance_c {
                  path_count$[v] += path_count$[u].readFF();
                  children_list(u).add_child (v);
                }

	      }
	    };

            // sungeun: 8/2011
            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level
            barrier.notify();
            // do some work while we wait
            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            barrier.wait();

            Active_Level[here.id] = Active_Level[here.id].next;
            Active_Remaining[here.id] =
              Active_Level[here.id].Members.numIndices:bool;

          }

          remaining = || reduce Active_Remaining;

	};  // end forward pass

	if VALIDATE_BC then
	  Sum_Min_Dist$ += Lcl_Sum_Min_Dist;

	// -------------------------------------------------------------
	// compute the dependencies recursively, traversing the vertices
	// of the graph in non-increasing order of distance (reverse
	// ordering from the initial traversal)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

        // to simplify synchronization between multiple barriers
        var barrier: [2..graph_diameter] Barrier;
        [2..graph_diameter] barrier.reset(numLocales);

        coforall loc in Locales do on loc {
          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
              depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
                ( path_count$[u].readFF() /
                  path_count$[v].readFF() )      *
                ( 1.0 + depend (v) );
              Between_Cent$ (u) += depend (u);
            }
            // sungeun: 8/2011
            // This barrier is needed to insure all updates to depend are
            // complete before the next pass.
            barrier[current_distance].barrier();
          }
        }

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      forall l in localePrivate do on l {
          for i in l.r {
            var al  => l.temps[i].Active_Level;
            coforall loc in Locales do on loc {
                var level = al[here.id];
                while level != nil {
                    var l2 = level.next;
                    delete level;
                    level = l2;
                }
            }
            delete l.temps[i];
          }
          delete l;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ============================================================
  // generic class structure must be defined outside of
  // generic procedure.  used by Betweenness Centrality kernel 4.
  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards pass
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    var tid$           : sync chpl_taskID_t = chpl_nullTaskID;
    var min_distance   : [vertex_domain] atomic int;
    var path_count$    : [vertex_domain] sync real(64);
    var depend         : [vertex_domain] real;
    var children_list  : [vertex_domain] child_struct(index(vertex_domain));
    var Active_Remaining: [PrivateSpace] bool;
    var Active_Level   : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = [0..#numTasks];
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      // This code assumes that chpl_taskID_t is an integral type
      extern proc chpl_task_getId(): chpl_taskID_t;
      var mytid = chpl_task_getId();
      var slot = (mytid:uint % (numTasks:uint)):int;
      // Would be nice to have CAS
      var tid: chpl_taskID_t = temps[slot].tid$; // lock
      while ((tid != chpl_nullTaskID) && (tid != mytid)) {
        temps[slot].tid$ = tid;                  // unlock
        slot = (slot+1)%numTasks;
        tid = temps[slot].tid$;                  // lock
      }
      temps[slot].tid$ = mytid;                  // unlock
      return slot;
    }
    inline proc get_min_distance(tid=get_tid()) return temps[tid].min_distance;
    inline proc get_path_count(tid=get_tid()) return temps[tid].path_count$;
    inline proc get_depend(tid=get_tid()) return temps[tid].depend;
    inline proc get_children_list(tid=get_tid()) return temps[tid].children_list;
    inline proc get_Active_Remaining(tid=get_tid()) return temps[tid].Active_Remaining;
    inline proc get_Active_Level(tid=get_tid()) return temps[tid].Active_Level;
  }

  //
  // simple barrier implementation
  //
  extern proc chpl_task_yield();
  record Barrier {
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(n: int) {
      reset(n);
    }

    inline proc reset(n: int) {
      on this {
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        var myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
        } else {
          wait();
        }
      }
    }

    inline proc notify() {
      on this {
        var myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier_notify()");
        }
      }
    }

    inline proc wait() {
      on this do
        while !done.read() do chpl_task_yield();
    }

    inline proc try() {
      return done.read();
    }
  }

}


Made the numIndices function for adomains
return a value of the per-dimension index
type rather than int(32), as it was before.
This is a partial stepping stone to the
current proposed solution to parameterize
this function by a type and make the
per-dimension index type be the default
type (something that I didn't have time
to undertake on this check-in).

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

//
// Arrays and domains
//

// this is the class that all array classes are derived from
pragma "abase"
class _abase {
  def reallocate(d: _domain) {
    halt("reallocation not implemented for this array");
  }
}

// this is a wrapper class for all arrays
pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d: _domain)
    return _value.slice(d._value);

  def =this(d: _domain, val: elt_type) {
    for i in d do
      this(i) = val;
  }

  def this(i: dom._index_type)
    return _value(i);

  def this(i: dom._dim_index_type ...rank) where rank > 1
    return _value(i);

  def this(i: _aseq(dom._dim_index_type) ...rank)
    return _value((...i));

  def =this(i: dom._index_type, val: elt_type) {
    _value(i) = val;
  }

  def =this(i: dom._dim_index_type ...rank, val: elt_type) where rank > 1 {
    _value(i) = val;
  }

  def =this(i: _aseq(dom._dim_index_type) ...rank, val: elt_type) {
    _value((...i)) = val;
  }

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def numElements return dom.numIndices;

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: _domain) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: seq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: _aseq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: a.elt_type) {
  a._value.assign(b);
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

pragma "domain"
class _domain {
  type _domain_type;
  type _index_type;
  type _dim_index_type;
  param rank : int;
  var _value : _domain_type;
  var _arrs: seq(_abase);

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : _index_type {
    forall x in _value
      yield x;
  }

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    _arrs #= x;
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def _exclusive_upper
    return _domain(_domain_type, _index_type, _dim_index_type, rank, _value._exclusive_upper);

  def add(i) {
    _value.add(i);
  }

  def remove(i) {
    _value.remove(i);
  }

  def numIndices return _value.numIndices;
  def low return _value.low;
  def high return _value.high;

  def member?(i) {
    return _value.member?(i);
  }

  def expand(i: int ...rank)
    return expand(i);

  def expand(i: rank*int) {
    var x = _value.expand(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def expand(i: int) where rank > 1 {
    var x = _value.expand(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def exterior(i: int ...rank)
    return exterior(i);

  def exterior(i: rank*int) {
    var x = _value.exterior(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def interior(i: int ...rank)
    return interior(i);

  def interior(i: rank*int) {
    var x = _value.interior(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def translate(i: int ...rank)
    return translate(i);

  def translate(i: rank*int) {
    var x = _value.translate(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  for e in a._arrs do
    e.reallocate(b);
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a._index_type, a._dim_index_type, a.rank, x);
}

////////////////////////////////////////////////////

def _build_domain(x)
  return x;

def _build_domain(ranges: _aseq ...?rank) {
  type t = ranges(1).elt_type;
  var x = _adomain(rank, t, ranges);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, t, rank, x);
}

def _build_domain_exclusive_upper(x: _domain)
  return x._exclusive_upper;

def _build_domain_type(param rank : int, type dimensional_index_type = int) {
  var x = _adomain(rank, dimensional_index_type);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, dimensional_index_type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, ind_type, ind_type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  var x: dom._index_type;
  return x;
}

///////////////

def _aseq._translate(i : int) {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  type dim_type;
  var ranges : rank*_aseq(dim_type);

  def _exclusive_upper {
    var x = _adomain(rank, dim_type);
    for param i in 1..rank {
      if ranges(i)._stride != 1 then
        halt("syntax [domain-specification) requires a stride of one");
      x.ranges(i) = ranges(i)._low..ranges(i)._high-1;
    }
    return x;
  }

  def getHeadCursor() {
    var c : rank*dim_type;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(rank-i+1) = ranges(rank-i+1).getNextCursor(c(rank-i+1));
      if ranges(rank-i+1).isValidCursor?(c(rank-i+1)) then
        return c;
      else
        c(rank-i+1) = ranges(rank-i+1).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    return c(1) != ranges(1)._high+1;
  }

  def this(dim : int)
    return ranges(dim);

  def numIndices {
    var sum = 1:dim_type;
    for param i in 1..rank do
      sum *= ranges(i).length;
    return sum;
    // WANT: return * reduce (this(1..rank).length);
  }

  def low {
    if (rank == 1) then
      return ranges(1)._low;
    else
      compilerError("low currently implemented only for rank-1 domains");
  }

  def high {
    if (rank == 1) then
      return ranges(1)._high;
    else
      commpilerError("high currently implemented only for rank-1 domains");
  }

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dim_type, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, dim_type, adomain=this);

  def translate(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def interior(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def exterior(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def expand(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim: int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = ranges(i)._expand(dim);
    return x;
  }

}

// this should eventually...
// ...be an iterator
// ...be in the distribtion's implementation of the blocked domain
// ...yield a subBlock of the domain per thread per locale
iterator subBlocks(D: ?DT): DT {
  yield [D.low..D.high];
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank, dom.dim_type);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank, dom.dim_type);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

class _aarray: _abase {
  type elt_type;
  param rank : int;
  type dim_type;

  var dom : _adomain(rank, dim_type);
  var off: rank*dim_type;
  var blk: rank*dim_type;
  var str: rank*int;
  var orig: rank*dim_type;
  var size : dim_type;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return dom.getHeadCursor();

  def getNextCursor(c)
    return dom.getNextCursor(c);

  def getValue(c)
    return this(dom.getValue(c));

  def isValidCursor?(c)
    return dom.isValidCursor?(c);

  def initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom(dim)._low;
      str(dim) = dom(dim)._stride;
      orig(dim) = 0:dim_type;
    }
    blk(rank) = 1:dim_type;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size:int); // ahh!!! can't cast to int here
    data.init();
  }

  def this(ind: dim_type ...1) var where rank == 1
    return this(ind);

  def this(ind : rank*dim_type) var {
    if boundsChecking
      for param i in 1..rank do
        if !_in(dom(i), ind(i)) then
          halt("array index out of bounds: ", ind);
    var sum : dim_type;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i) / str(i):dim_type - orig(i);
    return data(sum:int); // !!ahh
  }

  def this(ind: _aseq(dim_type) ...rank) var {
    var d = [(...ind)];
    return slice(d._value);
  }

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias = _aarray(elt_type, rank, dim_type, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i) * (dom(i)._stride / str(i));
      alias.str(i) = d(i)._stride;
      alias.orig(i) = orig(i) + (off(i) - dom(i)._low) * blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, dim_type, rank, d));
  }

  def slice(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank {
      if !_in(dom(i), d(i)) then
        halt("array slice out of bounds in dimension ", i, ": ", d);
      if d(i)._stride % dom(i)._stride != 0 then
        halt("stride of array slice is not multiple of stride in dimension ", i);
    }
    var alias = _aarray(elt_type, rank, dim_type, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = off(i);
      alias.blk(i) = blk(i);
      alias.str(i) = str(i);
      alias.orig(i) = orig(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, dim_type, rank, d));
  }

  def reallocate(d: _domain) {
    if (d.rank == rank) {
      var new = _aarray(elt_type, rank, dim_type, d._value);
      for i in _intersect(d._value, dom) do
        new(i) = this(i);
      dom = new.dom;
      off = new.off;
      blk = new.blk;
      str = new.str;
      orig = new.orig;
      size = new.size;
      data = new.data;
    }
  }

  def assign(y : _aarray) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : _adomain) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : seq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: _aseq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: elt_type) {
    for i in dom do
      this(i) = y;
  }
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*x.dim_type;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) <= (x.dom(x.rank)._high - x.dom(x.rank)._stride:x.dim_type) {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride:x.dim_type;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) <= (x.dom(dim)._high - x.dom(dim)._stride:x.dim_type) {
          i(dim) += x.dom(dim)._stride:x.dim_type;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}

def _intersect(a: _aseq, b: _aseq) {
  var g, x: int;
  (g, x) = _extended_euclid(a._stride, b._stride);
  var gg = g:a.elt_type;
  var xx = x:a.elt_type;
  var as = (a._stride):a.elt_type;
  if abs(a._low - b._low) % gg != 0 then
    return 1..0:a.elt_type;
  var low = max(a._low, b._low);
  var high = min(a._high, b._high);
  var stride = a._stride * b._stride / g;
  var alignment = a._low + (b._low - a._low) * xx * as / gg;
  if alignment == 0 then
    alignment = stride:a.elt_type;
  low = low + low % alignment;
  return low..high by stride;
}

def _intersect(a: _adomain, b: _adomain) {
  var c = _adomain(a.rank, a.dim_type);
  for param i in 1..a.rank do
    c.ranges(i) = _intersect(a(i), b(i));
  return c;
}

// Extended-Euclid (Knuth Volume 2 --- Section 4.5.2)
// given two non-negative integers u and v
// returns (gcd(u, v), x) where x is set such that u*x + v*y = gcd(u, v)
def _extended_euclid(u: int, v: int) {
  var u1 = 1;
  var u2 = 0;
  var u3 = u;
  var v1 = 0;
  var v2 = 1;
  var v3 = v;
  while v3 != 0 {
    var q = u3 / v3;
    var t1 = u1 - v1 * q;
    var t2 = u2 - v2 * q;
    var t3 = u3 - v3 * q;
    u1 = v1;
    u2 = v2;
    u3 = v3;
    v1 = t1;
    v2 = t2;
    v3 = t3;
  }
  return (u3, u1);
}

-- Arithmetic sequence

def _build_aseq(low: int, high: int) return _aseq(int, low, high);
def _build_aseq(low: uint, high: uint) return _aseq(uint, low, high);
def _build_aseq(low: int(64), high: int(64)) return _aseq(int(64), low, high);
def _build_aseq(low: uint(64), high: uint(64)) return _aseq(uint(64), low, high);

def _build_aseq(low, high) {
  compilerError("arithmetic sequence bounds are not of integral type");
}

record _aseq {
  type elt_type;
  var _low : elt_type;
  var _high : elt_type;
  var _stride : int = 1;

  def initialize() {
    if _low > _high {
      _low = 1:elt_type;
      _high = 0:elt_type;
      _stride = 1;
    }
  }

  iterator this() : elt_type {
    forall x in this
      yield x;
  }

  def getHeadCursor()
    if _stride > 0 then
      return _low;
    else
      return _high;

  def getNextCursor(c)
    return c + _stride:elt_type;

  def getValue(c)
    return c;

  def isValidCursor?(c)
    return _low <= c && c <= _high;

  def length
    return
      (if _stride > 0
        then (_high - _low + _stride:elt_type) / _stride:elt_type
        else (_low - _high + _stride:elt_type) / _stride:elt_type);
}

def by(s : _aseq, i : int) {
  if i == 0 then
    halt("illegal stride of 0");
  if s._low == 1 && s._high == 0 then
    return _aseq(s.elt_type, s._low, s._high, s._stride);
  var as = _aseq(s.elt_type, s._low, s._high, s._stride * i);
  if as._stride < 0 then
    as._low = as._low + (as._high - as._low) % (-as._stride):as.elt_type;
  else
    as._high = as._high - (as._high - as._low) % (as._stride):as.elt_type;
  return as;
}

def _in(s : _aseq, i : s.elt_type)
  return i >= s._low && i <= s._high &&
    (i - s._low) % abs(s._stride):s.elt_type == 0;

// really slow --- REWRITE
def _in(s1: _aseq, s2: _aseq) {
  for i in s2 do
    if !_in(s1, i) then
      return false;
  return true;
}

def fwrite(f : file, s : _aseq) {
  fwrite(f, s._low, "..", s._high);
  if (s._stride != 1) then
    fwrite(f, " by ", s._stride);
}

pragma "inline" def string.substring(s: _aseq)
  if s._stride != 1 then
    return __primitive("string_strided_select", this, s._low, s._high, s._stride);
  else
    return __primitive("string_select", this, s._low, s._high);

//
// Arrays and domains
//

// this is the class that all array classes are derived from
pragma "abase"
class _abase {
  def reallocate(d: _domain) {
    halt("reallocation not implemented for this array");
  }
}

// this is a wrapper class for all arrays
pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d: _domain)
    return _value.slice(d._value);

  def =this(d: _domain, val: elt_type) {
    for i in d do
      this(i) = val;
  }

  def this(i: dom._index_type)
    return _value(i);

  def this(i: dom._dim_index_type ...rank) where rank > 1
    return _value(i);

  def this(i: _aseq(dom._dim_index_type) ...rank)
    return _value((...i));

  def =this(i: dom._index_type, val: elt_type) {
    _value(i) = val;
  }

  def =this(i: dom._dim_index_type ...rank, val: elt_type) where rank > 1 {
    _value(i) = val;
  }

  def =this(i: _aseq(dom._dim_index_type) ...rank, val: elt_type) {
    _value((...i)) = val;
  }

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def numElements return dom.numIndices;

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: _domain) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: seq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: _aseq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: a.elt_type) {
  a._value.assign(b);
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

pragma "domain"
class _domain {
  type _domain_type;
  type _index_type;
  type _dim_index_type;
  param rank : int;
  var _value : _domain_type;
  var _arrs: seq(_abase);

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : _index_type {
    forall x in _value
      yield x;
  }

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    _arrs #= x;
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def _exclusive_upper
    return _domain(_domain_type, _index_type, _dim_index_type, rank, _value._exclusive_upper);

  def add(i) {
    _value.add(i);
  }

  def remove(i) {
    _value.remove(i);
  }

  def numIndices return _value.numIndices;
  def low return _value.low;
  def high return _value.high;

  def member?(i) {
    return _value.member?(i);
  }

  def expand(i: int ...rank)
    return expand(i);

  def expand(i: rank*int) {
    var x = _value.expand(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def expand(i: int) where rank > 1 {
    var x = _value.expand(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def exterior(i: int ...rank)
    return exterior(i);

  def exterior(i: rank*int) {
    var x = _value.exterior(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def interior(i: int ...rank)
    return interior(i);

  def interior(i: rank*int) {
    var x = _value.interior(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }

  def translate(i: int ...rank)
    return translate(i);

  def translate(i: rank*int) {
    var x = _value.translate(i);
    return _domain(x.type, _index_type, _dim_index_type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  for e in a._arrs do
    e.reallocate(b);
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a._index_type, a._dim_index_type, a.rank, x);
}

////////////////////////////////////////////////////

def _build_domain(x)
  return x;

def _build_domain(ranges: _aseq ...?rank) {
  type t = ranges(1).elt_type;
  var x = _adomain(rank, t, ranges);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, t, rank, x);
}

def _build_domain_exclusive_upper(x: _domain)
  return x._exclusive_upper;

def _build_domain_type(param rank : int, type dimensional_index_type = int) {
  var x = _adomain(rank, dimensional_index_type);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, dimensional_index_type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, ind_type, ind_type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  var x: dom._index_type;
  return x;
}

///////////////

def _aseq._translate(i : int) {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  type dim_type;
  var ranges : rank*_aseq(dim_type);

  def _exclusive_upper {
    var x = _adomain(rank, dim_type);
    for param i in 1..rank {
      if ranges(i)._stride != 1 then
        halt("syntax [domain-specification) requires a stride of one");
      x.ranges(i) = ranges(i)._low..ranges(i)._high-1;
    }
    return x;
  }

  def getHeadCursor() {
    var c : rank*dim_type;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(rank-i+1) = ranges(rank-i+1).getNextCursor(c(rank-i+1));
      if ranges(rank-i+1).isValidCursor?(c(rank-i+1)) then
        return c;
      else
        c(rank-i+1) = ranges(rank-i+1).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    return c(1) != ranges(1)._high+1;
  }

  def this(dim : int)
    return ranges(dim);

  def numIndices {
    var sum = 1;
    for param i in 1..rank do
      sum *= ranges(i).length;
    return sum;
    // WANT: return * reduce (this(1..rank).length);
  }

  def low {
    if (rank == 1) then
      return ranges(1)._low;
    else
      compilerError("low currently implemented only for rank-1 domains");
  }

  def high {
    if (rank == 1) then
      return ranges(1)._high;
    else
      commpilerError("high currently implemented only for rank-1 domains");
  }

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dim_type, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, dim_type, adomain=this);

  def translate(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def interior(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def exterior(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def expand(dim: rank*int) {
    var x = _adomain(rank, int);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim: int) {
    var x = _adomain(rank, int);
    for i in 1..rank do
      x.ranges(i) = ranges(i)._expand(dim);
    return x;
  }

}

// this should eventually...
// ...be an iterator
// ...be in the distribtion's implementation of the blocked domain
// ...yield a subBlock of the domain per thread per locale
iterator subBlocks(D: ?DT): DT {
  yield [D.low..D.high];
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank, dom.dim_type);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank, dom.dim_type);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

class _aarray: _abase {
  type elt_type;
  param rank : int;
  type dim_type;

  var dom : _adomain(rank, dim_type);
  var off: rank*dim_type;
  var blk: rank*dim_type;
  var str: rank*int;
  var orig: rank*dim_type;
  var size : dim_type;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return dom.getHeadCursor();

  def getNextCursor(c)
    return dom.getNextCursor(c);

  def getValue(c)
    return this(dom.getValue(c));

  def isValidCursor?(c)
    return dom.isValidCursor?(c);

  def initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom(dim)._low;
      str(dim) = dom(dim)._stride;
      orig(dim) = 0:dim_type;
    }
    blk(rank) = 1:dim_type;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size:int); // ahh!!! can't cast to int here
    data.init();
  }

  def this(ind: dim_type ...1) var where rank == 1
    return this(ind);

  def this(ind : rank*dim_type) var {
    if boundsChecking
      for param i in 1..rank do
        if !_in(dom(i), ind(i)) then
          halt("array index out of bounds: ", ind);
    var sum : dim_type;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i) / str(i):dim_type - orig(i);
    return data(sum:int); // !!ahh
  }

  def this(ind: _aseq(dim_type) ...rank) var {
    var d = [(...ind)];
    return slice(d._value);
  }

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias = _aarray(elt_type, rank, dim_type, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i) * (dom(i)._stride / str(i));
      alias.str(i) = d(i)._stride;
      alias.orig(i) = orig(i) + (off(i) - dom(i)._low) * blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, dim_type, rank, d));
  }

  def slice(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank {
      if !_in(dom(i), d(i)) then
        halt("array slice out of bounds in dimension ", i, ": ", d);
      if d(i)._stride % dom(i)._stride != 0 then
        halt("stride of array slice is not multiple of stride in dimension ", i);
    }
    var alias = _aarray(elt_type, rank, dim_type, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = off(i);
      alias.blk(i) = blk(i);
      alias.str(i) = str(i);
      alias.orig(i) = orig(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, dim_type, rank, d));
  }

  def reallocate(d: _domain) {
    if (d.rank == rank) {
      var new = _aarray(elt_type, rank, dim_type, d._value);
      for i in _intersect(d._value, dom) do
        new(i) = this(i);
      dom = new.dom;
      off = new.off;
      blk = new.blk;
      str = new.str;
      orig = new.orig;
      size = new.size;
      data = new.data;
    }
  }

  def assign(y : _aarray) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : _adomain) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : seq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: _aseq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: elt_type) {
    for i in dom do
      this(i) = y;
  }
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*x.dim_type;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) <= (x.dom(x.rank)._high - x.dom(x.rank)._stride:x.dim_type) {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride:x.dim_type;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) <= (x.dom(dim)._high - x.dom(dim)._stride:x.dim_type) {
          i(dim) += x.dom(dim)._stride:x.dim_type;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}

def _intersect(a: _aseq, b: _aseq) {
  var g, x: int;
  (g, x) = _extended_euclid(a._stride, b._stride);
  var gg = g:a.elt_type;
  var xx = x:a.elt_type;
  var as = (a._stride):a.elt_type;
  if abs(a._low - b._low) % gg != 0 then
    return 1..0:a.elt_type;
  var low = max(a._low, b._low);
  var high = min(a._high, b._high);
  var stride = a._stride * b._stride / g;
  var alignment = a._low + (b._low - a._low) * xx * as / gg;
  if alignment == 0 then
    alignment = stride:a.elt_type;
  low = low + low % alignment;
  return low..high by stride;
}

def _intersect(a: _adomain, b: _adomain) {
  var c = _adomain(a.rank, a.dim_type);
  for param i in 1..a.rank do
    c.ranges(i) = _intersect(a(i), b(i));
  return c;
}

// Extended-Euclid (Knuth Volume 2 --- Section 4.5.2)
// given two non-negative integers u and v
// returns (gcd(u, v), x) where x is set such that u*x + v*y = gcd(u, v)
def _extended_euclid(u: int, v: int) {
  var u1 = 1;
  var u2 = 0;
  var u3 = u;
  var v1 = 0;
  var v2 = 1;
  var v3 = v;
  while v3 != 0 {
    var q = u3 / v3;
    var t1 = u1 - v1 * q;
    var t2 = u2 - v2 * q;
    var t3 = u3 - v3 * q;
    u1 = v1;
    u2 = v2;
    u3 = v3;
    v1 = t1;
    v2 = t2;
    v3 = t3;
  }
  return (u3, u1);
}

-- Arithmetic sequence

def _build_aseq(low: int, high: int) return _aseq(int, low, high);
def _build_aseq(low: uint, high: uint) return _aseq(uint, low, high);
def _build_aseq(low: int(64), high: int(64)) return _aseq(int(64), low, high);
def _build_aseq(low: uint(64), high: uint(64)) return _aseq(uint(64), low, high);

def _build_aseq(low, high) {
  compilerError("arithmetic sequence bounds are not of integral type");
}

record _aseq {
  type elt_type;
  var _low : elt_type;
  var _high : elt_type;
  var _stride : int = 1;

  def initialize() {
    if _low > _high {
      _low = 1:elt_type;
      _high = 0:elt_type;
      _stride = 1;
    }
  }

  iterator this() : elt_type {
    forall x in this
      yield x;
  }

  def getHeadCursor()
    if _stride > 0 then
      return _low;
    else
      return _high;

  def getNextCursor(c)
    return c + _stride:elt_type;

  def getValue(c)
    return c;

  def isValidCursor?(c)
    return _low <= c && c <= _high;

  def length
    return
      (if _stride > 0
        then (_high - _low + _stride:elt_type) / _stride:elt_type
        else (_low - _high + _stride:elt_type) / _stride:elt_type);
}

def by(s : _aseq, i : int) {
  if i == 0 then
    halt("illegal stride of 0");
  if s._low == 1 && s._high == 0 then
    return _aseq(s.elt_type, s._low, s._high, s._stride);
  var as = _aseq(s.elt_type, s._low, s._high, s._stride * i);
  if as._stride < 0 then
    as._low = as._low + (as._high - as._low) % (-as._stride):as.elt_type;
  else
    as._high = as._high - (as._high - as._low) % (as._stride):as.elt_type;
  return as;
}

def _in(s : _aseq, i : s.elt_type)
  return i >= s._low && i <= s._high &&
    (i - s._low) % abs(s._stride):s.elt_type == 0;

// really slow --- REWRITE
def _in(s1: _aseq, s2: _aseq) {
  for i in s2 do
    if !_in(s1, i) then
      return false;
  return true;
}

def fwrite(f : file, s : _aseq) {
  fwrite(f, s._low, "..", s._high);
  if (s._stride != 1) then
    fwrite(f, " by ", s._stride);
}

pragma "inline" def string.substring(s: _aseq)
  if s._stride != 1 then
    return __primitive("string_strided_select", this, s._low, s._high, s._stride);
  else
    return __primitive("string_select", this, s._low, s._high);