long SizeofPFBinarySubvector(
   Subvector *subvector,
   Subgrid   *subgrid)
{
   int ix = SubgridIX(subgrid);
   int iy = SubgridIY(subgrid);
   int iz = SubgridIZ(subgrid);

   int             nx = SubgridNX(subgrid);
   int             ny = SubgridNY(subgrid);
   int             nz = SubgridNZ(subgrid);

   int             nx_v = SubvectorNX(subvector);
   int             ny_v = SubvectorNY(subvector);

   int            i, j, k, ai;

   long size;

   size = 9*amps_SizeofInt;

   ai = 0;
   BoxLoopI1(i,j,k,
	     ix,iy,iz,nx,ny,nz,
	     ai,nx_v,ny_v,nz_v,1,1,1,
	     {
		size += amps_SizeofDouble;
	     });
void        PrintSubvector(
   amps_File   file,
   Subvector  *subvector,
   Subgrid    *subgrid)
{
   int  ix, iy, iz;
   int  nx, ny, nz;
   int  i, j, k;


   ix = SubgridIX(subgrid);
   iy = SubgridIY(subgrid);
   iz = SubgridIZ(subgrid);

   nx = SubgridNX(subgrid);
   ny = SubgridNY(subgrid);
   nz = SubgridNZ(subgrid);

   amps_Fprintf(file, "\t\tPosition(%d,%d,%d), Size (%d,%d,%d)\n",
		ix, iy, iz, nx, ny, nz);

   for(k = iz; k < iz + nz; k++)
      for(j = iy; j < iy + ny; j++)
	 for(i = ix; i < ix + nx; i++)
	    amps_Fprintf(file, "\t\t(%d,%d,%d): %f\n", i, j, k, 
			 *SubvectorElt(subvector, i, j, k));
}
Exemple #3
0
/*--------------------------------------------------------------------------
 * InputPorosity
 *--------------------------------------------------------------------------*/
void    InputPorosity(
                      GeomSolid *  geounit,
                      GrGeomSolid *gr_geounit,
                      Vector *     field)
{
  /*-----------------------------------------------------------------------
   * Local variables
   *-----------------------------------------------------------------------*/
  PFModule      *this_module = ThisPFModule;
  PublicXtra    *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
  InstanceXtra  *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
  double field_value = (public_xtra->field_value);
  Grid           *grid = (instance_xtra->grid);
  Subgrid        *subgrid;
  Subvector      *field_sub;
  double         *fieldp;
  int subgrid_loop;
  int i, j, k;
  int ix, iy, iz;
  int nx, ny, nz;
  int r;
  int index;

  (void)geounit;
  /*-----------------------------------------------------------------------
   * Assign constant values to field
   *-----------------------------------------------------------------------*/
  /* extra variables for reading from file */
  Type3 * dummy3;
  dummy3 = (Type3*)(public_xtra->data);
  Vector *ic_values = dummy3->ic_values;
  Subvector *ic_values_sub;
  double  *ic_values_dat;
  for (subgrid_loop = 0; subgrid_loop < GridNumSubgrids(grid); subgrid_loop++)
  {
    subgrid = GridSubgrid(grid, subgrid_loop);
    field_sub = VectorSubvector(field, subgrid_loop);

    /* new subvector from file */
    ic_values_sub = VectorSubvector(ic_values, subgrid_loop);
    ix = SubgridIX(subgrid);
    iy = SubgridIY(subgrid);
    iz = SubgridIZ(subgrid);
    nx = SubgridNX(subgrid);
    ny = SubgridNY(subgrid);
    nz = SubgridNZ(subgrid);
    /* RDF: assume resolution is the same in all 3 directions */
    r = SubgridRX(subgrid);
    fieldp = SubvectorData(field_sub);
    /* new subvector data to read from */
    ic_values_dat = SubvectorData(ic_values_sub);
    GrGeomInLoop(i, j, k, gr_geounit, r, ix, iy, iz, nx, ny, nz,
    {
      index = SubvectorEltIndex(field_sub, i, j, k);
      /* now assign the value from file to field */
      //                     fieldp[index] = field_value;
      fieldp[index] = ic_values_dat[index];
    });
  }
Exemple #4
0
/*
 * Copy data from a WRF array to a PF vector based on the
 * k-index data for the top of the domain.
 */
void WRF2PF(
            float * wrf_array, /* WRF array */
            int     wrf_depth, /* Depth (Z) of WRF array, X,Y are assumed
                                * to be same as PF vector subgrid */
            int     ghost_size_i_lower, /* Number of ghost cells */
            int     ghost_size_j_lower,
            int     ghost_size_i_upper,
            int     ghost_size_j_upper,
            Vector *pf_vector,
            Vector *top)
{
  Grid       *grid = VectorGrid(pf_vector);
  int sg;

  (void)ghost_size_j_upper;

  ForSubgridI(sg, GridSubgrids(grid))
  {
    Subgrid *subgrid = GridSubgrid(grid, sg);

    int ix = SubgridIX(subgrid);
    int iy = SubgridIY(subgrid);

    int nx = SubgridNX(subgrid);
    int ny = SubgridNY(subgrid);

    int wrf_nx = nx + ghost_size_i_lower + ghost_size_i_upper;

    Subvector *subvector = VectorSubvector(pf_vector, sg);
    double *subvector_data = SubvectorData(subvector);

    Subvector *top_subvector = VectorSubvector(top, sg);
    double    *top_data = SubvectorData(top_subvector);

    int i, j, k;

    for (i = ix; i < ix + nx; i++)
    {
      for (j = iy; j < iy + ny; j++)
      {
        int top_index = SubvectorEltIndex(top_subvector, i, j, 0);

        // SGS What to do if near bottom such that
        // there are not wrf_depth values?
        int iz = (int)top_data[top_index] - (wrf_depth - 1);
        for (k = iz; k < iz + wrf_depth; k++)
        {
          int pf_index = SubvectorEltIndex(subvector, i, j, k);
          int wrf_index = (i - ix + ghost_size_i_lower) +
                          ((wrf_depth - (k - iz) - 1) * wrf_nx) +
                          ((j - iy + ghost_size_j_lower) * (wrf_nx * wrf_depth));
          subvector_data[pf_index] = (double)(wrf_array[wrf_index]);
        }
      }
    }
  }
double   InnerProd(
   Vector  *x,
   Vector  *y)
{
   Grid         *grid = VectorGrid(x);
   Subgrid      *subgrid;
 
   Subvector    *y_sub;
   Subvector    *x_sub;

   double       *yp, *xp;

   double        result = 0.0;

   int           ix,   iy,   iz;
   int           nx,   ny,   nz;
   int           nx_v, ny_v, nz_v;
                 
   int           i_s, i, j, k, iv;

   amps_Invoice  result_invoice;


   result_invoice = amps_NewInvoice("%d", &result);
   
   ForSubgridI(i_s, GridSubgrids(grid))
   {
      subgrid = GridSubgrid(grid, i_s);

      ix = SubgridIX(subgrid);
      iy = SubgridIY(subgrid);
      iz = SubgridIZ(subgrid);

      nx = SubgridNX(subgrid);
      ny = SubgridNY(subgrid);
      nz = SubgridNZ(subgrid);

      y_sub = VectorSubvector(y, i_s);
      x_sub = VectorSubvector(x, i_s);

      nx_v = SubvectorNX(y_sub);
      ny_v = SubvectorNY(y_sub);
      nz_v = SubvectorNZ(y_sub);

      yp = SubvectorElt(y_sub, ix, iy, iz);
      xp = SubvectorElt(x_sub, ix, iy, iz);
 
      iv = 0;
      BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz,
		iv, nx_v, ny_v, nz_v, 1, 1, 1,
		{
		   result += yp[iv] * xp[iv];
		});
void     Axpy(
   double   alpha,
   Vector  *x,
   Vector  *y)
{
   Grid       *grid    = VectorGrid(x);
   Subgrid    *subgrid;
 
   Subvector  *y_sub;
   Subvector  *x_sub;

   double     *yp, *xp;

   int         ix,   iy,   iz;
   int         nx,   ny,   nz;
   int         nx_v, ny_v, nz_v;

   int         i_s, i, j, k, iv;


   ForSubgridI(i_s, GridSubgrids(grid))
   {
      subgrid = GridSubgrid(grid, i_s);
      
      ix = SubgridIX(subgrid);
      iy = SubgridIY(subgrid);
      iz = SubgridIZ(subgrid);
      
      nx = SubgridNX(subgrid);
      ny = SubgridNY(subgrid);
      nz = SubgridNZ(subgrid);
      
      y_sub = VectorSubvector(y, i_s);
      x_sub = VectorSubvector(x, i_s);
      
      nx_v = SubvectorNX(y_sub);
      ny_v = SubvectorNY(y_sub);
      nz_v = SubvectorNZ(y_sub);
      
      yp = SubvectorElt(y_sub, ix, iy, iz);
      xp = SubvectorElt(x_sub, ix, iy, iz);
	 
      iv = 0;
      BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz,
		iv, nx_v, ny_v, nz_v, 1, 1, 1,
		{
		   yp[iv] += alpha * xp[iv];
		});
double       ComputeTotalConcen(
                                GrGeomSolid *gr_domain,
                                Grid *       grid,
                                Vector *     substance)
{
  Subgrid        *subgrid;
  double cell_volume, field_sum;
  double dx, dy, dz;

  Subvector      *s_sub;

  int i, j, k, r, ix, iy, iz, nx, ny, nz, is, ips;
  int            *fdir;
  double         *data;
  amps_Invoice result_invoice;

  field_sum = 0.0;
  ForSubgridI(is, GridSubgrids(grid))
  {
    subgrid = GridSubgrid(grid, is);

    s_sub = VectorSubvector(substance, is);

    ix = SubgridIX(subgrid);
    iy = SubgridIY(subgrid);
    iz = SubgridIZ(subgrid);

    nx = SubgridNX(subgrid);
    ny = SubgridNY(subgrid);
    nz = SubgridNZ(subgrid);

    dx = SubgridDX(subgrid);
    dy = SubgridDY(subgrid);
    dz = SubgridDZ(subgrid);

    /* RDF: assume resolution is the same in all 3 directions */
    r = SubgridRX(subgrid);

    data = SubvectorData(s_sub);

    cell_volume = dx * dy * dz;

    GrGeomSurfLoop(i, j, k, fdir, gr_domain, r, ix, iy, iz, nx, ny, nz,
    {
      ips = SubvectorEltIndex(s_sub, i, j, k);
      data[ips] = 0.0;
    });
Exemple #8
0
void LBInitializeBC(
                    Lattice *    lattice,
                    Problem *    problem,
                    ProblemData *problem_data)
{
  /*------------------------------------------------------------*
  * Local variables
  *------------------------------------------------------------*/

  /* Lattice variables */
  Grid  *grid = (lattice->grid);
  Vector *pressure = (lattice->pressure);
  Vector *perm = (lattice->perm);
  CharVector *cellType = (lattice->cellType);
  double time = (lattice->t);

  /* Structures */
  BCPressureData *bc_pressure_data = ProblemDataBCPressureData(problem_data);
  TimeCycleData   *time_cycle_data;
  SubgridArray   *subgrids = GridSubgrids(grid);
  GrGeomSolid    *gr_domain;

  /* Patch variables */
  double       ***values;
  double         *patch_values = NULL;
  int            *fdir;

  /* Grid parameters */
  Subgrid   *subgrid;
  int nx, ny, nz;
  int ix, iy, iz;
  int nx_v, ny_v, nz_v;

  /* Indices and counters */
  int num_patches;
  int num_phases;
  int ipatch, is, i, j, k, ival;
  int cycle_number, interval_number;
  int r;

  /* Physical variables and coefficients */
  Subvector *sub_p;
  double    *pp;
  Subvector *sub_perm;
  double    *permp;
  Subcharvector *sub_cellType;
  char      *cellTypep;
  double rho_g;

  /* Communications */
  VectorUpdateCommHandle *handle;

  /*--------------------------
   *  Initializations
   *--------------------------*/
  rho_g = ProblemGravity(problem) * RHO;
  num_patches = BCPressureDataNumPatches(bc_pressure_data);
  gr_domain = ProblemDataGrDomain(problem_data);
  num_phases = BCPressureDataNumPhases(bc_pressure_data);
  if (num_patches > 0)
  {
    time_cycle_data = BCPressureDataTimeCycleData(bc_pressure_data);
    values = ctalloc(double **, num_patches);

    for (ipatch = 0; ipatch < num_patches; ipatch++)
    {
      values[ipatch] = ctalloc(double *, SubgridArraySize(subgrids));

      cycle_number = BCPressureDataCycleNumber(bc_pressure_data, ipatch);
      interval_number = TimeCycleDataComputeIntervalNumber(problem, time,
                                                           time_cycle_data, cycle_number);

      switch (BCPressureDataType(bc_pressure_data, ipatch))
      {
        case 0:
        {
          BCPressureType0 *bc_pressure_type0;

          GeomSolid       *ref_solid;

          double z, dz2;
          double         **elevations;
          int ref_patch, iel;

          bc_pressure_type0 = (BCPressureType0*)BCPressureDataIntervalValue(
                                                                            bc_pressure_data, ipatch, interval_number);
          ref_solid = ProblemDataSolid(problem_data,
                                       BCPressureType0RefSolid(bc_pressure_type0));
          ref_patch = BCPressureType0RefPatch(bc_pressure_type0);

          /* Calculate elevations at (x,y) points on reference patch. */
          elevations = CalcElevations(ref_solid, ref_patch, subgrids, problem_data);

          ForSubgridI(is, subgrids)
          {
            /* subgrid = GridSubgrid(grid, is); */
            subgrid = SubgridArraySubgrid(subgrids, is);
            sub_p = VectorSubvector(pressure, is);
            sub_perm = VectorSubvector(perm, is);
            sub_cellType = CharVectorSubcharvector(cellType, is);

            nx = SubgridNX(subgrid);
            ny = SubgridNY(subgrid);
            nz = SubgridNZ(subgrid);

            ix = SubgridIX(subgrid);
            iy = SubgridIY(subgrid);
            iz = SubgridIZ(subgrid);

            /* RDF: assume resolution is the same in all 3 directions */
            r = SubgridRX(subgrid);

            pp = SubvectorData(sub_p);
            permp = SubvectorData(sub_perm);
            cellTypep = SubcharvectorData(sub_cellType);

            nx_v = SubvectorNX(sub_p);
            ny_v = SubvectorNY(sub_p);
            nz_v = SubvectorNZ(sub_p);

            values[ipatch][is] = patch_values;

            dz2 = RealSpaceDZ(0) / 2.0;

            GrGeomPatchLoop(i, j, k, fdir, gr_domain, ipatch,
                            r, ix, iy, iz, nx, ny, nz,
            {
              ival = SubvectorEltIndex(sub_p, i, j, k);
              iel = (i - ix) + (j - iy) * nx;
              z = RealSpaceZ(k, 0) + fdir[2] * dz2;

              pp[ival] = BCPressureType0Value(bc_pressure_type0)
                         - rho_g * (z - elevations[is][iel]);

              cellTypep[ival] = 0;
            });

            tfree(elevations[is]);
          }       /* End subgrid loop */

          tfree(elevations);
          break;
        }

        case 1:
        {
          BCPressureType1 *bc_pressure_type1;
          int num_points;
          double x, y, z, dx2, dy2, dz2;
          double unitx, unity, line_min, line_length, xy, slope;
          int ip;

          bc_pressure_type1 = (BCPressureType1*)BCPressureDataIntervalValue(bc_pressure_data, ipatch, interval_number);

          ForSubgridI(is, subgrids)
          {
            /* subgrid = GridSubgrid(grid, is); */
            subgrid = SubgridArraySubgrid(subgrids, is);
            sub_p = VectorSubvector(pressure, is);
            sub_perm = VectorSubvector(perm, is);
            sub_cellType = CharVectorSubcharvector(cellType, is);

            nx = SubgridNX(subgrid);
            ny = SubgridNY(subgrid);
            nz = SubgridNZ(subgrid);

            ix = SubgridIX(subgrid);
            iy = SubgridIY(subgrid);
            iz = SubgridIZ(subgrid);

            /* RDF: assume resolution is the same in all 3 directions */
            r = SubgridRX(subgrid);

            pp = SubvectorData(sub_p);
            permp = SubvectorData(sub_perm);
            cellTypep = SubcharvectorData(sub_cellType);

            nx_v = SubvectorNX(sub_p);
            ny_v = SubvectorNY(sub_p);
            nz_v = SubvectorNZ(sub_p);

            values[ipatch][is] = patch_values;

            dx2 = RealSpaceDX(0) / 2.0;
            dy2 = RealSpaceDY(0) / 2.0;
            dz2 = RealSpaceDZ(0) / 2.0;

            /* compute unit direction vector for piecewise linear line */
            unitx = BCPressureType1XUpper(bc_pressure_type1) - BCPressureType1XLower(bc_pressure_type1);
            unity = BCPressureType1YUpper(bc_pressure_type1) - BCPressureType1YLower(bc_pressure_type1);
            line_length = sqrt(unitx * unitx + unity * unity);
            unitx /= line_length;
            unity /= line_length;
            line_min = BCPressureType1XLower(bc_pressure_type1) * unitx
                       + BCPressureType1YLower(bc_pressure_type1) * unity;

            GrGeomPatchLoop(i, j, k, fdir, gr_domain, ipatch,
                            r, ix, iy, iz, nx, ny, nz,
            {
              ival = SubvectorEltIndex(sub_p, i, j, k);

              x = RealSpaceX(i, 0) + fdir[0] * dx2;
              y = RealSpaceY(j, 0) + fdir[1] * dy2;
              z = RealSpaceZ(k, 0) + fdir[2] * dz2;

              /* project center of BC face onto piecewise line */
              xy = (x * unitx + y * unity - line_min) / line_length;

              /* find two neighboring points */
              ip = 1;
              /* Kludge; this needs to be fixed. */
              num_points = 2;
              for (; ip < (num_points - 1); ip++)
              {
                if (xy < BCPressureType1Point(bc_pressure_type1, ip))
                  break;
              }

              /* compute the slope */
              slope = ((BCPressureType1Value(bc_pressure_type1, ip) - BCPressureType1Value(bc_pressure_type1, (ip - 1)))
                       / (BCPressureType1Point(bc_pressure_type1, ip) - BCPressureType1Point(bc_pressure_type1, (ip - 1))));

              pp[ival] = BCPressureType1Value(bc_pressure_type1, ip - 1)
                         + slope * (xy - BCPressureType1Point(
                                                              bc_pressure_type1, ip - 1))
                         - rho_g * z;

              cellTypep[ival] = 0;
            });
          }      /* End subgrid loop */
void    PhaseDensity(
   int     phase,           /* Phase */
   Vector *phase_pressure,  /* Vector of phase pressures at each block */
   Vector *density_v,       /* Vector of return densities at each block */
   double *pressure_d,      /* Double array of pressures */
   double *density_d,       /* Double array return density */
   int     fcn)             /* Flag determining what to calculate 
			     * fcn = CALCFCN => calculate the function value
			     * fcn = CALCDER => calculate the function 
			     *                  derivative */
   
/*  Module returns either a double array or Vector of densities.
 *  If density_v is NULL, then a double array is returned. 
 *  This "overloading" was provided so that the density module written
 *  for the Richards' solver modules would be backward compatible with
 *  the Impes modules.
 */
{
   PFModule      *this_module   = ThisPFModule;
   PublicXtra    *public_xtra   = (PublicXtra *)PFModulePublicXtra(this_module);

   Type0         *dummy0;
   Type1         *dummy1;

   Grid          *grid;

   Subvector     *p_sub;
   Subvector     *d_sub;

   double        *pp; 
   double        *dp; 

   Subgrid       *subgrid;

   int            sg;

   int            ix,   iy,   iz;
   int            nx,   ny,   nz;
   int            nx_p, ny_p, nz_p;
   int            nx_d, ny_d, nz_d;

   int            i, j, k, ip, id;


   switch((public_xtra -> type[phase]))
   {

   case 0:
   {
      double  constant;
      dummy0 = (Type0 *)(public_xtra -> data[phase]);
      constant = (dummy0 -> constant);

      if ( density_v != NULL)
      {
         grid = VectorGrid(density_v);
	 ForSubgridI(sg, GridSubgrids(grid))
	 {
	    subgrid = GridSubgrid(grid, sg);

	    d_sub = VectorSubvector(density_v,  sg);

	    ix = SubgridIX(subgrid) - 1;
	    iy = SubgridIY(subgrid) - 1;
	    iz = SubgridIZ(subgrid) - 1;

	    nx = SubgridNX(subgrid) + 2;
	    ny = SubgridNY(subgrid) + 2;
	    nz = SubgridNZ(subgrid) + 2;

	    nx_d = SubvectorNX(d_sub);
	    ny_d = SubvectorNY(d_sub);
	    nz_d = SubvectorNZ(d_sub);

	    dp = SubvectorElt(d_sub, ix, iy, iz);

	    id = 0;
	    if ( fcn == CALCFCN )
	    {
	       BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz,
			 id, nx_d, ny_d, nz_d, 1, 1, 1,
			 {
			    dp[id] = constant;
			 });
	    }
void    PermeabilityFace(
   Vector *zperm,
   Vector *permeability)
{
   PFModule      *this_module      = ThisPFModule;
   InstanceXtra  *instance_xtra    = (InstanceXtra  *)PFModuleInstanceXtra(this_module);
   PublicXtra   *public_xtra       = (PublicXtra   *)PFModulePublicXtra(this_module);

   Grid         *z_grid   = (instance_xtra -> z_grid);

   VectorUpdateCommHandle   *handle;

   SubgridArray *subgrids;
   Subgrid      *subgrid;

   Subvector    *subvector_pc, *subvector_pf;

   int           ix, iy, iz;
   int           nx, ny, nz;
   double        dx, dy, dz;

   int           nx_pc, ny_pc, nz_pc;
   int           nx_pf, ny_pf, nz_pf;

   int           pci, pfi;

   int           sg, i, j, k;
   int           flopest;

   double       *pf,  *pc_l, *pc_u;

   /*-----------------------------------------------------------------------
    * Begin timing
    *-----------------------------------------------------------------------*/

    BeginTiming(public_xtra -> time_index);

   /*-----------------------------------------------------------------------
    * exchange boundary data for cell permeability values
    *-----------------------------------------------------------------------*/
   handle = InitVectorUpdate(permeability, VectorUpdateAll);
   FinalizeVectorUpdate(handle);

   /*-----------------------------------------------------------------------
    * compute the z-face permeabilities for each subgrid
    *-----------------------------------------------------------------------*/

   subgrids = GridSubgrids(z_grid);
   ForSubgridI(sg, subgrids)
   {
      subgrid = SubgridArraySubgrid(subgrids, sg);

      subvector_pc    = VectorSubvector(permeability, sg);
      subvector_pf    = VectorSubvector(zperm, sg);

      ix = SubgridIX(subgrid);
      iy = SubgridIY(subgrid);
      iz = SubgridIZ(subgrid);

      nx = SubgridNX(subgrid);
      ny = SubgridNY(subgrid);
      nz = SubgridNZ(subgrid);

      dx = SubgridDX(subgrid);
      dy = SubgridDY(subgrid);
      dz = SubgridDZ(subgrid);

      nx_pc = SubvectorNX(subvector_pc);
      ny_pc = SubvectorNY(subvector_pc);
      nz_pc = SubvectorNZ(subvector_pc);

      nx_pf = SubvectorNX(subvector_pf);
      ny_pf = SubvectorNY(subvector_pf);
      nz_pf = SubvectorNZ(subvector_pf);

      flopest = nx_pf * ny_pf * nz_pf;

      pc_l = SubvectorElt(subvector_pc, ix  ,iy  ,iz-1);
      pc_u = SubvectorElt(subvector_pc, ix  ,iy  ,iz  );

      pf = SubvectorElt(subvector_pf, ix  ,iy  ,iz);

      pci = 0; pfi = 0;

      BoxLoopI2(i,j,k,
                ix,iy,iz,nx,ny,nz,
                pci,nx_pc,ny_pc,nz_pc,1,1,1,
                pfi,nx_pf,ny_pf,nz_pf,1,1,1,
      {
         pf[pfi] = Mean( pc_l[pci], pc_u[pci] );
      });
void         ICPhaseSatur(
Vector      *ic_phase_satur,
int          phase,
ProblemData *problem_data)
{
   PFModule      *this_module   = ThisPFModule;
   PublicXtra    *public_xtra   = (PublicXtra *)PFModulePublicXtra(this_module);

   Grid          *grid = VectorGrid(ic_phase_satur);

   Type0          *dummy0;

   SubgridArray   *subgrids = GridSubgrids(grid);

   Subgrid        *subgrid;
   Subvector      *ps_sub;

   double         *data;

   int             ix, iy, iz;
   int             nx, ny, nz;
   int             r;

   double          field_sum;

   int             is, i, j, k, ips;


   /*-----------------------------------------------------------------------
    * Initial saturation conditions for this phase
    *-----------------------------------------------------------------------*/

   InitVector(ic_phase_satur, 0.0);

   switch((public_xtra -> type[phase]))
   {
   case 0:
   {
      int      num_regions;
      int     *region_indices;
      double  *values;

      GrGeomSolid  *gr_solid;
      double        value;
      int           ir;


      dummy0 = (Type0 *)(public_xtra -> data[phase]);

      num_regions    = (dummy0 -> num_regions);
      region_indices = (dummy0 -> region_indices);
      values         = (dummy0 -> values);

      for (ir = 0; ir < num_regions; ir++)
      {
	 gr_solid = ProblemDataGrSolid(problem_data, region_indices[ir]);
	 value    = values[ir];

	 ForSubgridI(is, subgrids)
	 {
            subgrid = SubgridArraySubgrid(subgrids, is);
            ps_sub  = VectorSubvector(ic_phase_satur, is);
	    
	    ix = SubgridIX(subgrid);
	    iy = SubgridIY(subgrid);
	    iz = SubgridIZ(subgrid);
	    
	    nx = SubgridNX(subgrid);
	    ny = SubgridNY(subgrid);
	    nz = SubgridNZ(subgrid);
	    
	    /* RDF: assume resolution is the same in all 3 directions */
	    r = SubgridRX(subgrid);
	    
	    data = SubvectorData(ps_sub);
	    GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz,
            {
	       ips = SubvectorEltIndex(ps_sub, i, j, k);

	       data[ips] = value;
	    });
	 }
      }

      break;
   }
void ComputeDomain(
		   SubgridArray  *all_subgrids,
		   Databox  *top, 
		   Databox  *bottom, 
		   int P, 
		   int Q, 
		   int R)
{
   int num_procs = P * Q * R;
   int p;

   // For each subgrid find the min/max k values 
   // in the active region (using top/bottom).  
   // Reset the subgrid to reflect this vertical extent.
   for(p = 0; p < num_procs; p++)
   {
      int s_i;
      ForSubgridI(s_i, all_subgrids)
      {
	 Subgrid* subgrid = SubgridArraySubgrid(all_subgrids, s_i);

	 int process = SubgridProcess(subgrid);

	 if(process == p) {
	    int i;
	    int j;

	    int ix = SubgridIX(subgrid);
	    int iy = SubgridIY(subgrid);
	    int iz = SubgridIZ(subgrid);
	    
	    int nx = SubgridNX(subgrid);
	    int ny = SubgridNY(subgrid);
	    int nz = SubgridNZ(subgrid);

	    int patch_top = iz;
	    int patch_bottom = iz + nz;
 
	    for (j = iy; j < iy+ ny; ++j)
	    {
	       for (i = ix; i < ix + nx; ++i)
	       {
		  int k_top = *(DataboxCoeff(top, i, j, 0));
		  if ( k_top >= 0 ) {
		     patch_top = max(patch_top, k_top);
		  }

		  int k_bottom = *(DataboxCoeff(bottom, i, j, 0));
		  if ( k_bottom >= 0 ) {
		     patch_bottom = min(patch_bottom, k_bottom);
		  }
	       }
	    }

	    // adjust grid to include 2 pad cells
	    patch_top = min(patch_top+2, iz + nz - 1);
	    patch_bottom = max(patch_bottom-2, iz);

	    // adjust for ghost cells, need to have patches 
	    // that extend in height to the neighbor patches.
	    // 
	    // There is a more efficient way to compute all this but
	    // since these are 2d arrays it should be reasonably quick.
	    // Not a single loop since we don't need to pad these values.
	    ix = max(0, ix -1);
	    nx = min(DataboxNx(top) - ix, nx + 2 - ix);

	    iy = max(0, iy -1);
	    ny = min(DataboxNy(top) - iy, ny + 2 - iy);

	    for (j = iy; j < iy+ ny; ++j)
	    {
	       for (i = ix; i < ix + nx; ++i)
	       {
		  int k_top = *(DataboxCoeff(top, i, j, 0));
		  if ( k_top >= 0 ) {
		     patch_top = max(patch_top, k_top);
		  }

		  int k_bottom = *(DataboxCoeff(bottom, i, j, 0));
		  if ( k_bottom >= 0 ) {
		     patch_bottom = min(patch_bottom, k_bottom);
		  }
	       }
	    }

	    SubgridIZ(subgrid) = patch_bottom;
	    SubgridNZ(subgrid) = (patch_top - SubgridIZ(subgrid)) + 1;
	 }
      }
   }
void OverlandSum(ProblemData *problem_data, 
		 Vector      *pressure,       /* Current pressure values */
		 double dt, 
		 Vector *overland_sum)
{
   GrGeomSolid *gr_domain         = ProblemDataGrDomain(problem_data);

   double       dx, dy, dz;
   int          i, j, r, is;
   int          ix, iy, iz;
   int          nx, ny;

   Subgrid     *subgrid;
   Grid        *grid              = VectorGrid(pressure);

   Vector      *slope_x           = ProblemDataTSlopeX(problem_data); 
   Vector      *slope_y           = ProblemDataTSlopeY(problem_data);
   Vector      *mannings          = ProblemDataMannings(problem_data);
   Vector      *top               = ProblemDataIndexOfDomainTop(problem_data);

   Subvector   *overland_sum_subvector;
   Subvector   *slope_x_subvector;
   Subvector   *slope_y_subvector;
   Subvector   *mannings_subvector;
   Subvector   *pressure_subvector;
   Subvector   *top_subvector;
   
   int index_overland_sum;
   int index_slope_x;
   int index_slope_y;
   int index_mannings;
   int index_pressure;
   int index_top;

   double *overland_sum_ptr;
   double *slope_x_ptr;
   double *slope_y_ptr;
   double *mannings_ptr;
   double *pressure_ptr;
   double *top_ptr;

   int ipatch;
   
   BCStruct    *bc_struct;

   BCPressureData *bc_pressure_data = ProblemDataBCPressureData(problem_data);
   int num_patches                  = BCPressureDataNumPatches(bc_pressure_data);

   bc_struct = NewBCStruct(GridSubgrids(grid), 
			   gr_domain,
			   num_patches,
			   BCPressureDataPatchIndexes(bc_pressure_data),
			   BCPressureDataBCTypes(bc_pressure_data),
			   NULL);

   if (num_patches > 0)
   {
      for (ipatch = 0; ipatch < num_patches; ipatch++)
      {
	 switch(BCPressureDataType(bc_pressure_data,ipatch))
         {
	    case 7:
	    {

	       ForSubgridI(is, GridSubgrids(grid))
	       {
	       
		  subgrid = GridSubgrid(grid, is);
		  
		  overland_sum_subvector = VectorSubvector(overland_sum, is);
		  slope_x_subvector      = VectorSubvector(slope_x, is);
		  slope_y_subvector      = VectorSubvector(slope_y, is);
		  mannings_subvector     = VectorSubvector(mannings, is);
		  pressure_subvector     = VectorSubvector(pressure, is);
		  top_subvector          = VectorSubvector(top, is);
		  
		  r = SubgridRX(subgrid);
		  
		  ix = SubgridIX(subgrid);
		  iy = SubgridIY(subgrid);
		  iz = SubgridIZ(subgrid);

		  nx = SubgridNX(subgrid);
		  ny = SubgridNY(subgrid);

		  dx = SubgridDX(subgrid);
		  dy = SubgridDY(subgrid);
		  dz = SubgridDZ(subgrid);
		  
		  overland_sum_ptr = SubvectorData(overland_sum_subvector);
		  slope_x_ptr      = SubvectorData(slope_x_subvector);
		  slope_y_ptr      = SubvectorData(slope_y_subvector);
		  mannings_ptr     = SubvectorData(mannings_subvector);
		  pressure_ptr     = SubvectorData(pressure_subvector);
		  top_ptr          = SubvectorData(top_subvector);

		  int state;
		  const int inactive = -1;
		  const int active = 1;

		  for(i = ix; i < ix + nx; i++) 
		  {
		     j = iy - 1;

		     index_top = SubvectorEltIndex(top_subvector, i, j, 0);
		     int k = (int)top_ptr[index_top];

		     if( k < 0 ) {
			state = inactive;
		     } else {
			state = active;
		     }

		     while( j < iy + ny) {
			
			if( state == inactive) {
			   index_top = SubvectorEltIndex(top_subvector, i, j, 0);
			   k = (int)top_ptr[index_top];
			   while( k < 0 && j <= iy + ny) {
			      j++;
			      index_top = SubvectorEltIndex(top_subvector, i, j, 0);
			      k = (int)top_ptr[index_top];
			   }

			   // If still in interior
			   if( j < iy + ny) {

			      if ( k >=0 ) {
				 
				 // inactive to active
				 
				 index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);
				 
				 // sloping to inactive active from active
				 if( slope_y_ptr[index_slope_y] > 0) {
				    index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);
				    
				    if(pressure_ptr[index_pressure] > 0) 
				    {
				       index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
				       index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
				       
				       overland_sum_ptr[index_overland_sum] += 
					  (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) *
					  pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt;
				    }
				 }
			      }

			      state = active;
			   }

			} else {
			   index_top = SubvectorEltIndex(top_subvector, i, j+1, 0);
			   k = (int)top_ptr[index_top];
			   while( k >= 0 && j <= iy + ny) {
			      j++;
			      index_top = SubvectorEltIndex(top_subvector, i, j+1, 0);
			      k = (int)top_ptr[index_top];
			   }

			   // If still in interior
			   if( j < iy + ny) {

			      index_top     = SubvectorEltIndex(top_subvector, i, j, 0);
			      k = (int)top_ptr[index_top];

			      // active to inactive

			      
			      index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);

			      // sloping from active to inactive
			      if( slope_y_ptr[index_slope_y] < 0) {
				 index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

				 if(pressure_ptr[index_pressure] > 0) 
				 {
				    index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
				    index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
				    
				    overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) *
				       pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt;
				 }
			      }
			   }

			   state = inactive;
			}
			j++;
		     }
		  }

#if 0
		  for(i = ix; i < ix + nx; i++) 
		  {
		     for(j = iy; j < iy + ny; j++) 
		     {
			index_top             = SubvectorEltIndex(top_subvector, i, j, 0);

			int k = (int)top_ptr[index_top];
			if ( !(k < 0)) 
			{
			   /*
			     Compute runnoff if slope is running off of active region
			   */
			   index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
			   index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);
			   index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);
			   index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
			   index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

			   if( slope_y_ptr[index_slope_y] > 0 ) 
			   {
			      if(pressure_ptr[index_pressure] > 0) 
			      {
				 overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) *
				    pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt;
			      }
			   }
			   
			   /*
			     Loop until going back outside of active area 
			   */
			   while( (j + 1 < iy + ny) && !(top_ptr[SubvectorEltIndex(top_subvector, i, j+1, 0)] < 0) ) 
			   {
			      j++;
			   }
			   
			   /* 
			      Found either domain boundary or outside of active area.
			      Compute runnoff if slope is running off of active region.
			   */

			   index_top             = SubvectorEltIndex(top_subvector, i, j, 0);
			   k = (int)top_ptr[index_top];
			   index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
			   index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);
			   index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);
			   index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
			   index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

			   if( slope_y_ptr[index_slope_y] < 0 ) 
			   {
			      if(pressure_ptr[index_pressure] > 0) 
			      {

				 overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) *
				    pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt;
			      }
			   }
			}
		     }
		  }
#endif


		  for(j = iy; j < iy + ny; j++) 
		  {
		     i = ix - 1;

		     index_top = SubvectorEltIndex(top_subvector, i, j, 0);
		     int k = (int)top_ptr[index_top];

		     if( k < 0 ) {
			state = inactive;
		     } else {
			state = active;
		     }

		     while( i < ix + nx) {
			
			if( state == inactive) {
			   index_top = SubvectorEltIndex(top_subvector, i, j, 0);
			   k = (int)top_ptr[index_top];
			   while( k < 0 && i <= ix + nx) {
			      i++;
			      index_top = SubvectorEltIndex(top_subvector, i, j, 0);
			      k = (int)top_ptr[index_top];
			   }

			   // If still in interior
			   if( i < ix + nx) {

			      if ( k >=0 ) {
				 
				 // inactive to active
				 
				 index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);
				 
				 // sloping to inactive active from active
				 if( slope_x_ptr[index_slope_x] > 0) {
				    index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);
				    
				    if(pressure_ptr[index_pressure] > 0) 
				    {
				       index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
				       index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
				       
				       overland_sum_ptr[index_overland_sum] += 
					  (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) *
					  pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt;
				    }
				 }
			      }

			      state = active;
			   }

			} else {
			   index_top = SubvectorEltIndex(top_subvector, i+1, j, 0);
			   k = (int)top_ptr[index_top];
			   while( k >= 0 && i <= ix + nx) {
			      i++;
			      index_top = SubvectorEltIndex(top_subvector, i+1, j, 0);
			      k = (int)top_ptr[index_top];
			   }

			   // If still in interior
			   if( i < ix + nx) {

			      index_top     = SubvectorEltIndex(top_subvector, i, j, 0);
			      k = (int)top_ptr[index_top];

			      // active to inactive
			      index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);

			      // sloping from active to inactive
			      if( slope_x_ptr[index_slope_x] < 0) {
				 index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

				 if(pressure_ptr[index_pressure] > 0) 
				 {
				    index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
				    index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
				    
				    overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) *
				       pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt;
				 }
			      }
			   }

			   state = inactive;
			}
			i++;
		     }
		  }

#if 0

		  for(j = iy; j < iy + ny; j++) 
		  {
		     for(i = ix; i < ix + nx; i++) 
		     {
			
			index_top             = SubvectorEltIndex(top_subvector, i, j, 0);

			int k = (int)top_ptr[index_top];
			if ( !(k < 0)) 
			{

			   /*
			     Compute runnoff if slope is running off of active region
			   */
			   index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
			   index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);
			   index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);
			   index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
			   index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

			   if( slope_x_ptr[index_slope_x] > 0 ) 
			   {
			      if(pressure_ptr[index_pressure] > 0) 
			      {
				 overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_x_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) *
				    pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt;
			      }
			   }
			   
			   /*
			     Loop until going back outside of active area 
			   */
			   while( (i + 1 < ix + nx) && !(top_ptr[SubvectorEltIndex(top_subvector, i+1, j, 0)] < 0) ) 
			   {
			      i++;
			   }
			   
			   /* 
			      Found either domain boundary or outside of active area.
			      Compute runnoff if slope is running off of active region.
			   */
			   index_top             = SubvectorEltIndex(top_subvector, i, j, 0);
			   k = (int)top_ptr[index_top];
			   index_overland_sum    = SubvectorEltIndex(overland_sum_subvector,  i, j, 0);
			   index_slope_x         = SubvectorEltIndex(slope_x_subvector, i, j, 0);
			   index_slope_y         = SubvectorEltIndex(slope_y_subvector, i, j, 0);
			   index_mannings        = SubvectorEltIndex(mannings_subvector, i, j, 0);
			   index_pressure        = SubvectorEltIndex(pressure_subvector, i, j, k);

			   if( slope_x_ptr[index_slope_x] < 0 ) 
			   {
			      if(pressure_ptr[index_pressure] > 0) 
			      {
				 overland_sum_ptr[index_overland_sum] += 
				    (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) *
				    pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt;
			      }
			   }
			}
		     }
		  }
#endif


	       }
	    }
	 }
      }
   }
Exemple #14
0
void ComputeTop(Problem *    problem,      /* General problem information */
                ProblemData *problem_data  /* Contains geometry information for the problem */
                )
{
  GrGeomSolid   *gr_solid = ProblemDataGrDomain(problem_data);
  Vector        *top = ProblemDataIndexOfDomainTop(problem_data);
  Vector        *perm_x = ProblemDataPermeabilityX(problem_data);

  Grid          *grid2d = VectorGrid(top);
  SubgridArray  *grid2d_subgrids = GridSubgrids(grid2d);

  /* use perm grid as top is 2D and want to loop over Z */
  Grid          *grid3d = VectorGrid(perm_x);
  SubgridArray  *grid3d_subgrids = GridSubgrids(grid3d);


  double *top_data;
  int index;

  VectorUpdateCommHandle   *handle;

  (void)problem;

  InitVectorAll(top, -1);
//   PFVConstInit(-1, top);

  int is;
  ForSubgridI(is, grid3d_subgrids)
  {
    Subgrid       *grid2d_subgrid = SubgridArraySubgrid(grid2d_subgrids, is);
    Subgrid       *grid3d_subgrid = SubgridArraySubgrid(grid3d_subgrids, is);

    Subvector     *top_subvector = VectorSubvector(top, is);

    int grid3d_ix = SubgridIX(grid3d_subgrid);
    int grid3d_iy = SubgridIY(grid3d_subgrid);
    int grid3d_iz = SubgridIZ(grid3d_subgrid);

    int grid2d_iz = SubgridIZ(grid2d_subgrid);

    int grid3d_nx = SubgridNX(grid3d_subgrid);
    int grid3d_ny = SubgridNY(grid3d_subgrid);
    int grid3d_nz = SubgridNZ(grid3d_subgrid);

    int grid3d_r = SubgridRX(grid3d_subgrid);

    top_data = SubvectorData(top_subvector);

    int i, j, k;
    GrGeomInLoop(i, j, k,
                 gr_solid, grid3d_r,
                 grid3d_ix, grid3d_iy, grid3d_iz,
                 grid3d_nx, grid3d_ny, grid3d_nz,
    {
      index = SubvectorEltIndex(top_subvector, i, j, grid2d_iz);

      if (top_data[index] < k)
      {
        top_data[index] = k;
      }
    });
Exemple #15
0
void         PFMG(
                  Vector *soln,
                  Vector *rhs,
                  double  tol,
                  int     zero)
{
  (void)zero;

#ifdef HAVE_HYPRE
  PFModule           *this_module = ThisPFModule;
  InstanceXtra       *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
  PublicXtra         *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);

  HYPRE_StructMatrix hypre_mat = instance_xtra->hypre_mat;
  HYPRE_StructVector hypre_b = instance_xtra->hypre_b;
  HYPRE_StructVector hypre_x = instance_xtra->hypre_x;

  HYPRE_StructSolver hypre_pfmg_data = instance_xtra->hypre_pfmg_data;

  Grid               *grid = VectorGrid(rhs);
  Subgrid            *subgrid;
  int sg;

  Subvector          *rhs_sub;
  Subvector          *soln_sub;

  double             *rhs_ptr;
  double             *soln_ptr;
  double value;

  int index[3];

  int ix, iy, iz;
  int nx, ny, nz;
  int nx_v, ny_v, nz_v;
  int i, j, k;
  int iv;

  int num_iterations;
  double rel_norm;

  /* Copy rhs to hypre_b vector. */
  BeginTiming(public_xtra->time_index_copy_hypre);

  ForSubgridI(sg, GridSubgrids(grid))
  {
    subgrid = SubgridArraySubgrid(GridSubgrids(grid), sg);
    rhs_sub = VectorSubvector(rhs, sg);

    rhs_ptr = SubvectorData(rhs_sub);

    ix = SubgridIX(subgrid);
    iy = SubgridIY(subgrid);
    iz = SubgridIZ(subgrid);

    nx = SubgridNX(subgrid);
    ny = SubgridNY(subgrid);
    nz = SubgridNZ(subgrid);

    nx_v = SubvectorNX(rhs_sub);
    ny_v = SubvectorNY(rhs_sub);
    nz_v = SubvectorNZ(rhs_sub);

    iv = SubvectorEltIndex(rhs_sub, ix, iy, iz);

    BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz,
              iv, nx_v, ny_v, nz_v, 1, 1, 1,
    {
      index[0] = i;
      index[1] = j;
      index[2] = k;

      HYPRE_StructVectorSetValues(hypre_b, index, rhs_ptr[iv]);
    });
Exemple #16
0
void         PGSRF(
                   GeomSolid *  geounit,
                   GrGeomSolid *gr_geounit,
                   Vector *     field,
                   RFCondData * cdata)
{
  /*-----------------*
  * Local variables *
  *-----------------*/
  PFModule      *this_module = ThisPFModule;
  PublicXtra    *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
  InstanceXtra  *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);

  /* Input parameters (see PGSRFNewPublicXtra() below) */
  double lambdaX = (public_xtra->lambdaX);
  double lambdaY = (public_xtra->lambdaY);
  double lambdaZ = (public_xtra->lambdaZ);
  double mean = (public_xtra->mean);
  double sigma = (public_xtra->sigma);
  int dist_type = (public_xtra->dist_type);
  double low_cutoff = (public_xtra->low_cutoff);
  double high_cutoff = (public_xtra->high_cutoff);
  int max_search_rad = (public_xtra->max_search_rad);
  int max_npts = (public_xtra->max_npts);
  int max_cpts = (public_xtra->max_cpts);
  Vector    *tmpRF = NULL;

  /* Conditioning data */
  int nc = (cdata->nc);
  double    *x = (cdata->x);
  double    *y = (cdata->y);
  double    *z = (cdata->z);
  double    *v = (cdata->v);

  /* Grid parameters */
  Grid      *grid = (instance_xtra->grid);
  Subgrid   *subgrid;
  Subvector *sub_field;
  Subvector *sub_tmpRF;
  int NX, NY, NZ;

  /* Subgrid parameters */
  int nx, ny, nz;
  double dx, dy, dz;
  int nx_v, ny_v, nz_v;
  int nx_v2, ny_v2, nz_v2;
  int nxG, nyG, nzG;

  /* Counters, indices, flags */
  int gridloop;
  int i, j, k, n, m;
  int ii, jj, kk;
  int i2, j2, k2;
  int imin, jmin, kmin;
  int rpx, rpy, rpz;
  int npts;
  int index1, index2, index3;

  /* Spatial variables */
  double    *fieldp;
  double    *tmpRFp;
  int iLx, iLy, iLz;            /* Correlation length in terms of grid points */
  int iLxp1, iLyp1, iLzp1;      /* One more than each of the above */
  int nLx, nLy, nLz;            /* Size of correlation neighborhood in grid pts. */
  int iLxyz;                    /* iLxyz = iLx*iLy*iLz */
  int nLxyz;                    /* nLxyz = nLx*nLy*nLz */
  int ix, iy, iz;
  int ref;
  int ix2, iy2, iz2;
  int i_search, j_search, k_search;
  int ci_search, cj_search, ck_search;
  double X0, Y0, Z0;

  /* Variables used in kriging  algorithm */
  double cmean, csigma;         /* Conditional mean and std. dev. from kriging */
  double A;
  double    *A_sub;             /* Sub-covariance matrix for external cond pts */
  double    *A11;               /* Submatrix; note that A11 is 1-dim */
  double    **A12, **A21, **A22;/* Submatrices for external conditioning data */
  double    **M;                /* Used as a temporary matrix */
  double    *b;                 /* Covariance vector for conditioning points */
  double    *b_tmp, *b2;
  double    *w, *w_tmp;         /* Solution vector to Aw=b */
  int       *ixx, *iyy, *izz;
  double    *value;
  int di, dj, dk;
  double uni, gau;
  double    ***cov;
  int ierr;

  /* Conditioning data variables */
  int cpts;                     /* N cond pts for a single simulated node */
  double    *cval;              /* Values for cond data for single node */

  /* Communications */
  VectorUpdateCommHandle *handle;
  int update_mode;

  /* Miscellaneous variables */
  int       **rand_path;
  char      ***marker;
  int p, r, modulus;
  double a1, a2, a3;
  double cx, cy, cz;
  double sum;

  // FIXME Shouldn't we get this from numeric_limits?
  double Tiny = 1.0e-12;

  (void)geounit;

  /*-----------------------------------------------------------------------
   * Allocate temp vectors
   *-----------------------------------------------------------------------*/
  tmpRF = NewVectorType(instance_xtra->grid, 1, max_search_rad, vector_cell_centered);

  /*-----------------------------------------------------------------------
   * Start sequential Gaussian simulator algorithm
   *-----------------------------------------------------------------------*/
  /* Begin timing */
  BeginTiming(public_xtra->time_index);

  /* initialize random number generators */
  SeedRand(public_xtra->seed);

  /* For now, we will assume that all subgrids have the same uniform spacing */
  subgrid = GridSubgrid(grid, 0);

  dx = SubgridDX(subgrid);
  dy = SubgridDY(subgrid);
  dz = SubgridDZ(subgrid);

  /* Size of search neighborhood through which random path must be defined */
  iLx = (int)(lambdaX / dx);
  iLy = (int)(lambdaY / dy);
  iLz = (int)(lambdaZ / dz);

  /* For computational efficiency, we'll limit the
   * size of the search neighborhood. */
  if (iLx > max_search_rad)
    iLx = max_search_rad;
  if (iLy > max_search_rad)
    iLy = max_search_rad;
  if (iLz > max_search_rad)
    iLz = max_search_rad;

  iLxp1 = iLx + 1;
  iLyp1 = iLy + 1;
  iLzp1 = iLz + 1;
  iLxyz = iLxp1 * iLyp1 * iLzp1;

  /* Define the size of a correlation neighborhood */
  nLx = 2 * iLx + 1;
  nLy = 2 * iLy + 1;
  nLz = 2 * iLz + 1;
  nLxyz = nLx * nLy * nLz;

  /*------------------------
   * Define a random path through the points in this subgrid.
   * The random path generation procedure of Srivastava and
   * Gomez has been adopted in this subroutine.  A linear
   * congruential generator of the form: r(i) = 5*r(i-1)+1 mod(2**n)
   * has a cycle length of 2**n.  By choosing the smallest power of
   * 2 that is still larger than the total number of points to be
   * simulated, the method ensures that all indices will be
   * generated once and only once.
   *------------------------*/
  rand_path = talloc(int*, iLxyz);
  for (i = 0; i < iLxyz; i++)
    rand_path[i] = talloc(int, 3);
  modulus = 2;
  while (modulus < iLxyz + 1)
    modulus *= 2;

  /* Compute a random starting node */
  p = (int)Rand();
  r = 1 + p * (iLxyz - 1);

  k = (r - 1) / (iLxp1 * iLyp1);
  j = (r - 1 - iLxp1 * iLyp1 * k) / iLxp1;
  i = (r - 1) - (k * iLyp1 + j) * iLxp1;
  rand_path[0][2] = k;
  rand_path[0][1] = j;
  rand_path[0][0] = i;

  /* Determine the next nodes */
  for (n = 1; n < iLxyz; n++)
  {
    r = (5 * r + 1) % modulus;
    while ((r < 1) || (r > iLxyz))
      r = (5 * r + 1) % modulus;

    k = ((r - 1) / (iLxp1 * iLyp1));
    j = (((r - 1) - iLxp1 * iLyp1 * k) / iLxp1);
    i = (r - 1) - (k * iLyp1 + j) * iLxp1;
    rand_path[n][0] = i;
    rand_path[n][1] = j;
    rand_path[n][2] = k;
  }

  /*-----------------------------------------------------------------------
   * Compute correlation lookup table
   *-----------------------------------------------------------------------*/
  /* First compute a covariance lookup table */
  cov = talloc(double**, nLx);
  for (i = 0; i < nLx; i++)
  {
    cov[i] = talloc(double*, nLy);
    for (j = 0; j < nLy; j++)
      cov[i][j] = ctalloc(double, nLz);
  }

  /* Note that in the construction of the covariance matrix
   * the max_search_rad is not used. Covariance depends upon
   * the correlation lengths, lambdaX/Y/Z, and the grid spacing.
   * The max_search_rad can be longer or shorter than the correlation
   * lengths. The bigger the search radius, the more accurately
   * the random field will match the correlation structure of the
   * covariance function. But the run time will increase greatly
   * as max_search_rad gets bigger because of the kriging matrix
   * that must be solved (see below).
   */
  cx = 0.0;
  cy = 0.0;
  cz = 0.0;
  if (lambdaX != 0.0)
    cx = dx * dx / (lambdaX * lambdaX);
  if (lambdaY != 0.0)
    cy = dy * dy / (lambdaY * lambdaY);
  if (lambdaZ != 0.0)
    cz = dz * dz / (lambdaZ * lambdaZ);

  for (k = 0; k < nLz; k++)
    for (j = 0; j < nLy; j++)
      for (i = 0; i < nLx; i++)
      {
        a1 = i * i * cx;
        a2 = j * j * cy;
        a3 = k * k * cz;
        cov[i][j][k] = exp(-sqrt(a1 + a2 + a3));
      }

  /* Allocate memory for variables that will be used in kriging */
  A11 = ctalloc(double, nLxyz * nLxyz);
  A_sub = ctalloc(double, nLxyz * nLxyz);
  A12 = ctalloc(double*, nLxyz);
  A21 = ctalloc(double*, nLxyz);
  A22 = ctalloc(double*, nLxyz);
  M = ctalloc(double*, nLxyz);
  for (i = 0; i < nLxyz; i++)
  {
    A12[i] = ctalloc(double, nLxyz);
    A21[i] = ctalloc(double, nLxyz);
    A22[i] = ctalloc(double, nLxyz);
    M[i] = ctalloc(double, nLxyz);
  }

  b = ctalloc(double, nLxyz);
  b2 = ctalloc(double, nLxyz);
  b_tmp = ctalloc(double, nLxyz);
  w = ctalloc(double, nLxyz);
  w_tmp = ctalloc(double, nLxyz);
  value = ctalloc(double, nLxyz);
  cval = ctalloc(double, nLxyz);
  ixx = ctalloc(int, nLxyz);
  iyy = ctalloc(int, nLxyz);
  izz = ctalloc(int, nLxyz);

  /* Allocate space for the "marker" used to keep track of which
   * points in a representative correlation box have been simulated
   * already.
   */
  marker = talloc(char**, (3 * iLx + 1));
  marker += iLx;
  for (i = -iLx; i <= 2 * iLx; i++)
  {
    marker[i] = talloc(char*, (3 * iLy + 1));
    marker[i] += iLy;
    for (j = -iLy; j <= 2 * iLy; j++)
    {
      marker[i][j] = ctalloc(char, (3 * iLz + 1));
      marker[i][j] += iLz;
      for (k = -iLz; k <= 2 * iLz; k++)
        marker[i][j][k] = 0;
    }
  }

  /* Convert the cutoff values to a gaussian if they're lognormal on input */
  if ((dist_type == 1) || (dist_type == 3))
  {
    if (low_cutoff <= 0.0)
    {
      low_cutoff = Tiny;
    }
    else
    {
      low_cutoff = (log(low_cutoff / mean)) / sigma;
    }

    if (high_cutoff <= 0.0)
    {
      high_cutoff = DBL_MAX;
    }
    else
    {
      high_cutoff = (log(high_cutoff / mean)) / sigma;
    }
  }

  /*--------------------------------------------------------------------
   * Start pGs algorithm
   *--------------------------------------------------------------------*/
  for (gridloop = 0; gridloop < GridNumSubgrids(grid); gridloop++)
  {
    subgrid = GridSubgrid(grid, gridloop);
    sub_tmpRF = VectorSubvector(tmpRF, gridloop);
    sub_field = VectorSubvector(field, gridloop);
    tmpRFp = SubvectorData(sub_tmpRF);
    fieldp = SubvectorData(sub_field);

    X0 = RealSpaceX(0, SubgridRX(subgrid));
    Y0 = RealSpaceY(0, SubgridRY(subgrid));
    Z0 = RealSpaceZ(0, SubgridRZ(subgrid));

    ix = SubgridIX(subgrid);
    iy = SubgridIY(subgrid);
    iz = SubgridIZ(subgrid);

    nx = SubgridNX(subgrid);
    ny = SubgridNY(subgrid);
    nz = SubgridNZ(subgrid);

    NX = ix + nx;
    NY = iy + ny;
    NZ = iz + nz;

    /* RDF: assume resolution is the same in all 3 directions */
    ref = SubgridRX(subgrid);

    nx_v = SubvectorNX(sub_field);
    ny_v = SubvectorNY(sub_field);
    nz_v = SubvectorNZ(sub_field);

    nx_v2 = SubvectorNX(sub_tmpRF);
    ny_v2 = SubvectorNY(sub_tmpRF);
    nz_v2 = SubvectorNZ(sub_tmpRF);

    /* Initialize tmpRF vector */
    GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz,
    {
      index2 = SubvectorEltIndex(sub_tmpRF, i, j, k);
      tmpRFp[index2] = 0.0;
    });

    /* Convert conditioning data to N(0,1)  distribution if
     * it's assumed to be lognormal. Then copy it into tmpRFp */
    if ((dist_type == 1) || (dist_type == 3))
    {
      for (n = 0; n < nc; n++)
      {
        i = (int)((x[n] - X0) / dx + 0.5);
        j = (int)((y[n] - Y0) / dy + 0.5);
        k = (int)((z[n] - Z0) / dz + 0.5);

        if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) &&
            (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) &&
            (iz - max_search_rad <= k && k <= iz + nz + max_search_rad))
        {
          index2 = SubvectorEltIndex(sub_tmpRF, i, j, k);
          if (v[n] <= 0.0)
            tmpRFp[index2] = Tiny;
          else
            tmpRFp[index2] = (log(v[n] / mean)) / sigma;
        }
      }
    }

    /* Otherwise, shift data to N(0,1) distribution */
    else
    {
      for (n = 0; n < nc; n++)
      {
        i = (int)((x[n] - X0) / dx + 0.5);
        j = (int)((y[n] - Y0) / dy + 0.5);
        k = (int)((z[n] - Z0) / dz + 0.5);

        if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) &&
            (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) &&
            (iz - max_search_rad <= k && k <= iz + nz + max_search_rad))
        {
          index2 = SubvectorEltIndex(sub_tmpRF, i, j, k);
          tmpRFp[index2] = (v[n] - mean) / sigma;
        }
      }
    }

    /* Set the search radii in each direction. If the maximum
     * number of points in a neighborhood is exceeded, these limits
     * will be reduced. */
    i_search = iLx;
    j_search = iLy;
    k_search = iLz;

    /* Compute values at all points using all templates */
    for (n = 0; n < iLxyz; n++)
    {
      /* Update the ghost layer before proceeding */
      if (n > 0)
      {
        /* First reset max_search_radius */
        max_search_rad = i_search;
        if (j_search > max_search_rad)
          max_search_rad = j_search;
        if (k_search > max_search_rad)
          max_search_rad = k_search;

        /* Reset the comm package based on the new max_search_radius */
        if (max_search_rad == 1)
          update_mode = VectorUpdatePGS1;
        else if (max_search_rad == 2)
          update_mode = VectorUpdatePGS2;
        else if (max_search_rad == 3)
          update_mode = VectorUpdatePGS3;
        else
          update_mode = VectorUpdatePGS4;

        handle = InitVectorUpdate(tmpRF, update_mode);
        FinalizeVectorUpdate(handle);
      }

      rpx = rand_path[n][0];
      rpy = rand_path[n][1];
      rpz = rand_path[n][2];
      ix2 = rpx;  while (ix2 < ix)
        ix2 += iLxp1;
      iy2 = rpy;  while (iy2 < iy)
        iy2 += iLyp1;
      iz2 = rpz;  while (iz2 < iz)
        iz2 += iLzp1;

      /* This if clause checks to see if there are, in fact,
       * any points at all in this subgrid, for this
       * particular region. Note that each value of n in the
       * above n-loop corresponds to a different region. */
      if ((ix2 < ix + nx) && (iy2 < iy + ny) && (iz2 < iz + nz))
      {
        /*
         * Construct the input matrix and vector for kriging,
         * solve the linear system, and compute csigma.
         * These depend only on the spatial distribution of
         * conditioning data, not on the actual values of
         * the data. Only the conditional mean (cmean) depends
         * on actual values, so it must be computed for every
         * point. Thus, it's found within the pgs_Boxloop below.
         * The size of the linear system that must be solved here
         * will be no larger than (2r+1)^3, where r=max_search_rad.
         * It is clear from this why it is necessary to limit
         * the size of the search radius.
         */

        /* Here the marker array indicates which points within
         * the search radius have been simulated already. This
         * spatial pattern of conditioning points will be the
         * same for every point in the current template. Thus,
         * this system can be solved once *outside* of the
         * GrGeomInLoop2 below. */

        npts = 9999;
        while (npts > max_npts)
        {
          m = 0;
          /* Count the number of points in search ellipse */
          for (k = rpz - k_search; k <= rpz + k_search; k++)
            for (j = rpy - j_search; j <= rpy + j_search; j++)
              for (i = rpx - i_search; i <= rpx + i_search; i++)
              {
                if (marker[i][j][k])
                {
                  ixx[m] = i;
                  iyy[m] = j;
                  izz[m++] = k;
                }
              }
          npts = m;

          /* If npts is too large, reduce the size of the
           * search ellipse one axis at a time. */
          if (npts > max_npts)
          {
            /* If i_search is the biggest, reduce it by one. */
            if ((i_search >= j_search) && (i_search >= k_search))
            {
              i_search--;
            }

            /* Or, if j_search is the biggest, reduce it by one. */
            else if ((j_search >= i_search) && (j_search >= k_search))
            {
              j_search--;
            }

            /* Otherwise, reduce k_search by one. */
            else
            {
              k_search--;
            }
          }
        }

        m = 0;
        for (j = 0; j < npts; j++)
        {
          di = abs(rpx - ixx[j]);
          dj = abs(rpy - iyy[j]);
          dk = abs(rpz - izz[j]);
          b[j] = cov[di][dj][dk];

          for (i = 0; i < npts; i++)
          {
            di = abs(ixx[i] - ixx[j]);
            dj = abs(iyy[i] - iyy[j]);
            dk = abs(izz[i] - izz[j]);
            A11[m++] = cov[di][dj][dk];
          }
        }

        /* Solve the linear system */
        for (i = 0; i < npts; i++)
          w[i] = b[i];

        if (npts > 0)
        {
          dpofa_(A11, &npts, &npts, &ierr);
          dposl_(A11, &npts, &npts, w);
        }

        /* Compute the conditional standard deviation for the RV
         * to be simulated. */
        csigma = 0.0;
        for (i = 0; i < npts; i++)
          csigma += w[i] * b[i];
        csigma = sqrt(cov[0][0][0] - csigma);

        /* The following loop hits every point in the current
         * region. That is, it skips by max_search_rad+1
         * through the subgrid. In this way, all the points
         * in this loop may simulated simultaneously; each is
         * outside the search radius of all the others. */
        nxG = (nx + ix);
        nyG = (ny + iy);
        nzG = (nz + iz);

        for (k = iz2; k < nzG; k += iLzp1)
          for (j = iy2; j < nyG; j += iLyp1)
            for (i = ix2; i < nxG; i += iLxp1)
            {
              index1 = SubvectorEltIndex(sub_field, i, j, k);
              index2 = SubvectorEltIndex(sub_tmpRF, i, j, k);

              /* Only simulate points in this geounit and that don't
               * already have a value. If a node already has a value,
               * it was assigned as external conditioning data,
               * so we don't need to simulate it.  */
              if (fabs(tmpRFp[index2]) < Tiny)
              {
                /* Condition the random variable */
                m = 0;
                cpts = 0;

                for (kk = -k_search; kk <= k_search; kk++)
                  for (jj = -j_search; jj <= j_search; jj++)
                    for (ii = -i_search; ii <= i_search; ii++)
                    {
                      value[m] = 0.0;
                      index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk);

                      if (marker[ii + rpx][jj + rpy][kk + rpz])
                      {
                        value[m++] = tmpRFp[index3];
                      }

                      /* In this case, there is a value at this point,
                       * but it wasn't simulated yet (as indicated by the
                       * fact that the marker has no place for it). Thus,
                       * it must be external conditioning data.  */
                      else if (fabs(tmpRFp[index3]) > Tiny)
                      {
                        ixx[npts + cpts] = rpx + ii;
                        iyy[npts + cpts] = rpy + jj;
                        izz[npts + cpts] = rpz + kk;
                        cval[cpts++] = tmpRFp[index3];
                      }
                    }

                /* If cpts is too large, reduce the size of the
                 * search neighborhood, one axis at a time. */
                /* Define the size of the search neighborhood */
                ci_search = i_search;
                cj_search = j_search;
                ck_search = k_search;
                while (cpts > max_cpts)
                {
                  /* If ci_search is the biggest, reduce it by one. */
                  if ((ci_search >= cj_search) && (ci_search >= ck_search))
                    ci_search--;

                  /* Or, if cj_search is the biggest, reduce it by one. */
                  else if ((cj_search >= ci_search) && (cj_search >= ck_search))
                    cj_search--;

                  /* Otherwise, reduce ck_search by one. */
                  else
                    ck_search--;

                  /* Now recount the conditioning data points */
                  m = 0;
                  cpts = 0;
                  for (kk = -ck_search; kk <= ck_search; kk++)
                    for (jj = -cj_search; jj <= cj_search; jj++)
                      for (ii = -ci_search; ii <= ci_search; ii++)
                      {
                        index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk);

                        if (!(marker[rpx + ii][rpy + jj][rpz + kk]) &&
                            (fabs(tmpRFp[index3]) > Tiny))
                        {
                          ixx[npts + cpts] = rpx + ii;
                          iyy[npts + cpts] = rpy + jj;
                          izz[npts + cpts] = rpz + kk;
                          cval[cpts++] = tmpRFp[index3];
                        }
                      }
                }

                for (i2 = 0; i2 < npts; i2++)
                  w_tmp[i2] = w[i2];

                /*--------------------------------------------------
                 * Conditioning to external data is done here.
                 *--------------------------------------------------*/
                if (cpts > 0)
                {
                  /* Compute the submatrices */
                  for (j2 = 0; j2 < npts + cpts; j2++)
                  {
                    di = abs(rpx - ixx[j2]);
                    dj = abs(rpy - iyy[j2]);
                    dk = abs(rpz - izz[j2]);
                    b[j2] = cov[di][dj][dk];

                    for (i2 = 0; i2 < npts + cpts; i2++)
                    {
                      di = abs(ixx[i2] - ixx[j2]);
                      dj = abs(iyy[i2] - iyy[j2]);
                      dk = abs(izz[i2] - izz[j2]);
                      A = cov[di][dj][dk];
                      if (i2 < npts && j2 >= npts)
                        A12[i2][j2 - npts] = A;
                      if (i2 >= npts && j2 < npts)
                        A21[i2 - npts][j2] = A;
                      if (i2 >= npts && j2 >= npts)
                        A22[i2 - npts][j2 - npts] = A;
                    }
                  }

                  /* Compute b2' = b2 - A21 * A11_inv * b1 and augment b1 */
                  for (i2 = 0; i2 < cpts; i2++)
                    b2[i2] = b[i2 + npts];
                  for (i2 = 0; i2 < npts; i2++)
                    b_tmp[i2] = b[i2];
                  dposl_(A11, &npts, &npts, b_tmp);

                  for (i2 = 0; i2 < cpts; i2++)
                  {
                    sum = 0.0;
                    for (j2 = 0; j2 < npts; j2++)
                    {
                      sum += A21[i2][j2] * b_tmp[j2];
                    }
                    b2[i2] -= sum;
                  }
                  for (i2 = 0; i2 < cpts; i2++)
                    b[i2 + npts] = b2[i2];

                  /* Compute A22' = A22 - A21 * A11_inv * A12 */
                  for (j2 = 0; j2 < cpts; j2++)
                    for (i2 = 0; i2 < npts; i2++)
                      M[j2][i2] = A12[i2][j2];

                  if (npts > 0)
                  {
                    for (i2 = 0; i2 < cpts; i2++)
                      dposl_(A11, &npts, &npts, M[i2]);
                  }

                  for (j2 = 0; j2 < cpts; j2++)
                    for (i2 = 0; i2 < cpts; i2++)
                    {
                      sum = 0.0;
                      for (k2 = 0; k2 < npts; k2++)
                        sum += A21[i2][k2] * M[j2][k2];
                      A22[i2][j2] -= sum;
                    }

                  m = 0;
                  for (j2 = 0; j2 < cpts; j2++)
                    for (i2 = 0; i2 < cpts; i2++)
                      A_sub[m++] = A22[i2][j2];

                  /* Compute x2 where A22*x2 = b2' */
                  dpofa_(A_sub, &cpts, &cpts, &ierr);
                  dposl_(A_sub, &cpts, &cpts, b2);

                  /* Compute w_tmp where A11*w_tmp = (b1 - A12*b2) */
                  if (npts > 0)
                  {
                    for (i2 = 0; i2 < npts; i2++)
                    {
                      sum = 0.0;
                      for (k2 = 0; k2 < cpts; k2++)
                        sum += A12[i2][k2] * b2[k2];
                      w_tmp[i2] = b[i2] - sum;
                    }
                    dposl_(A11, &npts, &npts, w_tmp);
                  }

                  /* Fill in the rest of w_tmp with b2 */
                  for (i2 = npts; i2 < npts + cpts; i2++)
                  {
                    w_tmp[i2] = b2[i2];
                    value[i2] = cval[i2 - npts];
                  }

                  /* Recompute csigma */
                  csigma = 0.0;
                  for (i2 = 0; i2 < npts + cpts; i2++)
                    csigma += w_tmp[i2] * b[i2];
                  csigma = sqrt(cov[0][0][0] - csigma);
                }
                /*--------------------------------------------------
                 * End of external conditioning
                 *--------------------------------------------------*/
                cmean = 0.0;
                for (m = 0; m < npts + cpts; m++)
                  cmean += w_tmp[m] * value[m];

                /* uni = fieldp[index1]; */
                uni = Rand();
                gauinv_(&uni, &gau, &ierr);
                tmpRFp[index2] = csigma * gau + cmean;

                /* Cutoff tail values if required */
                if (dist_type > 1)
                {
                  if (tmpRFp[index2] < low_cutoff)
                    tmpRFp[index2] = low_cutoff;
                  if (tmpRFp[index2] > high_cutoff)
                    tmpRFp[index2] = high_cutoff;
                }
              }        /* if( abs(tmpRFp[index2]) < Tiny )  */
            }
        /* end of triple for-loops over i,j,k  */

        /* Update the marker vector */
        imin = rpx - iLxp1; if (imin < -iLx)
          imin += iLxp1;
        jmin = rpy - iLyp1; if (jmin < -iLy)
          jmin += iLyp1;
        kmin = rpz - iLzp1; if (kmin < -iLz)
          kmin += iLzp1;

        for (kk = kmin; kk <= 2 * iLz; kk += iLzp1)
          for (jj = jmin; jj <= 2 * iLy; jj += iLyp1)
            for (ii = imin; ii <= 2 * iLx; ii += iLxp1)
            {
              marker[ii][jj][kk] = 1;
            }
      }     /* if(...) */
    }   /* n loop */

    /* Make log-normal if requested. Note that low
     * and high cutoffs are already accomplished. */
    if ((dist_type == 1) || (dist_type == 3))
    {
      GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz,
      {
        index1 = SubvectorEltIndex(sub_field, i, j, k);
        index2 = SubvectorEltIndex(sub_tmpRF, i, j, k);
        fieldp[index1] = mean * exp((sigma) * tmpRFp[index2]);
      });
Exemple #17
0
void         XSlope(
                    ProblemData *problem_data,
                    Vector *     x_slope,
                    Vector *     dummy)
{
  PFModule      *this_module = ThisPFModule;
  PublicXtra    *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
  InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);

  Grid             *grid3d = instance_xtra->grid3d;

  GrGeomSolid      *gr_solid, *gr_domain;

  Type0            *dummy0;
  Type1            *dummy1;
  Type2            *dummy2;
  Type3            *dummy3;

  VectorUpdateCommHandle       *handle;

  SubgridArray     *subgrids = GridSubgrids(grid3d);

  Subgrid          *subgrid;
  Subvector        *ps_sub;
  Subvector        *sx_values_sub;

  double           *data;
  double           *psdat, *sx_values_dat;
  //double            slopex[60][32][392];

  int ix, iy, iz;
  int nx, ny, nz;
  int r;

  int is, i, j, k, ips, ipicv;
  double time = 0.0;

  (void)dummy;

  /*-----------------------------------------------------------------------
   * Put in any user defined sources for this phase
   *-----------------------------------------------------------------------*/

  InitVectorAll(x_slope, 0.0);

  switch ((public_xtra->type))
  {
    case 0:
    {
      int num_regions;
      int     *region_indices;
      double  *values;
      double x, y, z;
      double value;
      int ir;

      dummy0 = (Type0*)(public_xtra->data);

      num_regions = (dummy0->num_regions);
      region_indices = (dummy0->region_indices);
      values = (dummy0->values);

      for (ir = 0; ir < num_regions; ir++)
      {
        gr_solid = ProblemDataGrSolid(problem_data, region_indices[ir]);
        value = values[ir];

        ForSubgridI(is, subgrids)
        {
          subgrid = SubgridArraySubgrid(subgrids, is);
          ps_sub = VectorSubvector(x_slope, is);

          ix = SubgridIX(subgrid);
          iy = SubgridIY(subgrid);
          iz = SubgridIZ(subgrid);

          nx = SubgridNX(subgrid);
          ny = SubgridNY(subgrid);
          nz = SubgridNZ(subgrid);

          /* RDF: assume resolution is the same in all 3 directions */
          r = SubgridRX(subgrid);

          /*
           * TODO
           * SGS this does not match the loop in nl_function_eval.  That
           * loop is going over more than the inner geom locations.  Is that
           * important?  Originally the x_slope array was not being allocated
           * by ctalloc, just alloc and unitialized memory reads were being
           * caused.   Switched that to be ctalloc to init to 0 to "hack" a
           * fix but is this really a sign of deeper indexing problems?
           */
          /* @RMM: todo. the looping to set slopes only goes over interior nodes
           * not ALL nodes (including ghost) as in nl fn eval and now the overland eval
           * routines.  THis is fine in the KW approximation which only needs interior values
           * but for diffusive wave and for the terrain following grid (which uses the surface
           * topo slopes as subsurface slopes) this can cuase bddy problems.  */

          data = SubvectorData(ps_sub);
          GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz,
          {
            ips = SubvectorEltIndex(ps_sub, i, j, 0);
            x = RealSpaceX(i, SubgridRX(subgrid));
            //data[ips] = sin(x)/8.0 + (1/8)*pow(x,-(7/8)) +sin(x/5.0)/(5.0*8.0);
            data[ips] = value;
          });
        }
      }

      break;
    }     /* End case 0 */
Exemple #18
0
void PFVLinearSum(
/* LinearSum : z = a * x + b * y              */
                  double  a,
                  Vector *x,
                  double  b,
                  Vector *y,
                  Vector *z)

{
  double c;
  Vector *v1, *v2;
  int test;

  Grid       *grid = VectorGrid(x);
  Subgrid    *subgrid;

  Subvector  *x_sub;
  Subvector  *y_sub;
  Subvector  *z_sub;

  double     *yp, *xp, *zp;

  int ix, iy, iz;
  int nx, ny, nz;
  int nx_x, ny_x, nz_x;
  int nx_y, ny_y, nz_y;
  int nx_z, ny_z, nz_z;

  int sg, i, j, k, i_x, i_y, i_z;

  if ((b == ONE) && (z == y))      /* BLAS usage: axpy y <- ax+y */
  {
    PFVAxpy(a, x, y);
    return;
  }

  if ((a == ONE) && (z == x))      /* BLAS usage: axpy x <- by+x */
  {
    PFVAxpy(b, y, x);
    return;
  }

  /* Case: a == b == 1.0 */

  if ((a == ONE) && (b == ONE))
  {
    PFVSum(x, y, z);
    return;
  }

  /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */

  if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE)))
  {
    v1 = test ? y : x;
    v2 = test ? x : y;
    PFVDiff(v2, v1, z);
    return;
  }

  /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */
  /* if a or b is 0.0, then user should have called N_VScale */

  if ((test = (a == ONE)) || (b == ONE))
  {
    c = test ? b : a;
    v1 = test ? y : x;
    v2 = test ? x : y;
    PFVLin1(c, v1, v2, z);
    return;
  }

  /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */

  if ((test = (a == -ONE)) || (b == -ONE))
  {
    c = test ? b : a;
    v1 = test ? y : x;
    v2 = test ? x : y;
    PFVLin2(c, v1, v2, z);
    return;
  }

  /* Case: a == b */
  /* catches case both a and b are 0.0 - user should have called N_VConst */

  if (a == b)
  {
    PFVScaleSum(a, x, y, z);
    return;
  }

  /* Case: a == -b */

  if (a == -b)
  {
    PFVScaleDiff(a, x, y, z);
    return;
  }

  /* Do all cases not handled above:
   * (1) a == other, b == 0.0 - user should have called N_VScale
   * (2) a == 0.0, b == other - user should have called N_VScale
   * (3) a,b == other, a !=b, a != -b */

  ForSubgridI(sg, GridSubgrids(grid))
  {
    subgrid = GridSubgrid(grid, sg);

    z_sub = VectorSubvector(z, sg);
    x_sub = VectorSubvector(x, sg);
    y_sub = VectorSubvector(y, sg);

    ix = SubgridIX(subgrid);
    iy = SubgridIY(subgrid);
    iz = SubgridIZ(subgrid);

    nx = SubgridNX(subgrid);
    ny = SubgridNY(subgrid);
    nz = SubgridNZ(subgrid);

    nx_x = SubvectorNX(x_sub);
    ny_x = SubvectorNY(x_sub);
    nz_x = SubvectorNZ(x_sub);

    nx_y = SubvectorNX(y_sub);
    ny_y = SubvectorNY(y_sub);
    nz_y = SubvectorNZ(y_sub);

    nx_z = SubvectorNX(z_sub);
    ny_z = SubvectorNY(z_sub);
    nz_z = SubvectorNZ(z_sub);

    zp = SubvectorElt(z_sub, ix, iy, iz);
    xp = SubvectorElt(x_sub, ix, iy, iz);
    yp = SubvectorElt(y_sub, ix, iy, iz);

    i_x = 0;
    i_y = 0;
    i_z = 0;
    BoxLoopI3(i, j, k, ix, iy, iz, nx, ny, nz,
              i_x, nx_x, ny_x, nz_x, 1, 1, 1,
              i_y, nx_y, ny_y, nz_y, 1, 1, 1,
              i_z, nx_z, ny_z, nz_z, 1, 1, 1,
    {
      zp[i_z] = a * xp[i_x] + b * yp[i_y];
    });
Exemple #19
0
GrGeomExtentArray  *GrGeomCreateExtentArray(
                                            SubgridArray *subgrids,
                                            int           xl_ghost,
                                            int           xu_ghost,
                                            int           yl_ghost,
                                            int           yu_ghost,
                                            int           zl_ghost,
                                            int           zu_ghost)
{
  Background         *bg = GlobalsBackground;

  GrGeomExtentArray  *extent_array;
  GrGeomExtents      *extents;
  int size;

  Subgrid            *subgrid;

  int ref;
  int bg_ix, bg_iy, bg_iz;
  int bg_nx, bg_ny, bg_nz;
  int is;


  size = SubgridArraySize(subgrids);
  extents = ctalloc(GrGeomExtents, size);

  ForSubgridI(is, subgrids)
  {
    subgrid = SubgridArraySubgrid(subgrids, is);

    /* compute background grid extents on MaxRefLevel index space */
    ref = (int)pow(2.0, GlobalsMaxRefLevel);
    bg_ix = BackgroundIX(bg) * ref;
    bg_iy = BackgroundIY(bg) * ref;
    bg_iz = BackgroundIZ(bg) * ref;
    bg_nx = BackgroundNX(bg) * ref;
    bg_ny = BackgroundNY(bg) * ref;
    bg_nz = BackgroundNZ(bg) * ref;

    ref = (int)Pow2(GlobalsMaxRefLevel);

    /*------------------------------------------
     * set the lower extent values
     *------------------------------------------*/

    if (xl_ghost > -1)
    {
      xl_ghost = pfmax(xl_ghost, 1);
      GrGeomExtentsIXLower(extents[is]) =
        (SubgridIX(subgrid) - xl_ghost) * ref;
    }
    else
    {
      GrGeomExtentsIXLower(extents[is]) = bg_ix;
    }

    if (yl_ghost > -1)
    {
      yl_ghost = pfmax(yl_ghost, 1);
      GrGeomExtentsIYLower(extents[is]) =
        (SubgridIY(subgrid) - yl_ghost) * ref;
    }
    else
    {
      GrGeomExtentsIYLower(extents[is]) = bg_iy;
    }

    if (zl_ghost > -1)
    {
      zl_ghost = pfmax(zl_ghost, 1);
      GrGeomExtentsIZLower(extents[is]) =
        (SubgridIZ(subgrid) - zl_ghost) * ref;
    }
    else
    {
      GrGeomExtentsIZLower(extents[is]) = bg_iz;
    }

    /*------------------------------------------
     * set the upper extent values
     *------------------------------------------*/

    if (xu_ghost > -1)
    {
      xu_ghost = pfmax(xu_ghost, 1);
      GrGeomExtentsIXUpper(extents[is]) =
        (SubgridIX(subgrid) + SubgridNX(subgrid) + xu_ghost) * ref - 1;
    }
    else
    {
      GrGeomExtentsIXUpper(extents[is]) = bg_ix + bg_nx - 1;
    }

    if (yu_ghost > -1)
    {
      yu_ghost = pfmax(yu_ghost, 1);
      GrGeomExtentsIYUpper(extents[is]) =
        (SubgridIY(subgrid) + SubgridNY(subgrid) + yu_ghost) * ref - 1;
    }
    else
    {
      GrGeomExtentsIYUpper(extents[is]) = bg_iy + bg_ny - 1;
    }

    if (zu_ghost > -1)
    {
      zu_ghost = pfmax(zu_ghost, 1);
      GrGeomExtentsIZUpper(extents[is]) =
        (SubgridIZ(subgrid) + SubgridNZ(subgrid) + zu_ghost) * ref - 1;
    }
    else
    {
      GrGeomExtentsIZUpper(extents[is]) = bg_iz + bg_nz - 1;
    }

    /*------------------------------------------
     * convert to "octree coordinates"
     *------------------------------------------*/

    /* Moved into the loop by SGS 7/8/98, was lying outside the is
     * loop which was an error (accessing invalid array elements)
     */

    GrGeomExtentsIXLower(extents[is]) -= bg_ix;
    GrGeomExtentsIYLower(extents[is]) -= bg_iy;
    GrGeomExtentsIZLower(extents[is]) -= bg_iz;
    GrGeomExtentsIXUpper(extents[is]) -= bg_ix;
    GrGeomExtentsIYUpper(extents[is]) -= bg_iy;
    GrGeomExtentsIZUpper(extents[is]) -= bg_iz;
  }