ROL
ROL_SGMGADef.hpp
Go to the documentation of this file.
1 // @HEADER
2 // ************************************************************************
3 //
4 // Rapid Optimization Library (ROL) Package
5 // Copyright (2014) Sandia Corporation
6 //
7 // Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive
8 // license for use of this work by or on behalf of the U.S. Government.
9 //
10 // Redistribution and use in source and binary forms, with or without
11 // modification, are permitted provided that the following conditions are
12 // met:
13 //
14 // 1. Redistributions of source code must retain the above copyright
15 // notice, this list of conditions and the following disclaimer.
16 //
17 // 2. Redistributions in binary form must reproduce the above copyright
18 // notice, this list of conditions and the following disclaimer in the
19 // documentation and/or other materials provided with the distribution.
20 //
21 // 3. Neither the name of the Corporation nor the names of the
22 // contributors may be used to endorse or promote products derived from
23 // this software without specific prior written permission.
24 //
25 // THIS SOFTWARE IS PROVIDED BY SANDIA CORPORATION "AS IS" AND ANY
26 // EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
27 // IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 // PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SANDIA CORPORATION OR THE
29 // CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30 // EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 // PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32 // PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33 // LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34 // NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35 // SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 //
37 // Questions? Contact lead developers:
38 // Drew Kouri (dpkouri@sandia.gov) and
39 // Denis Ridzal (dridzal@sandia.gov)
40 //
41 // ************************************************************************
42 // @HEADER
43 
44 
45 namespace ROL {
46 
47 //**************************************************************************80
48 double *sgmga::sgmga_aniso_balance ( double alpha_max,
49  int dim_num,
50  double level_weight[] )
51 //**************************************************************************80
52 //
53 // Purpose:
54 //
55 // SGMGA_ANISO_BALANCE "balances" an anisotropic weight vector.
56 //
57 // Discussion:
58 //
59 // The entries in LEVEL_WEIGHT are essentially arbitrary nonnegative numbers.
60 //
61 // The ratio between two entries indicates their relative importance.
62 // For instance,
63 //
64 // LEVEL_WEIGHT(1) / LEVEL_WEIGHT(2) = 10
65 //
66 // means that variable 2 is 10 times more important than variable 1.
67 // Here, being 10 times more important means that we will generate 10 levels
68 // of sparse grid in direction 2 as we generate 1 level in direction 1.
69 //
70 // Under this interpretation, a ratio of 10 already indicates an extreme
71 // imbalanace in the variables, since 10 sparse grid levels in the second
72 // variable corresponds roughly to approximating x^1 only, and
73 // all of y^1 through y^10. A ratio higher than this seems unreasonable.
74 //
75 // Therefore, this function tries to take a somewhat arbitrary level weight
76 // vector, and produce a "balanced" level weight vector with the properties
77 // that the mininum entry is 1 (representing the item of most importance)
78 // and the maximum entry is ALPHA_MAX. A reasonable value of ALPHA_MAX
79 // might be 10 or even 5.
80 //
81 // Licensing:
82 //
83 // This code is distributed under the GNU LGPL license.
84 //
85 // Modified:
86 //
87 // 03 February 2010
88 //
89 // Author:
90 //
91 // John Burkardt
92 //
93 // Reference:
94 //
95 // Fabio Nobile, Raul Tempone, Clayton Webster,
96 // A Sparse Grid Stochastic Collocation Method for Partial Differential
97 // Equations with Random Input Data,
98 // SIAM Journal on Numerical Analysis,
99 // Volume 46, Number 5, 2008, pages 2309-2345.
100 //
101 // Fabio Nobile, Raul Tempone, Clayton Webster,
102 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
103 // Differential Equations with Random Input Data,
104 // SIAM Journal on Numerical Analysis,
105 // Volume 46, Number 5, 2008, pages 2411-2442.
106 //
107 // Parameters:
108 //
109 // Input, double ALPHA_MAX, the maximum legal value of
110 // LEVEL_WEIGHT, after all entries have been divided by the minimum
111 // nonzero entry. 1 <= ALPHA_MAX.
112 //
113 // Input, int DIM_NUM, the spatial dimension.
114 //
115 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
116 // The values must be positive.
117 //
118 // Output, double SGMGA_ANISO_BALANCE[DIM_NUM], the balanced
119 // anisotropic weights. The smallest nonzero entry is 1.0 and
120 // no entry is greater than ALPHA_MAX.
121 //
122 {
123  int dim;
124  double *level_weight2;
125  double level_weight_min;
126  int nonzero_num;
127 
128  if ( alpha_max < 1.0 )
129  {
130  std::cerr << "\n";
131  std::cerr << "SGMGA_ANISO_BALANCE - Fatal error!\n";
132  std::cerr << " ALPHA_MAX < 1.0\n";
133  std::exit ( 1 );
134  }
135 //
136 // Find the smallest nonzero entry.
137 //
138  level_weight_min = webbur->r8_huge ( );
139  nonzero_num = 0;
140 
141  for ( dim = 0; dim < dim_num; dim++ )
142  {
143  if ( 0.0 < level_weight[dim] )
144  {
145  if ( level_weight[dim] < level_weight_min )
146  {
147  level_weight_min = level_weight[dim];
148  nonzero_num = nonzero_num + 1;
149  }
150  }
151  }
152 
153  if ( nonzero_num == 0 )
154  {
155  std::cerr << "\n";
156  std::cerr << "SGMGA_ANISO_BALANCE - Fatal error!\n";
157  std::cerr << " Could not find a positive entry in LEVEL_WEIGHT.\n";
158  std::exit ( 1 );
159  }
160 //
161 // Rescale so the smallest nonzero entry is 1.
162 //
163  level_weight2 = new double[dim_num];
164  for ( dim = 0; dim < dim_num; dim++ )
165  {
166  level_weight2[dim] = level_weight[dim] / level_weight_min;
167  }
168 //
169 // Set the maximum entry to no more than ALPHA_MAX.
170 //
171  for ( dim = 0; dim < dim_num; dim++ )
172  {
173  level_weight2[dim] = webbur->r8_min ( alpha_max, level_weight2[dim] );
174  }
175  return level_weight2;
176 }
177 
178 
179 //**************************************************************************80
180 void sgmga::sgmga_aniso_normalize ( int option,
181  int dim_num,
182  double level_weight[] )
183 //**************************************************************************80
184 //
185 // Purpose:
186 //
187 // SGMGA_ANISO_NORMALIZE normalizes the SGMGA anisotropic weight vector.
188 //
189 // Discussion:
190 //
191 // It is convenient for the user to initialize the anisotropic weight
192 // vector with any set of positive values. These values are to be used
193 // as coefficients of the 1D levels, to evaluate an expression which
194 // determines which 1D levels will be included in a given rule.
195 //
196 // This means that a relatively LARGE coefficient forces the corresponding
197 // level to be relatively SMALL. This is perhaps the opposite of what
198 // a user might expect. If a user wishes to use an importance vector,
199 // so that a relatively large importance should correspond to more levels,
200 // and hence more points, in that dimension, then the function
201 // SGMGA_IMPORTANCE_TO_ANISO should be called first!
202 //
203 // Since the weights only represent the relative importance of the
204 // components, they may be multiplied by any (positive) scale factor.
205 // Nonetheless, it may be convenient to choose a particular normalization
206 // for the weights.
207 //
208 // Licensing:
209 //
210 // This code is distributed under the GNU LGPL license.
211 //
212 // Modified:
213 //
214 // 27 November 2009
215 //
216 // Author:
217 //
218 // John Burkardt
219 //
220 // Reference:
221 //
222 // Fabio Nobile, Raul Tempone, Clayton Webster,
223 // A Sparse Grid Stochastic Collocation Method for Partial Differential
224 // Equations with Random Input Data,
225 // SIAM Journal on Numerical Analysis,
226 // Volume 46, Number 5, 2008, pages 2309-2345.
227 //
228 // Fabio Nobile, Raul Tempone, Clayton Webster,
229 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
230 // Differential Equations with Random Input Data,
231 // SIAM Journal on Numerical Analysis,
232 // Volume 46, Number 5, 2008, pages 2411-2442.
233 //
234 // Parameters:
235 //
236 // Input, int OPTION, the normalization option.
237 // 0, no scaling is applied.
238 // 1, the weights are scaled so that the minimum nonzero entry is 1.
239 // 2, the weights are scaled so that they sum to DIM_NUM.
240 //
241 // Input, int DIM_NUM, the spatial dimension.
242 //
243 // Input/output, double LEVEL_WEIGHT[DIM_NUM], the anisotropic
244 // weights. The input values must be strictly positive.
245 // On output, these have been normalized.
246 //
247 {
248  int dim;
249  int found;
250  double level_weight_min;
251  double level_weight_sum;
252 //
253 // Option 0, no normalization.
254 //
255  if ( option == 0 )
256  {
257  }
258 //
259 // Option 1, the minimum nonzero entry is 1.
260 //
261  else if ( option == 1 )
262  {
263  level_weight_min = webbur->r8_huge ( );
264  found = 0;
265  for ( dim = 0; dim < dim_num; dim++ )
266  {
267  if ( 0.0 < level_weight[dim] )
268  {
269  if ( level_weight[dim] < level_weight_min )
270  {
271  level_weight_min = level_weight[dim];
272  found = found + 1;
273  }
274  }
275  }
276 
277  if ( found == 0 )
278  {
279  std::cerr << "\n";
280  std::cerr << "SGMGA_ANISO_NORMALIZE - Fatal error!\n";
281  std::cerr << " Could not find a positive entry in LEVEL_WEIGHT.\n";
282  std::exit ( 1 );
283  }
284 
285  for ( dim = 0; dim < dim_num; dim++ )
286  {
287  level_weight[dim] = level_weight[dim] / level_weight_min;
288  }
289  }
290 //
291 // Option 2, rescale so sum of weights is DIM_NUM.
292 //
293  else if ( option == 2 )
294  {
295  level_weight_sum = webbur->r8vec_sum ( dim_num, level_weight );
296 
297  if ( level_weight_sum <= 0.0 )
298  {
299  std::cerr << "\n";
300  std::cerr << "SGMGA_ANISO_NORMALIZE - Fatal error!\n";
301  std::cerr << " Sum of level weights is not positive.\n";
302  std::exit ( 1 );
303  }
304  for ( dim = 0; dim < dim_num; dim++ )
305  {
306  level_weight[dim] = ( ( double ) ( dim_num ) * level_weight[dim] )
307  / level_weight_sum;
308  }
309  }
310 
311  return;
312 }
313 
314 
315 //**************************************************************************80
317  double importance[],
318  double level_weight[] )
319 //**************************************************************************80
320 //
321 // Purpose:
322 //
323 // SGMGA_IMPORTANCE_TO_ANISO: importance vector to anisotropic weight vector.
324 //
325 // Discussion:
326 //
327 // To specify the anisotropy of a multidimensional problem, the user is
328 // allowed to specify an "importance vector". This vector can contain
329 // any set of positive values. These values represent the relative
330 // importance of each dimension. These values, with a suitable normalization,
331 // will be used to evaluate a constraint of the following form:
332 //
333 // QMIN < Level(1) / Importance(1) + Level(2) / Importance(2) + ...
334 // Level(N) / Importance(N) <= QMAX
335 //
336 // and a set of levels that satisfies this constraint will then be included
337 // in a given anistotropic sparse grid rule. Thus, increasing the
338 // importance value of a particular dimension allows larger level values
339 // in that dimension to satisfy the constraint.
340 //
341 // The program actually works with coefficients LEVEL_WEIGHT that are
342 // the inverse of the importance vector entries, with a suitable
343 // normalization. This function is supplied to convert between the
344 // more natural "importance vector" and the internally useful
345 // "level_weight" vector.
346 //
347 // This function converts the importance vector to an unnormalized
348 // anisotropy weight vector.
349 //
350 // Note that some (but not all) of the IMPORTANCE vector entries may be zero.
351 // This indicates that the corresponding dimension is of "zero" or
352 // rather "minimal" importance. In such a case, only a one-point quadrature
353 // rule will be applied for that dimension, no matter what sparse grid
354 // level is requested for the overall problem.
355 //
356 // Licensing:
357 //
358 // This code is distributed under the GNU LGPL license.
359 //
360 // Modified:
361 //
362 // 13 November 2009
363 //
364 // Author:
365 //
366 // John Burkardt
367 //
368 // Reference:
369 //
370 // Fabio Nobile, Raul Tempone, Clayton Webster,
371 // A Sparse Grid Stochastic Collocation Method for Partial Differential
372 // Equations with Random Input Data,
373 // SIAM Journal on Numerical Analysis,
374 // Volume 46, Number 5, 2008, pages 2309-2345.
375 //
376 // Fabio Nobile, Raul Tempone, Clayton Webster,
377 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
378 // Differential Equations with Random Input Data,
379 // SIAM Journal on Numerical Analysis,
380 // Volume 46, Number 5, 2008, pages 2411-2442.
381 //
382 // Parameters:
383 //
384 // Input, int DIM_NUM, the spatial dimension.
385 //
386 // Input, double IMPORTANCE[DIM_NUM], the importance vector.
387 // All entries must be nonnegative, and at least one must be positive.
388 //
389 // Output, double LEVEL_WEIGHT[DIM_NUM], the anisotropic
390 // weights.
391 //
392 {
393  int dim;
394  int found;
395  //double level_weight_norm;
396 
397  for ( dim = 0; dim < dim_num; dim++ )
398  {
399  if ( importance[dim] < 0.0 )
400  {
401  std::cerr << "\n";
402  std::cerr << "SGMGA_IMPORTANCE_TO_ANISO - Fatal error!\n";
403  std::cerr << " Some IMPORTANCE entries are not positive.\n";
404  std::exit ( 1 );
405  }
406  }
407 
408  found = 0;
409 
410  for ( dim = 0; dim < dim_num; dim++ )
411  {
412  if ( 0.0 < importance[dim] )
413  {
414  level_weight[dim] = 1.0 / importance[dim];
415  found = found + 1;
416  }
417  else
418  {
419  level_weight[dim] = 0.0;
420  }
421  }
422 
423  if ( found == 0 )
424  {
425  std::cerr << "\n";
426  std::cerr << "SGMGA_IMPORTANCE_TO_ANISO - Fatal error!\n";
427  std::cerr << " No importance entry is positive.\n";
428  std::exit ( 1 );
429  }
430 
431  return;
432 }
433 
434 
435 //**************************************************************************80
436 void sgmga::sgmga_index ( int dim_num,
437  double level_weight[],
438  int level_max,
439  int rule[],
440  int point_num,
441  int point_total_num,
442  int sparse_unique_index[],
443  int growth[],
444  int sparse_order[],
445  int sparse_index[] )
446 //**************************************************************************80
447 //
448 // Purpose:
449 //
450 // SGMGA_INDEX indexes an SGMGA grid.
451 //
452 // Discussion:
453 //
454 // For each "unique" point in the sparse grid, we return its INDEX and ORDER.
455 //
456 // That is, for the I-th unique point P, we determine the product grid which
457 // first generated this point, and and we return in SPARSE_ORDER the orders
458 // of the 1D rules in that grid, and and in SPARSE_INDEX the component
459 // indexes in those rules that generated this specific point.
460 //
461 // For instance, say P was first generated by a rule which was a 3D product
462 // of a 9th order CC rule and and a 15th order GL rule, and and that to
463 // generate P, we used the 7-th point of the CC rule and and the 3rh point
464 // of the GL rule. Then the SPARSE_ORDER information would be (9,15) and
465 // the SPARSE_INDEX information would be (7,3). This, combined with the
466 // information in RULE, is enough to regenerate the value of P.
467 //
468 // The user must preallocate space for the output arrays SPARSE_ORDER and
469 // SPARSE_INDEX.
470 //
471 // Licensing:
472 //
473 // This code is distributed under the GNU LGPL license.
474 //
475 // Modified:
476 //
477 // 26 April 2011
478 //
479 // Author:
480 //
481 // John Burkardt
482 //
483 // Reference:
484 //
485 // Fabio Nobile, Raul Tempone, Clayton Webster,
486 // A Sparse Grid Stochastic Collocation Method for Partial Differential
487 // Equations with Random Input Data,
488 // SIAM Journal on Numerical Analysis,
489 // Volume 46, Number 5, 2008, pages 2309-2345.
490 //
491 // Fabio Nobile, Raul Tempone, Clayton Webster,
492 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
493 // Differential Equations with Random Input Data,
494 // SIAM Journal on Numerical Analysis,
495 // Volume 46, Number 5, 2008, pages 2411-2442.
496 //
497 // Parameters:
498 //
499 // Input, int DIM_NUM, the spatial dimension.
500 //
501 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
502 //
503 // Input, int LEVEL_MAX, the maximum value of LEVEL.
504 //
505 // Input, int RULE[DIM_NUM], the rule in each dimension.
506 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
507 // 2, "F2", Fejer Type 2, Open Fully Nested.
508 // 3, "GP", Gauss Patterson, Open Fully Nested.
509 // 4, "GL", Gauss Legendre, Open Weakly Nested.
510 // 5, "GH", Gauss Hermite, Open Weakly Nested.
511 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
512 // 7, "LG", Gauss Laguerre, Open Non Nested.
513 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
514 // 9, "GJ", Gauss Jacobi, Open Non Nested.
515 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
516 // 11, "UO", User supplied Open, presumably Non Nested.
517 // 12, "UC", User supplied Closed, presumably Non Nested.
518 //
519 // Input, int POINT_NUM, the number of unique points
520 // in the grid.
521 //
522 // Input, int POINT_TOTAL_NUM, the total number of points in the grid.
523 //
524 // Input, int SPARSE_UNIQUE_INDEX[POINT_TOTAL_NUM], associates each
525 // point in the grid with its unique representative.
526 //
527 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
528 // 0, "DF", default growth associated with this quadrature rule;
529 // 1, "SL", slow linear, L+1;
530 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
531 // 3, "ML", moderate linear, 2L+1;
532 // 4, "SE", slow exponential;
533 // 5, "ME", moderate exponential;
534 // 6, "FE", full exponential.
535 //
536 // Output, int SPARSE_ORDER[DIM_NUM*POINT_NUM], lists,
537 // for each point, the order of the 1D rules used in the grid that
538 // generated it.
539 //
540 // Output, int SPARSE_INDEX[DIM_NUM*POINT_NUM)] lists, for
541 // each point, its index in each of the 1D rules in the grid that generated
542 // it. The indices are 1-based.
543 //
544 {
545  double coef;
546  int dim;
547  int *level_1d;
548  int *level_1d_max;
549  double level_weight_min_pos;
550  bool more_grids;
551  bool more_points;
552  int *order_1d;
553  int point;
554  int point_count;
555  int *point_index;
556  int point_unique;
557  double q_max;
558  double q_min;
559 //
560 // Special cases.
561 //
562  if ( level_max < 0 )
563  {
564  return;
565  }
566 
567  if ( level_max == 0 )
568  {
569  point = 0;
570  for ( dim = 0; dim < dim_num; dim++ )
571  {
572  sparse_order[dim+point*dim_num] = 1;
573  sparse_index[dim+point*dim_num] = 1;
574  }
575  return;
576  }
577 //
578 // Initialize the INDEX and ORDER arrays to -1 to help catch errors.
579 //
580  for ( point = 0; point < point_num; point++ )
581  {
582  for ( dim = 0; dim < dim_num; dim++ )
583  {
584  sparse_order[dim+point*dim_num] = -1;
585  sparse_index[dim+point*dim_num] = -1;
586  }
587  }
588 
589  point_count = 0;
590 
591  level_1d = new int[dim_num];
592  level_1d_max = new int[dim_num];
593  order_1d = new int[dim_num];
594  point_index = new int[dim_num];
595 //
596 // Initialization for SGMGA_VCN_ORDERED.
597 //
598  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
599  q_min = ( double ) ( level_max ) * level_weight_min_pos
600  - webbur->r8vec_sum ( dim_num, level_weight );
601  q_max = ( double ) ( level_max ) * level_weight_min_pos;
602  for ( dim = 0; dim < dim_num; dim++ )
603  {
604  if ( 0.0 < level_weight[dim] )
605  {
606  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim])+1;
607  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
608  {
609  level_1d_max[dim] = level_1d_max[dim] - 1;
610  }
611  }
612  else
613  {
614  level_1d_max[dim] = 0;
615  }
616  }
617  more_grids = false;
618 //
619 // Seek all vectors LEVEL_1D which satisfy the constraint.
620 //
621 // LEVEL_MAX * LEVEL_WEIGHT_MIN_POS - sum ( LEVEL_WEIGHT )
622 // < sum ( 0 <= I < DIM_NUM ) LEVEL_WEIGHT[I] * LEVEL_1D[I]
623 // <= LEVEL_MAX * LEVEL_WEIGHT_MIN_POS.
624 //
625  for ( ; ; )
626  {
627  sgmga_vcn_ordered ( dim_num, level_weight, level_1d_max,
628  level_1d, q_min, q_max, &more_grids );
629 
630  if ( !more_grids )
631  {
632  break;
633  }
634 //
635 // Compute the combinatorial coefficient.
636 //
637  coef = sgmga_vcn_coef ( dim_num, level_weight, level_1d, q_max );
638 
639  if ( coef == 0.0 )
640  {
641  continue;
642  }
643 //
644 // Transform each 1D level to a corresponding 1D order.
645 //
646  webbur->level_growth_to_order ( dim_num, level_1d, rule, growth, order_1d );
647 //
648 // The inner loop generates a POINT of the GRID of the LEVEL.
649 //
650  more_points = false;
651 
652  for ( ; ; )
653  {
654  webbur->vec_colex_next3 ( dim_num, order_1d, point_index, &more_points );
655 
656  if ( !more_points )
657  {
658  break;
659  }
660  point_unique = sparse_unique_index[point_count];
661  for ( dim = 0; dim < dim_num; dim++ )
662  {
663  sparse_order[dim+point_unique*dim_num] = order_1d[dim];
664  }
665  for ( dim = 0; dim < dim_num; dim++ )
666  {
667  sparse_index[dim+point_unique*dim_num] = point_index[dim];
668  }
669  point_count = point_count + 1;
670  }
671  }
672 
673  delete [] level_1d;
674  delete [] level_1d_max;
675  delete [] order_1d;
676  delete [] point_index;
677 
678  return;
679 }
680 
681 
682 //**************************************************************************80
683 void sgmga::sgmga_point ( int dim_num,
684  double level_weight[],
685  int level_max,
686  int rule[],
687  int np[],
688  double p[],
689  void ( *gw_compute_points[] ) ( int order,
690  int np,
691  double p[],
692  double x[] ),
693  int point_num,
694  int sparse_order[],
695  int sparse_index[],
696  int growth[],
697  double sparse_point[] )
698 //**************************************************************************80
699 //
700 // Purpose:
701 //
702 // SGMGA_POINT computes the points of an SGMGA rule.
703 //
704 // Discussion:
705 //
706 // The sparse grid is the logical sum of low degree product rules.
707 //
708 // Each product rule is the product of 1D factor rules.
709 //
710 // The user specifies:
711 // * the spatial dimension of the quadrature region,
712 // * the level that defines the Smolyak grid.
713 // * the quadrature rules.
714 // * the number of points.
715 //
716 // The user must preallocate space for the output array SPARSE_POINT.
717 //
718 // Licensing:
719 //
720 // This code is distributed under the GNU LGPL license.
721 //
722 // Modified:
723 //
724 // 26 April 2011
725 //
726 // Author:
727 //
728 // John Burkardt
729 //
730 // Reference:
731 //
732 // Fabio Nobile, Raul Tempone, Clayton Webster,
733 // A Sparse Grid Stochastic Collocation Method for Partial Differential
734 // Equations with Random Input Data,
735 // SIAM Journal on Numerical Analysis,
736 // Volume 46, Number 5, 2008, pages 2309-2345.
737 //
738 // Fabio Nobile, Raul Tempone, Clayton Webster,
739 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
740 // Differential Equations with Random Input Data,
741 // SIAM Journal on Numerical Analysis,
742 // Volume 46, Number 5, 2008, pages 2411-2442.
743 //
744 // Parameters:
745 //
746 // Input, int DIM_NUM, the spatial dimension.
747 //
748 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
749 //
750 // Input, int LEVEL_MAX, controls the size of the final sparse grid.
751 //
752 // Input, int RULE[DIM_NUM], the rule in each dimension.
753 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
754 // 2, "F2", Fejer Type 2, Open Fully Nested.
755 // 3, "GP", Gauss Patterson, Open Fully Nested.
756 // 4, "GL", Gauss Legendre, Open Weakly Nested.
757 // 5, "GH", Gauss Hermite, Open Weakly Nested.
758 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
759 // 7, "LG", Gauss Laguerre, Open Non Nested.
760 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
761 // 9, "GJ", Gauss Jacobi, Open Non Nested.
762 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
763 // 11, "UO", User supplied Open, presumably Non Nested.
764 // 12, "UC", User supplied Closed, presumably Non Nested.
765 //
766 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
767 //
768 // Input, double P[sum(NP[*])], the parameters needed by each rule.
769 //
770 // Input, void ( *GW_COMPUTE_POINTS[] ) ( int order, int np, double p[], double x[] ),
771 // an array of pointers to functions which return the 1D quadrature points
772 // associated with each spatial dimension for which a Golub Welsch rule
773 // is used.
774 //
775 // Input, int POINT_NUM, the number of points in the grid,
776 // as determined by SGMGA_SIZE.
777 //
778 // Input, int SPARSE_ORDER[DIM_NUM*POINT_NUM], lists, for each point,
779 // the order of the 1D rules used in the grid that generated it.
780 //
781 // Input, int SPARSE_INDEX[DIM_NUM*POINT_NUM], lists, for each point,
782 // its index in each of the 1D rules in the grid that generated it.
783 // The indices are 1-based.
784 //
785 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
786 // 0, "DF", default growth associated with this quadrature rule;
787 // 1, "SL", slow linear, L+1;
788 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
789 // 3, "ML", moderate linear, 2L+1;
790 // 4, "SE", slow exponential;
791 // 5, "ME", moderate exponential;
792 // 6, "FE", full exponential.
793 //
794 // Output, double SPARSE_POINT[DIM_NUM*POINT_NUM], the points.
795 //
796 {
797  int dim;
798  int level;
799  int *level_1d_max;
800  double level_weight_min_pos;
801  int order;
802  int p_index;
803  int point;
804  double *points;
805  double q_max;
806 
807  for ( point = 0; point < point_num; point++ )
808  {
809  for ( dim = 0; dim < dim_num; dim++ )
810  {
811  sparse_point[dim+point*dim_num] = - webbur->r8_huge ( );
812  }
813  }
814 //
815 // Compute the point coordinates.
816 //
817  level_1d_max = new int[dim_num];
818  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
819  q_max = ( double ) ( level_max ) * level_weight_min_pos;
820 
821  p_index = 0;
822 
823  for ( dim = 0; dim < dim_num; dim++ )
824  {
825  if ( 0.0 < level_weight[dim] )
826  {
827  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
828  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
829  {
830  level_1d_max[dim] = level_1d_max[dim] - 1;
831  }
832  }
833  else
834  {
835  level_1d_max[dim] = 0;
836  }
837 
838  for ( level = 0; level <= level_1d_max[dim]; level++ )
839  {
840  webbur->level_growth_to_order ( 1, &level, rule+dim, growth+dim, &order );
841 
842  points = new double[order];
843 
844  if ( rule[dim] == 1 )
845  {
846  webbur->clenshaw_curtis_compute_points_np (
847  order, np[dim], p+p_index, points );
848  }
849  else if ( rule[dim] == 2 )
850  {
851  webbur->fejer2_compute_points_np (
852  order, np[dim], p+p_index, points );
853  }
854  else if ( rule[dim] == 3 )
855  {
856  webbur->patterson_lookup_points_np (
857  order, np[dim], p+p_index, points );
858  }
859  else if ( rule[dim] == 4 )
860  {
861  webbur->legendre_compute_points_np (
862  order, np[dim], p+p_index, points );
863  }
864  else if ( rule[dim] == 5 )
865  {
866  webbur->hermite_compute_points_np (
867  order, np[dim], p+p_index, points );
868  }
869  else if ( rule[dim] == 6 )
870  {
871  webbur->gen_hermite_compute_points_np (
872  order, np[dim], p+p_index, points );
873  }
874  else if ( rule[dim] == 7 )
875  {
876  webbur->laguerre_compute_points_np (
877  order, np[dim], p+p_index, points );
878  }
879  else if ( rule[dim] == 8 )
880  {
881  webbur->gen_laguerre_compute_points_np (
882  order, np[dim], p+p_index, points );
883  }
884  else if ( rule[dim] == 9 )
885  {
886  webbur->jacobi_compute_points_np (
887  order, np[dim], p+p_index, points );
888  }
889  else if ( rule[dim] == 10 )
890  {
891  webbur->hermite_genz_keister_lookup_points_np (
892  order, np[dim], p+p_index, points );
893  }
894  else if ( rule[dim] == 11 )
895  {
896  gw_compute_points[dim] (
897  order, np[dim], p+p_index, points );
898  }
899  else if ( rule[dim] == 12 )
900  {
901  gw_compute_points[dim] (
902  order, np[dim], p+p_index, points );
903  }
904  else
905  {
906  std::cerr << "\n";
907  std::cerr << "SGMGA_POINT - Fatal error!\n";
908  std::cerr << " Unexpected value of RULE[" << dim << "] = "
909  << rule[dim] << ".\n";
910  std::exit ( 1 );
911  }
912 
913  for ( point = 0; point < point_num; point++ )
914  {
915  if ( sparse_order[dim+point*dim_num] == order )
916  {
917  sparse_point[dim+point*dim_num] =
918  points[sparse_index[dim+point*dim_num]-1];
919  }
920  }
921  delete [] points;
922  }
923  p_index = p_index + np[dim];
924  }
925 //
926 // Check to see if we missed any points.
927 //
928  for ( point = 0; point < point_num; point++ )
929  {
930  for ( dim = 0; dim < dim_num; dim++ )
931  {
932  if ( sparse_point[dim+point*dim_num] == - webbur->r8_huge ( ) )
933  {
934  std::cerr << "\n";
935  std::cerr << "SGMGA_POINT - Fatal error!\n";
936  std::cerr << " At least one point component was not assigned.\n";
937  std::cerr << " POINT = " << point << "\n";
938  std::cerr << " DIM = " << dim << "\n";
939  std::cerr << " SPARSE_ORDER(DIM,POINT) = "
940  << sparse_order[dim+point*dim_num] << "\n";
941  std::cerr << " LEVEL_WEIGHT(DIM) = " << level_weight[dim] << "\n";
942  std::exit ( 1 );
943  }
944  }
945  }
946 
947  delete [] level_1d_max;
948 
949  return;
950 }
951 
952 
953 //**************************************************************************80
954 void sgmga::sgmga_product_weight ( int dim_num,
955  int order_1d[],
956  int order_nd,
957  int rule[],
958  int np[],
959  double p[],
960  void ( *gw_compute_weights[] )(int order,
961  int np,
962  double p[],
963  double w[] ),
964  double weight_nd[] )
965 //**************************************************************************80
966 //
967 // Purpose:
968 //
969 // SGMGA_PRODUCT_WEIGHT computes the weights of a mixed product rule.
970 //
971 // Discussion:
972 //
973 // This routine computes the weights for a quadrature rule which is
974 // a product of 1D rules of varying order and kind.
975 //
976 // The user must preallocate space for the output array WEIGHT_ND.
977 //
978 // Licensing:
979 //
980 // This code is distributed under the GNU LGPL license.
981 //
982 // Modified:
983 //
984 // 09 June 2010
985 //
986 // Author:
987 //
988 // John Burkardt
989 //
990 // Reference:
991 //
992 // Fabio Nobile, Raul Tempone, Clayton Webster,
993 // A Sparse Grid Stochastic Collocation Method for Partial Differential
994 // Equations with Random Input Data,
995 // SIAM Journal on Numerical Analysis,
996 // Volume 46, Number 5, 2008, pages 2309-2345.
997 //
998 // Fabio Nobile, Raul Tempone, Clayton Webster,
999 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
1000 // Differential Equations with Random Input Data,
1001 // SIAM Journal on Numerical Analysis,
1002 // Volume 46, Number 5, 2008, pages 2411-2442.
1003 //
1004 // Parameters:
1005 //
1006 // Input, int DIM_NUM, the spatial dimension.
1007 //
1008 // Input, int ORDER_1D[DIM_NUM], the order of the 1D rules.
1009 //
1010 // Input, int ORDER_ND, the order of the product rule.
1011 //
1012 // Input, int RULE[DIM_NUM], the rule in each dimension.
1013 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
1014 // 2, "F2", Fejer Type 2, Open Fully Nested.
1015 // 3, "GP", Gauss Patterson, Open Fully Nested.
1016 // 4, "GL", Gauss Legendre, Open Weakly Nested.
1017 // 5, "GH", Gauss Hermite, Open Weakly Nested.
1018 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
1019 // 7, "LG", Gauss Laguerre, Open Non Nested.
1020 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
1021 // 9, "GJ", Gauss Jacobi, Open Non Nested.
1022 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
1023 // 11, "UO", User supplied Open, presumably Non Nested.
1024 // 12, "UC", User supplied Closed, presumably Non Nested.
1025 //
1026 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
1027 //
1028 // Input, double P[sum(NP[*])], the parameters needed by each rule.
1029 //
1030 // Input, void ( *GW_COMPUTE_WEIGHTS[] ) ( int order, int np, double p[], double w[] ),
1031 // an array of pointers to functions which return the 1D quadrature weights
1032 // associated with each spatial dimension for which a Golub Welsch rule
1033 // is used.
1034 //
1035 // Output, double WEIGHT_ND[ORDER_ND], the product rule weights.
1036 //
1037 {
1038  int dim;
1039  int i;
1040  int p_index;
1041  double *weight_1d;
1042 
1043  for ( i = 0; i < order_nd; i++ )
1044  {
1045  weight_nd[i] = 1.0;
1046  }
1047 
1048  p_index = 0;
1049 
1050  for ( dim = 0; dim < dim_num; dim++ )
1051  {
1052  weight_1d = new double[order_1d[dim]];
1053 
1054  if ( rule[dim] == 1 )
1055  {
1056  webbur->clenshaw_curtis_compute_weights_np (
1057  order_1d[dim], np[dim], p+p_index, weight_1d );
1058  }
1059  else if ( rule[dim] == 2 )
1060  {
1061  webbur->fejer2_compute_weights_np (
1062  order_1d[dim], np[dim], p+p_index, weight_1d );
1063  }
1064  else if ( rule[dim] == 3 )
1065  {
1066  webbur->patterson_lookup_weights_np (
1067  order_1d[dim], np[dim], p+p_index, weight_1d );
1068  }
1069  else if ( rule[dim] == 4 )
1070  {
1071  webbur->legendre_compute_weights_np (
1072  order_1d[dim], np[dim], p+p_index, weight_1d );
1073  }
1074  else if ( rule[dim] == 5 )
1075  {
1076  webbur->hermite_compute_weights_np (
1077  order_1d[dim], np[dim], p+p_index, weight_1d );
1078  }
1079  else if ( rule[dim] == 6 )
1080  {
1081  webbur->gen_hermite_compute_weights_np (
1082  order_1d[dim], np[dim], p+p_index, weight_1d );
1083  }
1084  else if ( rule[dim] == 7 )
1085  {
1086  webbur->laguerre_compute_weights_np (
1087  order_1d[dim], np[dim], p+p_index, weight_1d );
1088  }
1089  else if ( rule[dim] == 8 )
1090  {
1091  webbur->gen_laguerre_compute_weights_np (
1092  order_1d[dim], np[dim], p+p_index, weight_1d );
1093  }
1094  else if ( rule[dim] == 9 )
1095  {
1096  webbur->jacobi_compute_weights_np (
1097  order_1d[dim], np[dim], p+p_index, weight_1d );
1098  }
1099  else if ( rule[dim] == 10 )
1100  {
1101  webbur->hermite_genz_keister_lookup_weights_np (
1102  order_1d[dim], np[dim], p+p_index, weight_1d );
1103  }
1104  else if ( rule[dim] == 11 )
1105  {
1106  gw_compute_weights[dim] (
1107  order_1d[dim], np[dim], p+p_index, weight_1d );
1108  }
1109  else if ( rule[dim] == 12 )
1110  {
1111  gw_compute_weights[dim] (
1112  order_1d[dim], np[dim], p+p_index, weight_1d );
1113  }
1114  else
1115  {
1116  std::cerr << "\n";
1117  std::cerr << "SGMGA_PRODUCT_WEIGHT - Fatal error!\n";
1118  std::cerr << " Unexpected value of RULE[" << dim << "] = "
1119  << rule[dim] << ".\n";
1120  std::exit ( 1 );
1121  }
1122 
1123  p_index = p_index + np[dim];
1124 
1125  webbur->r8vec_direct_product2 ( dim, order_1d[dim], weight_1d,
1126  dim_num, order_nd, weight_nd );
1127 
1128  delete [] weight_1d;
1129  }
1130  return;
1131 }
1132 
1133 
1134 //**************************************************************************80
1135 int sgmga::sgmga_size ( int dim_num,
1136  double level_weight[],
1137  int level_max,
1138  int rule[],
1139  int np[],
1140  double p[],
1141  void ( *gw_compute_points[] ) ( int order,
1142  int np,
1143  double p[],
1144  double x[] ),
1145  double tol,
1146  int growth[] )
1147 //**************************************************************************80
1148 //
1149 // Purpose:
1150 //
1151 // SGMGA_SIZE sizes an SGMGA grid, discounting duplicates.
1152 //
1153 // Discussion:
1154 //
1155 // The sparse grid is the logical sum of product grids that satisfy
1156 // a particular constraint.
1157 //
1158 // Depending on the 1D rules involved, there may be many duplicate points
1159 // in the sparse grid.
1160 //
1161 // This function counts the unique points in the sparse grid. It does this
1162 // in a straightforward way, by actually generating all the points, and
1163 // comparing them, with a tolerance for equality.
1164 //
1165 // This function has been modified to automatically omit points for which
1166 // the "combinatorial coefficient" is zero, since such points would have
1167 // a weight of zero in the grid.
1168 //
1169 // Licensing:
1170 //
1171 // This code is distributed under the GNU LGPL license.
1172 //
1173 // Modified:
1174 //
1175 // 26 April 2011
1176 //
1177 // Author:
1178 //
1179 // John Burkardt
1180 //
1181 // Reference:
1182 //
1183 // Fabio Nobile, Raul Tempone, Clayton Webster,
1184 // A Sparse Grid Stochastic Collocation Method for Partial Differential
1185 // Equations with Random Input Data,
1186 // SIAM Journal on Numerical Analysis,
1187 // Volume 46, Number 5, 2008, pages 2309-2345.
1188 //
1189 // Fabio Nobile, Raul Tempone, Clayton Webster,
1190 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
1191 // Differential Equations with Random Input Data,
1192 // SIAM Journal on Numerical Analysis,
1193 // Volume 46, Number 5, 2008, pages 2411-2442.
1194 //
1195 // Parameters:
1196 //
1197 // Input, int DIM_NUM, the spatial dimension.
1198 //
1199 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
1200 //
1201 // Input, int LEVEL_MAX, the maximum value of LEVEL.
1202 //
1203 // Input, int RULE[DIM_NUM], the rule in each dimension.
1204 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
1205 // 2, "F2", Fejer Type 2, Open Fully Nested.
1206 // 3, "GP", Gauss Patterson, Open Fully Nested.
1207 // 4, "GL", Gauss Legendre, Open Weakly Nested.
1208 // 5, "GH", Gauss Hermite, Open Weakly Nested.
1209 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
1210 // 7, "LG", Gauss Laguerre, Open Non Nested.
1211 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
1212 // 9, "GJ", Gauss Jacobi, Open Non Nested.
1213 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
1214 // 11, "UO", User supplied Open, presumably Non Nested.
1215 // 12, "UC", User supplied Closed, presumably Non Nested.
1216 //
1217 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
1218 //
1219 // Input, double P[sum(NP[*])], the parameters needed by each rule.
1220 //
1221 // Input, void ( *GW_COMPUTE_POINTS[] ) ( int order, int np, double p[], double x[] ),
1222 // an array of pointers to functions which return the 1D quadrature points
1223 // associated with each spatial dimension for which a Golub Welsch rule
1224 // is used.
1225 //
1226 // Input, double TOL, a tolerance for point equality.
1227 //
1228 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
1229 // 0, "DF", default growth associated with this quadrature rule;
1230 // 1, "SL", slow linear, L+1;
1231 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
1232 // 3, "ML", moderate linear, 2L+1;
1233 // 4, "SE", slow exponential;
1234 // 5, "ME", moderate exponential;
1235 // 6, "FE", full exponential.
1236 //
1237 // Output, int SGMGA_SIZE, the number of unique points.
1238 //
1239 {
1240  double coef;
1241  int dim;
1242  int level;
1243  int *level_1d;
1244  int *level_1d_max;
1245  double level_weight_min_pos;
1246  bool more_grids;
1247  bool more_points;
1248  int order;
1249  int *order_1d;
1250  int p_index;
1251  int point;
1252  int *point_index;
1253  int point_num;
1254  int point_total_num;
1255  int point_total_num2;
1256  double *points;
1257  double q_max;
1258  double q_min;
1259  int seed;
1260  int *sparse_total_index;
1261  int *sparse_total_order;
1262  double *sparse_total_point;
1263 //
1264 // Special cases.
1265 //
1266  if ( level_max < 0 )
1267  {
1268  point_num = -1;
1269  return point_num;
1270  }
1271 
1272  if ( level_max == 0 )
1273  {
1274  point_num = 1;
1275  return point_num;
1276  }
1277 //
1278 // Get total number of points, including duplicates.
1279 //
1280  point_total_num = sgmga_size_total ( dim_num, level_weight, level_max,
1281  rule, growth );
1282 //
1283 // Generate SPARSE_TOTAL_ORDER and SPARSE_TOTAL_INDEX arrays
1284 // for the TOTAL set of points.
1285 //
1286  sparse_total_order = new int[dim_num*point_total_num];
1287  sparse_total_index = new int[dim_num*point_total_num];
1288 
1289  point_total_num2 = 0;
1290 
1291  level_1d = new int[dim_num];
1292  level_1d_max = new int[dim_num];
1293  order_1d = new int[dim_num];
1294  point_index = new int[dim_num];
1295 //
1296 // Initialization for SGMGA_VCN_ORDERED.
1297 //
1298  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
1299  q_min = ( double ) ( level_max ) * level_weight_min_pos
1300  - webbur->r8vec_sum ( dim_num, level_weight );
1301  q_max = ( double ) ( level_max ) * level_weight_min_pos;
1302  for ( dim = 0; dim < dim_num; dim++ )
1303  {
1304  if ( 0.0 < level_weight[dim] )
1305  {
1306  level_1d_max[dim] = (int)webbur->r8_floor (q_max/level_weight[dim]) + 1;
1307  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
1308  {
1309  level_1d_max[dim] = level_1d_max[dim] - 1;
1310  }
1311  }
1312  else
1313  {
1314  level_1d_max[dim] = 0;
1315  }
1316  }
1317  more_grids = false;
1318 //
1319 // Seek all vectors LEVEL_1D which satisfy the constraint.
1320 //
1321 // LEVEL_MAX * LEVEL_WEIGHT_MIN_POS - sum ( LEVEL_WEIGHT )
1322 // < sum ( 0 <= I < DIM_NUM ) LEVEL_WEIGHT[I] * LEVEL_1D[I]
1323 // <= LEVEL_MAX * LEVEL_WEIGHT_MIN_POS.
1324 //
1325  for ( ; ; )
1326  {
1327  sgmga_vcn_ordered ( dim_num, level_weight, level_1d_max,
1328  level_1d, q_min, q_max, &more_grids );
1329 
1330  if ( !more_grids )
1331  {
1332  break;
1333  }
1334 //
1335 // Compute the combinatorial coefficient.
1336 //
1337  coef = sgmga_vcn_coef ( dim_num, level_weight, level_1d, q_max );
1338 
1339  if ( coef == 0.0 )
1340  {
1341  continue;
1342  }
1343 //
1344 // Transform each 1D level to a corresponding 1D order.
1345 //
1346  webbur->level_growth_to_order ( dim_num, level_1d, rule, growth, order_1d );
1347 //
1348 // The inner loop generates a POINT of the GRID of the LEVEL.
1349 //
1350  more_points = false;
1351 
1352  for ( ; ; )
1353  {
1354  webbur->vec_colex_next3 ( dim_num, order_1d, point_index, &more_points );
1355 
1356  if ( !more_points )
1357  {
1358  break;
1359  }
1360  for ( dim = 0; dim < dim_num; dim++ )
1361  {
1362  sparse_total_order[dim+point_total_num2*dim_num] = order_1d[dim];
1363  }
1364  for ( dim = 0; dim < dim_num; dim++ )
1365  {
1366  sparse_total_index[dim+point_total_num2*dim_num] = point_index[dim];
1367  }
1368  point_total_num2 = point_total_num2 + 1;
1369  }
1370  }
1371  delete [] level_1d;
1372  delete [] order_1d;
1373  delete [] point_index;
1374 //
1375 // Now compute the coordinates of the TOTAL set of points.
1376 //
1377  sparse_total_point = new double[dim_num*point_total_num];
1378 
1379  for ( point = 0; point < point_total_num; point++ )
1380  {
1381  for ( dim = 0; dim < dim_num; dim++ )
1382  {
1383  sparse_total_point[dim+point*dim_num] = webbur->r8_huge ( );
1384  }
1385  }
1386 //
1387 // Compute the point coordinates.
1388 //
1389  level_1d_max = new int[dim_num];
1390  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
1391  q_max = ( double ) ( level_max ) * level_weight_min_pos;
1392 
1393  p_index = 0;
1394  for ( dim = 0; dim < dim_num; dim++ )
1395  {
1396  if ( 0.0 < level_weight[dim] )
1397  {
1398  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
1399  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
1400  {
1401  level_1d_max[dim] = level_1d_max[dim] - 1;
1402  }
1403  }
1404  else
1405  {
1406  level_1d_max[dim] = 0;
1407  }
1408 
1409  for ( level = 0; level <= level_1d_max[dim]; level++ )
1410  {
1411  webbur->level_growth_to_order ( 1, &level, rule+dim, growth+dim, &order );
1412 
1413  points = new double[order];
1414 
1415  if ( rule[dim] == 1 )
1416  {
1417  webbur->clenshaw_curtis_compute_points_np (
1418  order, np[dim], p+p_index, points );
1419  }
1420  else if ( rule[dim] == 2 )
1421  {
1422  webbur->fejer2_compute_points_np (
1423  order, np[dim], p+p_index, points );
1424  }
1425  else if ( rule[dim] == 3 )
1426  {
1427  webbur->patterson_lookup_points_np (
1428  order, np[dim], p+p_index, points );
1429  }
1430  else if ( rule[dim] == 4 )
1431  {
1432  webbur->legendre_compute_points_np (
1433  order, np[dim], p+p_index, points );
1434  }
1435  else if ( rule[dim] == 5 )
1436  {
1437  webbur->hermite_compute_points_np (
1438  order, np[dim], p+p_index, points );
1439  }
1440  else if ( rule[dim] == 6 )
1441  {
1442  webbur->gen_hermite_compute_points_np (
1443  order, np[dim], p+p_index, points );
1444  }
1445  else if ( rule[dim] == 7 )
1446  {
1447  webbur->laguerre_compute_points_np (
1448  order, np[dim], p+p_index, points );
1449  }
1450  else if ( rule[dim] == 8 )
1451  {
1452  webbur->gen_laguerre_compute_points_np (
1453  order, np[dim], p+p_index, points );
1454  }
1455  else if ( rule[dim] == 9 )
1456  {
1457  webbur->jacobi_compute_points_np (
1458  order, np[dim], p+p_index, points );
1459  }
1460  else if ( rule[dim] == 10 )
1461  {
1462  webbur->hermite_genz_keister_lookup_points_np (
1463  order, np[dim], p+p_index, points );
1464  }
1465  else if ( rule[dim] == 11 )
1466  {
1467  gw_compute_points[dim] (
1468  order, np[dim], p+p_index, points );
1469  }
1470  else if ( rule[dim] == 12 )
1471  {
1472  gw_compute_points[dim] (
1473  order, np[dim], p+p_index, points );
1474  }
1475  else
1476  {
1477  std::cerr << "\n";
1478  std::cerr << "SGMGA_SIZE - Fatal error!\n";
1479  std::cerr << " Unexpected value of RULE[" << dim << "] = "
1480  << rule[dim] << ".\n";
1481  std::exit ( 1 );
1482  }
1483 
1484  for ( point = 0; point < point_total_num; point++ )
1485  {
1486  if ( sparse_total_order[dim+point*dim_num] == order )
1487  {
1488  sparse_total_point[dim+point*dim_num] =
1489  points[sparse_total_index[dim+point*dim_num]-1];
1490  }
1491  }
1492  delete [] points;
1493  }
1494  p_index = p_index + np[dim];
1495  }
1496 //
1497 // Count the tolerably unique columns.
1498 //
1499  seed = 123456789;
1500 
1501  point_num = webbur->point_radial_tol_unique_count ( dim_num, point_total_num,
1502  sparse_total_point, tol, &seed );
1503 
1504  delete [] level_1d_max;
1505  delete [] sparse_total_index;
1506  delete [] sparse_total_order;
1507  delete [] sparse_total_point;
1508 
1509  return point_num;
1510 }
1511 
1512 
1513 //**************************************************************************80
1514 int sgmga::sgmga_size_total ( int dim_num,
1515  double level_weight[],
1516  int level_max,
1517  int rule[],
1518  int growth[] )
1519 //**************************************************************************80
1520 //
1521 // Purpose:
1522 //
1523 // SGMGA_SIZE_TOTAL sizes an SGMGA grid, counting duplicates.
1524 //
1525 // Discussion:
1526 //
1527 // This routine returns the total point count for an SGMGA
1528 // ( Sparse Grid of Mixed type with Growth rule and Anisotropic weights).
1529 //
1530 // The sparse grid is the logical sum of product grids.
1531 //
1532 // The sparse grid has an associated integer index LEVEL_MAX, whose lowest
1533 // value is 0. LEVEL_MAX = 0 indicates the sparse grid made up of one product
1534 // grid, which in turn is the product of 1D factor grids of the lowest level.
1535 // This usually means the sparse grid with LEVEL_MAX equal to 0 is a
1536 // one point grid.
1537 //
1538 // We can assign a level to each factor grid, and hence a LEVEL vector
1539 // to the corresponding product grid, and a weighted index
1540 // LEVEL_GRID (which will in general be a real number):
1541 //
1542 // LEVEL_GRID = sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * LEVEL(I)
1543 //
1544 // The product grid will participate in the formation of the sparse grid
1545 // if it satisfies the following weighted constraint:
1546 //
1547 // LEVEL_MAX - DIM_NUM < LEVEL_GRID <= LEVEL_MAX
1548 //
1549 // This routine determines the total number of abscissas in all the
1550 // product rules used to form the SGMGA associated with the index LEVEL_MAX.
1551 // The count disregards duplication. If the same multidimensional abcsissa
1552 // occurs in two different product rules that are part of the SGMGA, then
1553 // that single abcissa is counted twice.
1554 //
1555 // This computation is useful in cases where the entire set of abscissas
1556 // is going to be generated, preparatory to compression to finding, indexing
1557 // and merging the duplicate abcissass.
1558 //
1559 // Licensing:
1560 //
1561 // This code is distributed under the GNU LGPL license.
1562 //
1563 // Modified:
1564 //
1565 // 26 April 2011
1566 //
1567 // Author:
1568 //
1569 // John Burkardt
1570 //
1571 // Reference:
1572 //
1573 // Fabio Nobile, Raul Tempone, Clayton Webster,
1574 // A Sparse Grid Stochastic Collocation Method for Partial Differential
1575 // Equations with Random Input Data,
1576 // SIAM Journal on Numerical Analysis,
1577 // Volume 46, Number 5, 2008, pages 2309-2345.
1578 //
1579 // Fabio Nobile, Raul Tempone, Clayton Webster,
1580 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
1581 // Differential Equations with Random Input Data,
1582 // SIAM Journal on Numerical Analysis,
1583 // Volume 46, Number 5, 2008, pages 2411-2442.
1584 //
1585 // Parameters:
1586 //
1587 // Input, int DIM_NUM, the spatial dimension.
1588 //
1589 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
1590 //
1591 // Input, int LEVEL_MAX, the maximum value of LEVEL.
1592 //
1593 // Input, int RULE[DIM_NUM], the rule in each dimension.
1594 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
1595 // 2, "F2", Fejer Type 2, Open Fully Nested.
1596 // 3, "GP", Gauss Patterson, Open Fully Nested.
1597 // 4, "GL", Gauss Legendre, Open Weakly Nested.
1598 // 5, "GH", Gauss Hermite, Open Weakly Nested.
1599 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
1600 // 7, "LG", Gauss Laguerre, Open Non Nested.
1601 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
1602 // 9, "GJ", Gauss Jacobi, Open Non Nested.
1603 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
1604 // 11, "UO", User supplied Open, presumably Non Nested.
1605 // 12, "UC", User supplied Closed, presumably Non Nested.
1606 //
1607 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
1608 // 0, "DF", default growth associated with this quadrature rule;
1609 // 1, "SL", slow linear, L+1;
1610 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
1611 // 3, "ML", moderate linear, 2L+1;
1612 // 4, "SE", slow exponential;
1613 // 5, "ME", moderate exponential;
1614 // 6, "FE", full exponential.
1615 //
1616 // Output, int SGMGA_SIZE_TOTAL, the number of points
1617 // including repetitions.
1618 //
1619 {
1620  double coef;
1621  int dim;
1622  int *level_1d;
1623  int *level_1d_max;
1624  double level_weight_min_pos;
1625  bool more_grids;
1626  int *order_1d;
1627  int point_total_num;
1628  double q_max;
1629  double q_min;
1630 //
1631 // Special case.
1632 //
1633  if ( level_max == 0 )
1634  {
1635  point_total_num = 1;
1636  return point_total_num;
1637  }
1638 
1639  point_total_num = 0;
1640 
1641  level_1d = new int[dim_num];
1642  level_1d_max = new int[dim_num];
1643  order_1d = new int[dim_num];
1644 //
1645 // Initialization for SGMGA_VCN_ORDERED.
1646 //
1647  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
1648  q_min = ( double ) ( level_max ) * level_weight_min_pos
1649  - webbur->r8vec_sum ( dim_num, level_weight );
1650  q_max = ( double ) ( level_max ) * level_weight_min_pos;
1651  for ( dim = 0; dim < dim_num; dim++ )
1652  {
1653  if ( 0.0 < level_weight[dim] )
1654  {
1655  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
1656  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
1657  {
1658  level_1d_max[dim] = level_1d_max[dim] - 1;
1659  }
1660  }
1661  else
1662  {
1663  level_1d_max[dim] = 0;
1664  }
1665  }
1666  more_grids = false;
1667 //
1668 // Seek all vectors LEVEL_1D which satisfy the constraint.
1669 //
1670 // LEVEL_MAX * LEVEL_WEIGHT_MIN_POS - sum ( LEVEL_WEIGHT )
1671 // < sum ( 0 <= I < DIM_NUM ) LEVEL_WEIGHT[I] * LEVEL_1D[I]
1672 // <= LEVEL_MAX * LEVEL_WEIGHT_MIN_POS.
1673 //
1674  for ( ; ; )
1675  {
1676  sgmga_vcn_ordered ( dim_num, level_weight, level_1d_max,
1677  level_1d, q_min, q_max, &more_grids );
1678 
1679  if ( !more_grids )
1680  {
1681  break;
1682  }
1683 //
1684 // Compute the combinatorlal coefficient.
1685 //
1686  coef = sgmga_vcn_coef ( dim_num, level_weight, level_1d, q_max );
1687 
1688  if ( coef == 0.0 )
1689  {
1690  continue;
1691  }
1692 //
1693 // Transform each 1D level to a corresponding 1D order.
1694 //
1695  webbur->level_growth_to_order ( dim_num, level_1d, rule, growth, order_1d );
1696 
1697  point_total_num = point_total_num + webbur->i4vec_product ( dim_num,
1698  order_1d );
1699  }
1700  delete [] level_1d;
1701  delete [] level_1d_max;
1702  delete [] order_1d;
1703 
1704  return point_total_num;
1705 }
1706 
1707 
1708 //**************************************************************************80
1709 void sgmga::sgmga_unique_index ( int dim_num,
1710  double level_weight[],
1711  int level_max,
1712  int rule[],
1713  int np[],
1714  double p[],
1715  void ( *gw_compute_points[] ) ( int order,
1716  int np,
1717  double p[],
1718  double x[] ),
1719  double tol,
1720  int point_num,
1721  int point_total_num,
1722  int growth[],
1723  int sparse_unique_index[] )
1724 //**************************************************************************80
1725 //
1726 // Purpose:
1727 //
1728 // SGMGA_UNIQUE_INDEX maps nonunique to unique points.
1729 //
1730 // Discussion:
1731 //
1732 // The sparse grid usually contains many points that occur in more
1733 // than one product grid.
1734 //
1735 // When generating the point locations, it is easy to realize that a point
1736 // has already been generated.
1737 //
1738 // But when it's time to compute the weights of the sparse grids, it is
1739 // necessary to handle situations in which weights corresponding to
1740 // the same point generated in multiple grids must be collected together.
1741 //
1742 // This routine generates ALL the points, including their multiplicities,
1743 // and figures out a mapping from them to the collapsed set of unique points.
1744 //
1745 // This mapping can then be used during the weight calculation so that
1746 // a contribution to the weight gets to the right place.
1747 //
1748 // The user must preallocate space for the output array SPARSE_UNIQUE_INDEX.
1749 //
1750 // Licensing:
1751 //
1752 // This code is distributed under the GNU LGPL license.
1753 //
1754 // Modified:
1755 //
1756 // 26 April 2011
1757 //
1758 // Author:
1759 //
1760 // John Burkardt
1761 //
1762 // Reference:
1763 //
1764 // Fabio Nobile, Raul Tempone, Clayton Webster,
1765 // A Sparse Grid Stochastic Collocation Method for Partial Differential
1766 // Equations with Random Input Data,
1767 // SIAM Journal on Numerical Analysis,
1768 // Volume 46, Number 5, 2008, pages 2309-2345.
1769 //
1770 // Fabio Nobile, Raul Tempone, Clayton Webster,
1771 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
1772 // Differential Equations with Random Input Data,
1773 // SIAM Journal on Numerical Analysis,
1774 // Volume 46, Number 5, 2008, pages 2411-2442.
1775 //
1776 // Parameters:
1777 //
1778 // Input, int DIM_NUM, the spatial dimension.
1779 //
1780 // Input, int LEVEL_MAX, the maximum value of LEVEL.
1781 //
1782 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
1783 //
1784 // Input, int RULE[DIM_NUM], the rule in each dimension.
1785 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
1786 // 2, "F2", Fejer Type 2, Open Fully Nested.
1787 // 3, "GP", Gauss Patterson, Open Fully Nested.
1788 // 4, "GL", Gauss Legendre, Open Weakly Nested.
1789 // 5, "GH", Gauss Hermite, Open Weakly Nested.
1790 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
1791 // 7, "LG", Gauss Laguerre, Open Non Nested.
1792 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
1793 // 9, "GJ", Gauss Jacobi, Open Non Nested.
1794 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
1795 // 11, "UO", User supplied Open, presumably Non Nested.
1796 // 12, "UC", User supplied Closed, presumably Non Nested.
1797 //
1798 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
1799 //
1800 // Input, double P[sum(NP[*])], the parameters needed by each rule.
1801 //
1802 // Input, void ( *GW_COMPUTE_POINTS[] ) ( int order, int np, double p[], double x[] ),
1803 // an array of pointers to functions which return the 1D quadrature points
1804 // associated with each spatial dimension for which a Golub Welsch rule
1805 // is used.
1806 //
1807 // Input, double TOL, a tolerance for point equality.
1808 //
1809 // Input, int POINT_NUM, the number of unique points in the grid.
1810 //
1811 // Input, int POINT_TOTAL_NUM, the total number of points
1812 // in the grid.
1813 //
1814 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
1815 // 0, "DF", default growth associated with this quadrature rule;
1816 // 1, "SL", slow linear, L+1;
1817 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
1818 // 3, "ML", moderate linear, 2L+1;
1819 // 4, "SE", slow exponential;
1820 // 5, "ME", moderate exponential;
1821 // 6, "FE", full exponential.
1822 //
1823 // Output, int SPARSE UNIQUE_INDEX[POINT_TOTAL_NUM], lists,
1824 // for each (nonunique) point, the corresponding index of the same point in
1825 // the unique listing.
1826 //
1827 {
1828  double coef;
1829  int dim;
1830  int level;
1831  int *level_1d;
1832  int *level_1d_max;
1833  double level_weight_min_pos;
1834  bool more_grids;
1835  bool more_points;
1836  int order;
1837  int *order_1d;
1838  int p_index;
1839  int point;
1840  int *point_index;
1841  //int point_num2;
1842  int point_total_num2;
1843  double *points;
1844  double q_max;
1845  double q_min;
1846  int rep;
1847  int seed;
1848  int *sparse_total_index;
1849  int *sparse_total_order;
1850  double *sparse_total_point;
1851  int *undx;
1852 //
1853 // Special cases.
1854 //
1855  if ( level_max < 0 )
1856  {
1857  return;
1858  }
1859 
1860  if ( level_max == 0 )
1861  {
1862  sparse_unique_index[0] = 0;
1863  return;
1864  }
1865 //
1866 // Generate SPARSE_TOTAL_ORDER and SPARSE_TOTAL_INDEX arrays
1867 // for the TOTAL set of points.
1868 //
1869  sparse_total_order = new int[dim_num*point_total_num];
1870  sparse_total_index = new int[dim_num*point_total_num];
1871 
1872  level_1d = new int[dim_num];
1873  level_1d_max = new int[dim_num];
1874  order_1d = new int[dim_num];
1875  point_index = new int[dim_num];
1876 
1877  point_total_num2 = 0;
1878 //
1879 // Initialization for SGMGA_VCN_ORDERED.
1880 //
1881  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
1882  q_min = ( double ) ( level_max ) * level_weight_min_pos
1883  - webbur->r8vec_sum ( dim_num, level_weight );
1884  q_max = ( double ) ( level_max ) * level_weight_min_pos;
1885  for ( dim = 0; dim < dim_num; dim++ )
1886  {
1887  if ( 0.0 < level_weight[dim] )
1888  {
1889  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
1890  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
1891  {
1892  level_1d_max[dim] = level_1d_max[dim] - 1;
1893  }
1894  }
1895  else
1896  {
1897  level_1d_max[dim] = 0;
1898  }
1899  }
1900  more_grids = false;
1901 //
1902 // Seek all vectors LEVEL_1D which satisfy the constraint:
1903 //
1904 // LEVEL_MAX * LEVEL_WEIGHT_MIN_POS - sum ( LEVEL_WEIGHT )
1905 // < sum ( 0 <= I < DIM_NUM ) LEVEL_WEIGHT[I] * LEVEL_1D[I]
1906 // <= LEVEL_MAX * LEVEL_WEIGHT_MIN_POS.
1907 //
1908  for ( ; ; )
1909  {
1910  sgmga_vcn_ordered ( dim_num, level_weight, level_1d_max,
1911  level_1d, q_min, q_max, &more_grids );
1912 
1913  if ( !more_grids )
1914  {
1915  break;
1916  }
1917 //
1918 // Compute the combinatorial coefficient.
1919 //
1920  coef = sgmga_vcn_coef ( dim_num, level_weight, level_1d, q_max );
1921 
1922  if ( coef == 0.0 )
1923  {
1924  continue;
1925  }
1926 //
1927 // Transform each 1D level to a corresponding 1D order.
1928 //
1929  webbur->level_growth_to_order ( dim_num, level_1d, rule, growth, order_1d );
1930 //
1931 // The inner loop generates a POINT of the GRID of the LEVEL.
1932 //
1933  more_points = false;
1934 
1935  for ( ; ; )
1936  {
1937  webbur->vec_colex_next3 ( dim_num, order_1d, point_index, &more_points );
1938 
1939  if ( !more_points )
1940  {
1941  break;
1942  }
1943  for ( dim = 0; dim < dim_num; dim++ )
1944  {
1945  sparse_total_order[dim+point_total_num2*dim_num] = order_1d[dim];
1946  }
1947  for ( dim = 0; dim < dim_num; dim++ )
1948  {
1949  sparse_total_index[dim+point_total_num2*dim_num] = point_index[dim];
1950  }
1951  point_total_num2 = point_total_num2 + 1;
1952  }
1953  }
1954  delete [] level_1d;
1955  delete [] level_1d_max;
1956  delete [] order_1d;
1957  delete [] point_index;
1958 //
1959 // Now compute the coordinates of the TOTAL set of points.
1960 //
1961  sparse_total_point = new double[dim_num*point_total_num];
1962 
1963  for ( point = 0; point < point_total_num; point++ )
1964  {
1965  for ( dim = 0; dim < dim_num; dim++ )
1966  {
1967  sparse_total_point[dim+point*dim_num] = webbur->r8_huge ( );
1968  }
1969  }
1970 //
1971 // Compute the point coordinates.
1972 //
1973  level_1d_max = new int[dim_num];
1974  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
1975  q_max = ( double ) ( level_max ) * level_weight_min_pos;
1976 
1977  p_index = 0;
1978  for ( dim = 0; dim < dim_num; dim++ )
1979  {
1980  if ( 0.0 < level_weight[dim] )
1981  {
1982  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
1983  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
1984  {
1985  level_1d_max[dim] = level_1d_max[dim] - 1;
1986  }
1987  }
1988  else
1989  {
1990  level_1d_max[dim] = 0;
1991  }
1992 
1993  for ( level = 0; level <= level_1d_max[dim]; level++ )
1994  {
1995  webbur->level_growth_to_order ( 1, &level, rule+dim, growth+dim, &order );
1996 
1997  points = new double[order];
1998 
1999  if ( rule[dim] == 1 )
2000  {
2001  webbur->clenshaw_curtis_compute_points_np (
2002  order, np[dim], p+p_index, points );
2003  }
2004  else if ( rule[dim] == 2 )
2005  {
2006  webbur->fejer2_compute_points_np (
2007  order, np[dim], p+p_index, points );
2008  }
2009  else if ( rule[dim] == 3 )
2010  {
2011  webbur->patterson_lookup_points_np (
2012  order, np[dim], p+p_index, points );
2013  }
2014  else if ( rule[dim] == 4 )
2015  {
2016  webbur->legendre_compute_points_np (
2017  order, np[dim], p+p_index, points );
2018  }
2019  else if ( rule[dim] == 5 )
2020  {
2021  webbur->hermite_compute_points_np (
2022  order, np[dim], p+p_index, points );
2023  }
2024  else if ( rule[dim] == 6 )
2025  {
2026  webbur->gen_hermite_compute_points_np (
2027  order, np[dim], p+p_index, points );
2028  }
2029  else if ( rule[dim] == 7 )
2030  {
2031  webbur->laguerre_compute_points_np (
2032  order, np[dim], p+p_index, points );
2033  }
2034  else if ( rule[dim] == 8 )
2035  {
2036  webbur->gen_laguerre_compute_points_np (
2037  order, np[dim], p+p_index, points );
2038  }
2039  else if ( rule[dim] == 9 )
2040  {
2041  webbur->jacobi_compute_points_np (
2042  order, np[dim], p+p_index, points );
2043  }
2044  else if ( rule[dim] == 10 )
2045  {
2046  webbur->hermite_genz_keister_lookup_points_np (
2047  order, np[dim], p+p_index, points );
2048  }
2049  else if ( rule[dim] == 11 )
2050  {
2051  gw_compute_points[dim] (
2052  order, np[dim], p+p_index, points );
2053  }
2054  else if ( rule[dim] == 12 )
2055  {
2056  gw_compute_points[dim] (
2057  order, np[dim], p+p_index, points );
2058  }
2059  else
2060  {
2061  std::cerr << "\n";
2062  std::cerr << "SGMGA_UNIQUE_INDEX - Fatal error!\n";
2063  std::cerr << " Unexpected value of RULE[" << dim << "] = "
2064  << rule[dim] << ".\n";
2065  std::exit ( 1 );
2066  }
2067 
2068  for ( point = 0; point < point_total_num; point++ )
2069  {
2070  if ( sparse_total_order[dim+point*dim_num] == order )
2071  {
2072  sparse_total_point[dim+point*dim_num] =
2073  points[sparse_total_index[dim+point*dim_num]-1];
2074  }
2075  }
2076  delete [] points;
2077  }
2078  p_index = p_index + np[dim];
2079  }
2080 //
2081 // Merge points that are too close.
2082 //
2083  seed = 123456789;
2084 
2085  undx = new int[point_num];
2086 
2087  //point_num2 = webbur->point_radial_tol_unique_index ( dim_num, point_total_num,
2088  // sparse_total_point, tol, &seed, undx, sparse_unique_index );
2089  webbur->point_radial_tol_unique_index ( dim_num, point_total_num,
2090  sparse_total_point, tol, &seed, undx, sparse_unique_index );
2091 
2092  for ( point = 0; point < point_total_num; point++ )
2093  {
2094  rep = undx[sparse_unique_index[point]];
2095  if ( point != rep )
2096  {
2097  for ( dim = 0; dim < dim_num; dim++ )
2098  {
2099  sparse_total_point[dim+point*dim_num] = sparse_total_point[dim+rep*dim_num];
2100  }
2101  }
2102  }
2103 //
2104 // Construct an index that indicates the "rank" of the unique points.
2105 //
2106  webbur->point_unique_index ( dim_num, point_total_num, sparse_total_point,
2107  point_num, undx, sparse_unique_index );
2108 
2109  delete [] undx;
2110 
2111  delete [] sparse_total_index;
2112  delete [] sparse_total_order;
2113  delete [] sparse_total_point;
2114 
2115  return;
2116 }
2117 
2118 
2119 //**************************************************************************80
2120 void sgmga::sgmga_vcn ( int n,
2121  double w[],
2122  int x[],
2123  double q_min,
2124  double q_max,
2125  bool *more )
2126 //**************************************************************************80
2127 //
2128 // Purpose:
2129 //
2130 // SGMGA_VCN returns the next constrained vector.
2131 //
2132 // Discussion:
2133 //
2134 // This function is intended to replace the "naive" version, now called
2135 // SGMGA_VCN_NAIVE, which is too slow for high dimensional problems.
2136 //
2137 // For nonnegative vectors X of dimension N, and nonnegative
2138 // weights W, we define:
2139 //
2140 // Q = sum ( 1 <= I <= N ) W(I) * X(I)
2141 //
2142 // and seek X satisfying the constraint:
2143 //
2144 // Q_MIN < Q <= Q_MAX
2145 //
2146 // This routine returns, one at a time exactly those X which satisfy
2147 // the constraint. No attempt is made to return the X values in
2148 // any particular order as far as Q goes.
2149 //
2150 // Example:
2151 //
2152 // W 4.0 3.0 5.0
2153 // MIN 16.0 0 0 0
2154 // --- ---- -----------
2155 // 1 20.0 5 0 0
2156 // 2 19.0 4 1 0
2157 // 3 18.0 3 2 0
2158 // 4 17.0 2 3 0
2159 // 5 20.0 2 4 0
2160 // 6 19.0 1 5 0
2161 // 7 18.0 0 6 0
2162 // 8 17.0 3 0 1
2163 // 9 20.0 3 1 1
2164 // 10 19.0 2 2 1
2165 // 11 18.0 1 3 1
2166 // 12 17.0 0 4 1
2167 // 13 20.0 0 5 1
2168 // 14 18.0 2 0 2
2169 // 15 17.0 1 1 2
2170 // 16 20.0 1 2 2
2171 // 17 19.0 0 3 2
2172 // 18 19.0 1 0 3
2173 // 19 18.0 0 1 3
2174 // 20 20.0 0 0 4
2175 // --- ---- ----------
2176 // MAX 20.0 6 7 5
2177 //
2178 // Licensing:
2179 //
2180 // This code is distributed under the GNU LGPL license.
2181 //
2182 // Modified:
2183 //
2184 // 21 May 2010
2185 //
2186 // Author:
2187 //
2188 // John Burkardt
2189 //
2190 // Reference:
2191 //
2192 // Fabio Nobile, Raul Tempone, Clayton Webster,
2193 // A Sparse Grid Stochastic Collocation Method for Partial Differential
2194 // Equations with Random Input Data,
2195 // SIAM Journal on Numerical Analysis,
2196 // Volume 46, Number 5, 2008, pages 2309-2345.
2197 //
2198 // Fabio Nobile, Raul Tempone, Clayton Webster,
2199 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
2200 // Differential Equations with Random Input Data,
2201 // SIAM Journal on Numerical Analysis,
2202 // Volume 46, Number 5, 2008, pages 2411-2442.
2203 //
2204 // Parameters:
2205 //
2206 // Input, int N, the dimension of the vector.
2207 //
2208 // Input, double W[N], the weights, which should be nonnegative.
2209 // At least one weight must be positive.
2210 //
2211 // Input/output, int X[N]. On first call, with
2212 // MORE = FALSE, the input value of X is not important. On subsequent calls,
2213 // the input value of X should be the output value from the previous call.
2214 // On output, (with MORE = TRUE), the value of X will be the "next"
2215 // vector in the reverse lexicographical list of vectors that satisfy
2216 // the condition. However, on output with MORE = FALSE, the vector
2217 // X is meaningless, because there are no more vectors in the list.
2218 //
2219 // Input, double Q_MIN, Q_MAX, the lower and upper limits on the sum.
2220 //
2221 // Input/output, bool *MORE. On input, if the user has set MORE
2222 // FALSE, the user is requesting the initiation of a new sequence
2223 // of values. If MORE is TRUE, then the user is requesting "more"
2224 // values in the current sequence. On output, if MORE is TRUE,
2225 // then another value was found and returned in X, but if MORE is
2226 // FALSE, then there are no more values in the sequence, and X is
2227 // NOT the next value.
2228 //
2229 {
2230  static int dir;
2231  int i;
2232  static int n2;
2233  static int nstart;
2234  double t;
2235  static int *xmax;
2236  static int xmin;
2237 //
2238 // Initialization for first call.
2239 //
2240 // Allocate XMAX to remember the currently maximum possible value for each X.
2241 //
2242 // Locate NSTART, the index of the first nonzero weight.
2243 // The algorithm is easier to program if the last index we look at
2244 // has a nonzero weight, so that it can always make up the remainder.
2245 //
2246  if ( !(*more) )
2247  {
2248  xmax = new int[n];
2249 
2250  nstart = - 1;
2251 
2252  for ( i = 0; i < n; i++ )
2253  {
2254  if ( 0.0 < w[i] )
2255  {
2256  nstart = i;
2257  break;
2258  }
2259  }
2260 //
2261 // Theoretically, we could even handle the case where all weights are zero.
2262 // That case is ruled out elsewhere in this software, so I will not try
2263 // to deal with it here for now.
2264 //
2265  if ( nstart == - 1 )
2266  {
2267  std::cerr << "\n";
2268  std::cerr << " SGMGA_VCN - Fatal error!\n";
2269  std::cerr << " No weight is positive.\n";
2270  std::exit ( 1 );
2271  }
2272 //
2273 // Initialize X to zero, even the indices we ignore.
2274 //
2275  for ( i = 0; i < n; i++ )
2276  {
2277  x[i] = 0;
2278  }
2279 //
2280 // N2 points to our current index of interest.
2281 //
2282  n2 = n;
2283  dir = - 1;
2284 
2285  *more = true;
2286  }
2287 //
2288 // Look for the next solution vector X.
2289 //
2290  for ( ; ; )
2291  {
2292 //
2293 // If no more, the search is terminated.
2294 //
2295  if ( !(*more) )
2296  {
2297  break;
2298  }
2299 //
2300 // DIR = -1, decrement N2, and, if possible, set X[N2] to XMIN.
2301 // DIR = 0, hold N2 at current value, and see if we can increment X[N2].
2302 //
2303  else if ( dir == - 1 || dir == 0 )
2304  {
2305  if ( dir == - 1 )
2306  {
2307  n2 = n2 - 1;
2308  }
2309 
2310  if ( w[n2] == 0.0 )
2311  {
2312  xmin = 0;
2313  xmax[n2] = 0;
2314  }
2315  else if ( nstart < n2 )
2316  {
2317  xmin = 0;
2318  t = q_max;
2319  for ( i = n2 + 1; i < n; i++ )
2320  {
2321  t = t - w[i] * ( double ) x[i];
2322  }
2323  xmax[n2] = (int)webbur->r8_floor ( t / w[n2] );
2324  }
2325  else if ( n2 == nstart && dir == - 1 )
2326  {
2327  t = q_min;
2328  for ( i = n2 + 1; i < n; i++ )
2329  {
2330  t = t - w[i] * ( double ) x[i];
2331  }
2332  xmin = (int)webbur->r8_ceiling ( t / w[n2] );
2333  if ( xmin < 0 )
2334  {
2335  xmin = 0;
2336  }
2337  t = 0.0;
2338  for ( i = 0; i < n2; i++ )
2339  {
2340  t = t + w[i] * ( double ) x[i];
2341  }
2342  t = t + w[n2] * xmin;
2343  for ( i = n2 + 1; i < n; i++ )
2344  {
2345  t = t + w[i] * ( double ) x[i];
2346  }
2347  if ( t <= q_min )
2348  {
2349  xmin = xmin + 1;
2350  }
2351  x[n2] = xmin;
2352  t = q_max;
2353  for ( i = n2 + 1; i < n; i++ )
2354  {
2355  t = t - w[i] * ( double ) x[i];
2356  }
2357  xmax[n2] = (int)webbur->r8_floor ( t / w[n2] );
2358  }
2359 
2360  if ( xmax[n2] < xmin )
2361  {
2362  dir = + 1;
2363  }
2364  else
2365  {
2366  if ( n2 == nstart )
2367  {
2368  if ( dir == - 1 )
2369  {
2370  dir = 0;
2371  break;
2372  }
2373  else if ( dir == 0 )
2374  {
2375  x[n2] = x[n2] + 1;
2376  if ( x[n2] <= xmax[n2] )
2377  {
2378  break;
2379  }
2380  else
2381  {
2382  dir = + 1;
2383  }
2384  }
2385  }
2386  else
2387  {
2388  x[n2] = xmin;
2389  }
2390  }
2391  }
2392 //
2393 // DIR = + 1:
2394 // Try moving backwards to find an index N2 whose X we can increment.
2395 //
2396  else if ( dir == + 1 )
2397  {
2398  for ( ; ; )
2399  {
2400  if ( n2 == n - 1 )
2401  {
2402  dir = 0;
2403  *more = false;
2404  delete [] xmax;
2405  break;
2406  }
2407 
2408  n2 = n2 + 1;
2409 
2410  if ( 0.0 < w[n2] )
2411  {
2412  if ( x[n2] < xmax[n2] )
2413  {
2414  x[n2] = x[n2] + 1;
2415  dir = - 1;
2416  break;
2417  }
2418  }
2419  }
2420  }
2421  }
2422  return;
2423 }
2424 
2425 
2426 //**************************************************************************80
2427 double sgmga::sgmga_vcn_coef ( int dim_num,
2428  double level_weight[],
2429  int x[],
2430  double q_max )
2431 //**************************************************************************80
2432 //
2433 // Purpose:
2434 //
2435 // SGMGA_VCN_COEF returns the "next" constrained vector's coefficient.
2436 //
2437 // Discussion:
2438 //
2439 // The related code "SGMGA_VCN_COEF_NAIVE" represents a "naive" approach to
2440 // this calculation. This code carries out the same calculation, but tries
2441 // to avoid the potential explosion in work that is exponential in the
2442 // spatial dimension for the naive approach.
2443 //
2444 // We are considering nonnegative integer vectors X of dimension DIM_NUM
2445 // for which the functional
2446 //
2447 // Q(X) = sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * X(I)
2448 //
2449 // satisfies the "Q" constraint:
2450 //
2451 // Q_MIN < Q(X) <= Q_MAX
2452 //
2453 // where LEVEL_WEIGHT is a vector of (essentially) positive weights.
2454 // Some, but not all of the entries of LEVEL_WEIGHT might be zero;
2455 // in that case, the corresponding values of X never vary, and do not
2456 // play a part in the following computation.
2457 //
2458 // Supposing we have a suitable vector X, we now wish to count the
2459 // number of distinct vectors Y which also satisfy the Q constraint
2460 // as well as the following "binary" constraint:
2461 //
2462 // Y(I) = X(I) + B(I)
2463 //
2464 // where every entry of B is 0 or 1.
2465 //
2466 // Clearly, there are 2^DIM_NUM vectors Y which satisfy the binary
2467 // constraint, and a naive calculation would simply generate each
2468 // possible Y, evaluate Q(Y), and if Y satisfies the Q constraint,
2469 // add it to the count.
2470 //
2471 // But if we are considering even moderately large values of DIM_NUM,
2472 // say 20 <= DIM_NUM, then the mere task of generating all possible
2473 // Y vectors is burdensome. If there are in fact likely to be only
2474 // a few satisfactory Y vectors, (which depends on the values of
2475 // Q_MIN, Q_MAX, and LEVEL_WEIGHT, of course) then it may be possible to
2476 // find and count them more rapidly.
2477 //
2478 // This function attempts a more rapid computation by carrying out the
2479 // search in a particular order, and realizing that, in certain cases,
2480 // if a particular value Y* does not satisfy the Q constraint, then
2481 // a consecutive sequence of Y's following Y* also cannot satisfy the
2482 // constraint, and hence the search can jump over them.
2483 //
2484 // Example:
2485 //
2486 // DIM_NUM = 3
2487 // LEVEL_WEIGHT 3.0 2.0 1.0
2488 // Q_MAX 6.0
2489 //
2490 // U = unsigned count
2491 // S = signed count returned as COEF
2492 //
2493 // # U S X1 X2 X3
2494 //
2495 // 1 8 0 0 0 0
2496 // 2 7 1 0 0 1
2497 // 3 6 0 0 0 2
2498 // 4 5 -1 0 0 3
2499 // 5 3 -1 0 0 4
2500 // 6 2 0 0 0 5
2501 // 7 1 1 0 0 6
2502 // 8 6 0 0 1 0
2503 // 9 5 -1 0 1 1
2504 // 10 3 -1 0 1 2
2505 // 11 2 0 0 1 3
2506 // 12 1 1 0 1 4
2507 // 13 3 -1 0 2 0
2508 // 14 2 0 0 2 1
2509 // 15 1 1 0 2 2
2510 // 16 1 1 0 3 0
2511 // 17 5 -1 1 0 0
2512 // 18 3 -1 1 0 1
2513 // 19 2 0 1 0 2
2514 // 20 1 1 1 0 3
2515 // 21 2 0 1 1 0
2516 // 22 1 1 1 1 1
2517 // 23 1 1 2 0 0
2518 //
2519 // Licensing:
2520 //
2521 // This code is distributed under the GNU LGPL license.
2522 //
2523 // Modified:
2524 //
2525 // 15 May 2010
2526 //
2527 // Author:
2528 //
2529 // John Burkardt
2530 //
2531 // Reference:
2532 //
2533 // Fabio Nobile, Raul Tempone, Clayton Webster,
2534 // A Sparse Grid Stochastic Collocation Method for Partial Differential
2535 // Equations with Random Input Data,
2536 // SIAM Journal on Numerical Analysis,
2537 // Volume 46, Number 5, 2008, pages 2309-2345.
2538 //
2539 // Fabio Nobile, Raul Tempone, Clayton Webster,
2540 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
2541 // Differential Equations with Random Input Data,
2542 // SIAM Journal on Numerical Analysis,
2543 // Volume 46, Number 5, 2008, pages 2411-2442.
2544 //
2545 // Parameters:
2546 //
2547 // Input, int DIM_NUM, the spatial dimension.
2548 //
2549 // Input, double LEVEL_WEIGHT[DIM_NUM], the weights.
2550 //
2551 // Input, int X[DIM_NUM], satisfies the Q constraint.
2552 //
2553 // Input, double Q_MAX, the Q constraint maximum.
2554 //
2555 // Output, double SGMGA_VCN_COEF, the combinatorial coefficient.
2556 //
2557 {
2558  int *b;
2559  int b_sum;
2560  int c;
2561  double coef;
2562  int i;
2563  int j;
2564  double q;
2565 
2566  c = 0;
2567  b = new int[dim_num];
2568 
2569  for ( i = 0; i < dim_num; i++ )
2570  {
2571  b[i] = 0;
2572  }
2573 
2574  for ( ; ; )
2575  {
2576 //
2577 // Generate the next binary perturbation.
2578 //
2579  i = - 1;
2580 
2581  while ( i < dim_num - 1 )
2582  {
2583  i = i + 1;
2584 //
2585 // If LEVEL_WEIGHT(I) == 0, B(I) is fixed at 0. Next I.
2586 //
2587  if ( level_weight[i] == 0.0 )
2588  {
2589  }
2590 //
2591 // If B(I) is 1, set it to 0. Next I.
2592 //
2593  else if ( b[i] == 1 )
2594  {
2595  b[i] = 0;
2596  }
2597 //
2598 // B(I) is 0. Convert it to 1.
2599 //
2600  else
2601  {
2602  b[i] = 1;
2603 
2604  for ( ; ; )
2605  {
2606 //
2607 // Does X + B satisfy the Q_MAX constraint?
2608 //
2609  q = 0.0;
2610  for ( j = 0; j < dim_num; j++ )
2611  {
2612  q = q + level_weight[j] * ( double ) ( x[j] + b[j] );
2613  }
2614  if ( q <= q_max )
2615  {
2616  break;
2617  }
2618 //
2619 // If Q(X+B) now exceeds QMAX, B is rejected. But we can also skip
2620 // all perturbations which agree with B through the I-th position.
2621 // To skip to the next "interesting" candidate, we essentially carry
2622 // out binary addition between B and a vector B' which has a single 1
2623 // in the I-th position.
2624 //
2625  b[i] = 0;
2626 
2627  while ( i < dim_num - 1 )
2628  {
2629  i = i + 1;
2630 
2631  if ( level_weight[i] == 0.0 )
2632  {
2633  }
2634  else if ( b[i] == 1 )
2635  {
2636  b[i] = 0;
2637  }
2638  else
2639  {
2640  b[i] = 1;
2641  break;
2642  }
2643  }
2644  }
2645  break;
2646  }
2647  }
2648  b_sum = 0;
2649  for ( j = 0; j < dim_num; j++ )
2650  {
2651  b_sum = b_sum + b[j];
2652  }
2653 //
2654 // X+B is another solution to be counted.
2655 //
2656  c = c + 1 - 2 * ( b_sum % 2 );
2657 //
2658 // We're done if we've got back to 0.
2659 //
2660  if ( b_sum == 0 )
2661  {
2662  break;
2663  }
2664  }
2665  coef = ( double ) ( c );
2666  delete [] b;
2667 
2668  return coef;
2669 }
2670 
2671 
2672 //**************************************************************************80
2673 double sgmga::sgmga_vcn_coef_naive ( int dim_num,
2674  double level_weight[],
2675  int x_max[],
2676  int x[],
2677  double q_min,
2678  double q_max )
2679 //**************************************************************************80
2680 //
2681 // Purpose:
2682 //
2683 // SGMGA_VCN_COEF_NAIVE returns the "next" constrained vector's coefficient.
2684 //
2685 // Discussion:
2686 //
2687 // This function uses a naive approach to the computation, resulting in
2688 // a set of 2^DIM_NUM tasks. Hence it is not suitable for cases where
2689 // DIM_NUM is moderately large. The function SGMGA_VCN_COEF carries out
2690 // a more complicated but more efficient algorithm for the same computation.
2691 //
2692 // We are given a vector X of dimension DIM_NUM which satisfies:
2693 //
2694 // 0 <= X(1:DIM_NUM) <= X_MAX(1:DIM_NUM).
2695 //
2696 // and the following constraint:
2697 //
2698 // sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * X(I) <= Q_MAX
2699 //
2700 // This routine computes the appropriate coefficient for X in the
2701 // anisotropic sparse grid scheme.
2702 //
2703 // The coefficient is calculated as follows:
2704 //
2705 // Let B be a binary vector of length DIM_NUM, and let ||B|| represent
2706 // the sum of the entries of B.
2707 //
2708 // Coef = sum ( all B such that X+B satisfies constraints ) (-1)^||B||
2709 //
2710 // Since X+0 satisfies the constraint, there is always at least one
2711 // summand.
2712 //
2713 // Licensing:
2714 //
2715 // This code is distributed under the GNU LGPL license.
2716 //
2717 // Modified:
2718 //
2719 // 18 May 2010
2720 //
2721 // Author:
2722 //
2723 // John Burkardt
2724 //
2725 // Reference:
2726 //
2727 // Fabio Nobile, Raul Tempone, Clayton Webster,
2728 // A Sparse Grid Stochastic Collocation Method for Partial Differential
2729 // Equations with Random Input Data,
2730 // SIAM Journal on Numerical Analysis,
2731 // Volume 46, Number 5, 2008, pages 2309-2345.
2732 //
2733 // Fabio Nobile, Raul Tempone, Clayton Webster,
2734 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
2735 // Differential Equations with Random Input Data,
2736 // SIAM Journal on Numerical Analysis,
2737 // Volume 46, Number 5, 2008, pages 2411-2442.
2738 //
2739 // Parameters:
2740 //
2741 // Input, int DIM_NUM, the number of components in the vector.
2742 //
2743 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
2744 //
2745 // Input, int X_MAX[DIM_NUM], the maximum values allowed in each component.
2746 //
2747 // Input, int X[DIM_NUM], a point which satisifies the constraints.
2748 //
2749 // Input, double Q_MIN, Q_MAX, the lower and upper limits on the sum.
2750 //
2751 // Output, double SGMGA_VCN_COEF_NAIVE, the combinatorial coefficient.
2752 //
2753 {
2754  int *b;
2755  int b_sum;
2756  double coef;
2757  int i;
2758  double q;
2759  bool too_big;
2760 
2761  b = new int[dim_num];
2762 
2763  for ( i = 0; i < dim_num; i++ )
2764  {
2765  b[i] = 0;
2766  }
2767  coef = 1.0;
2768 
2769  for ( ; ; )
2770  {
2771 //
2772 // Generate the next binary perturbation.
2773 //
2774  webbur->binary_vector_next ( dim_num, b );
2775  b_sum = webbur->i4vec_sum ( dim_num, b );
2776 //
2777 // We're done if we've got back to 0.
2778 //
2779  if ( b_sum == 0 )
2780  {
2781  break;
2782  }
2783 //
2784 // Does it satisfy the XMAX constraint?
2785 // (THIS CHECK IS SURPRISINGLY NECESSARY, PARTLY BECAUSE OF ZERO WEIGHT).
2786 //
2787  too_big = false;
2788  for ( i = 0; i < dim_num; i++ )
2789  {
2790  if ( x_max[i] < x[i] + b[i] )
2791  {
2792  too_big = true;
2793  break;
2794  }
2795  }
2796  if ( too_big )
2797  {
2798  continue;
2799  }
2800 //
2801 // Does it satisfy the Q_MAX constraint?
2802 //
2803  q = 0.0;
2804  for ( i = 0; i < dim_num; i++ )
2805  {
2806  q = q + level_weight[i] * ( double ) ( x[i] + b[i] );
2807  }
2808 
2809  if ( q <= q_max )
2810  {
2811  coef = coef + webbur->r8_mop ( b_sum );
2812  }
2813  }
2814 
2815  delete [] b;
2816 
2817  return coef;
2818 }
2819 
2820 
2821 //**************************************************************************80
2822 void sgmga::sgmga_vcn_naive ( int dim_num,
2823  double level_weight[],
2824  int x_max[],
2825  int x[],
2826  double q_min,
2827  double q_max,
2828  bool *more )
2829 //**************************************************************************80
2830 //
2831 // Purpose:
2832 //
2833 // SGMGA_VCN_NAIVE returns the next constrained vector.
2834 //
2835 // Discussion:
2836 //
2837 // This function uses a naive algorithm, which quickly becomes unsuitable
2838 // for higher dimensions. The function SGMGA_VCN is an attempt at a more
2839 // efficient calculation of the same quantities.
2840 //
2841 // We consider vectors X of dimension DIM_NUM satisfying:
2842 //
2843 // 0 <= X(1:DIM_NUM) <= X_MAX(1:DIM_NUM).
2844 //
2845 // and define
2846 //
2847 // Q = sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * X(I)
2848 //
2849 // and seek X satisfying the constraint:
2850 //
2851 // Q_MIN < Q <= Q_MAX
2852 //
2853 // For sparse grid applications, we compute
2854 //
2855 // LEVEL_WEIGHT_MIN_POS = minimum positive entry in LEVEL_WEIGHT
2856 //
2857 // and assume there is an underlying LEVEL used to index the sets of
2858 // constrained vectors, and that
2859 //
2860 // Q_MAX = LEVEL * LEVEL_WEIGHT_MIN_POS
2861 // Q_MIN = LEVEL - LEVEL_WEIGHT_MIN_POS * sum ( LEVEL_WEIGHT(:) )
2862 // X_MAX(I) = LEVEL * LEVEL_WEIGHT_MIN_POS / LEVEL_WEIGHT(I)
2863 //
2864 // This routine returns, one at a time exactly those X which satisfy
2865 // the constraint. No attempt is made to return the X values in
2866 // any particular order as far as Q goes.
2867 //
2868 // Example:
2869 //
2870 // LEVEL_WEIGHT: 1.000000 1.000000
2871 //
2872 // Q_MIN: 0.000000
2873 // Q_MAX: 2.000000
2874 // X_MAX: 2 2
2875 //
2876 // 1 1.000000 1 0
2877 // 2 2.000000 2 0
2878 // 3 1.000000 0 1
2879 // 4 2.000000 1 1
2880 // 5 2.000000 0 2
2881 //
2882 // LEVEL_WEIGHT: 1.000000 2.000000
2883 //
2884 // Q_MIN: -1.000000
2885 // Q_MAX: 2.000000
2886 // X_MAX: 2 1
2887 //
2888 // 1 0.000000 0 0
2889 // 2 1.000000 1 0
2890 // 3 2.000000 2 0
2891 // 4 2.000000 0 1
2892 //
2893 // Licensing:
2894 //
2895 // This code is distributed under the GNU LGPL license.
2896 //
2897 // Modified:
2898 //
2899 // 30 October 2009
2900 //
2901 // Author:
2902 //
2903 // John Burkardt
2904 //
2905 // Reference:
2906 //
2907 // Fabio Nobile, Raul Tempone, Clayton Webster,
2908 // A Sparse Grid Stochastic Collocation Method for Partial Differential
2909 // Equations with Random Input Data,
2910 // SIAM Journal on Numerical Analysis,
2911 // Volume 46, Number 5, 2008, pages 2309-2345.
2912 //
2913 // Fabio Nobile, Raul Tempone, Clayton Webster,
2914 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
2915 // Differential Equations with Random Input Data,
2916 // SIAM Journal on Numerical Analysis,
2917 // Volume 46, Number 5, 2008, pages 2411-2442.
2918 //
2919 // Parameters:
2920 //
2921 // Input, int DIM_NUM, the number of components in the vector.
2922 //
2923 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
2924 //
2925 // Input, int X_MAX[DIM_NUM], the maximum values allowed in each component.
2926 //
2927 // Input/output, int X[DIM_NUM]. On first call (with MORE = FALSE),
2928 // the input value of X is not important. On subsequent calls, the
2929 // input value of X should be the output value from the previous call.
2930 // On output, (with MORE = TRUE), the value of X will be the "next"
2931 // vector in the reverse lexicographical list of vectors that satisfy
2932 // the condition. However, on output with MORE = FALSE, the vector
2933 // X is meaningless, because there are no more vectors in the list.
2934 //
2935 // Input, double Q_MIN, Q_MAX, the lower and upper
2936 // limits on the sum.
2937 //
2938 // Input/output, bool *MORE. On input, if the user has set MORE
2939 // FALSE, the user is requesting the initiation of a new sequence
2940 // of values. If MORE is TRUE, then the user is requesting "more"
2941 // values in the current sequence. On output, if MORE is TRUE,
2942 // then another value was found and returned in X, but if MORE is
2943 // FALSE, then there are no more values in the sequence, and X is
2944 // NOT the next value.
2945 //
2946 {
2947  int i;
2948  int j;
2949  double q;
2950 
2951  if ( ! ( *more ) )
2952  {
2953  *more = true;
2954  for ( i = 0; i < dim_num; i++ )
2955  {
2956  x[i] = 0;
2957  }
2958 
2959  q = 0.0;
2960  for ( i = 0; i < dim_num; i++ )
2961  {
2962  q = q + level_weight[i] * ( double ) ( x[i] );
2963  }
2964 
2965  if ( q_min < q && q <= q_max )
2966  {
2967  return;
2968  }
2969  }
2970 
2971  for ( ; ; )
2972  {
2973  j = 0;
2974 
2975  for ( ; ; )
2976  {
2977  if ( x[j] < x_max[j] )
2978  {
2979  break;
2980  }
2981 
2982  if ( dim_num - 1 <= j )
2983  {
2984  *more = false;
2985  return;
2986  }
2987  j = j + 1;
2988  }
2989 
2990  x[j] = x[j] + 1;
2991  for ( i = 0; i < j; i++ )
2992  {
2993  x[i] = 0;
2994  }
2995 
2996  q = 0.0;
2997  for ( i = 0; i < dim_num; i++ )
2998  {
2999  q = q + level_weight[i] * ( double ) ( x[i] );
3000  }
3001 
3002  if ( q_min < q && q <= q_max )
3003  {
3004  break;
3005  }
3006  }
3007 
3008  return;
3009 }
3010 
3011 
3012 //**************************************************************************80
3013 void sgmga::sgmga_vcn_ordered ( int dim_num,
3014  double level_weight[],
3015  int x_max[],
3016  int x[],
3017  double q_min,
3018  double q_max,
3019  bool *more )
3020 //**************************************************************************80
3021 //
3022 // Purpose:
3023 //
3024 // SGMGA_VCN_ORDERED returns the "next" constrained vector, with ordering.
3025 //
3026 // Discussion:
3027 //
3028 // We consider vectors X of dimension DIM_NUM satisfying:
3029 //
3030 // 0 <= X(1:DIM_NUM) <= X_MAX(1:DIM_NUM).
3031 //
3032 // and define
3033 //
3034 // Q = sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * X(I)
3035 //
3036 // and seek X's satisfying the constraint:
3037 //
3038 // Q_MIN < Q <= Q_MAX
3039 //
3040 // For sparse grid applications, we compute
3041 //
3042 // LEVEL_WEIGHT_MIN_POS = minimum positive entry in LEVEL_WEIGHT
3043 //
3044 // and assume there is an underlying LEVEL used to index the sets of
3045 // constrained vectors, and that
3046 //
3047 // Q_MAX = LEVEL * LEVEL_WEIGHT_MIN_POS
3048 // Q_MIN = LEVEL - LEVEL_WEIGHT_MIN_POS * sum ( LEVEL_WEIGHT(:) )
3049 // X_MAX(I) = LEVEL * LEVEL_WEIGHT_MIN_POS / LEVEL_WEIGHT(I)
3050 //
3051 // This function returns, one at a time exactly those X which satisfy
3052 // the constraint.
3053 //
3054 // A weak ordering is imposed on the solution vectors. This function
3055 // subdivides the range Q_MIN through Q_MAX into subintervals of width 1, so
3056 // that the X vectors returned are roughly sorted (or at least binned)
3057 // by Q value.
3058 //
3059 // Example:
3060 //
3061 // If the weights are also integral, then the X vectors are in fact SORTED
3062 // by Q value:
3063 //
3064 // LEVEL_WEIGHT: 1.000000 1.000000
3065 // Q_MIN: 0.000000
3066 // Q_MAX: 2.000000
3067 // X_MAX: 2 2
3068 //
3069 // 1 1.000000 1 0
3070 // 2 1.000000 0 1
3071 // 3 2.000000 2 0
3072 // 4 2.000000 1 1
3073 // 5 2.000000 0 2
3074 //
3075 // When the weights are not integral, then the X values are only BINNED
3076 // by Q value, that is, we first get all X's with Q values between Q_MIN
3077 // and Q_MIN+1, then Q_MIN+1 to Q_MIN+2 and so on, as demonstrated here:
3078 //
3079 // LEVEL_WEIGHT: 1.5 1
3080 // Q_MIN: 0.5
3081 // Q_MAX: 3
3082 // X_MAX: 2 3
3083 //
3084 // 1 1.5 1 0
3085 // 2 1 0 1
3086 // 3 2.5 1 1
3087 // 4 2 0 2
3088 // 5 3 2 0
3089 // 6 3 0 3
3090 //
3091 // Licensing:
3092 //
3093 // This code is distributed under the GNU LGPL license.
3094 //
3095 // Modified:
3096 //
3097 // 21 May 2010
3098 //
3099 // Author:
3100 //
3101 // John Burkardt
3102 //
3103 // Reference:
3104 //
3105 // Fabio Nobile, Raul Tempone, Clayton Webster,
3106 // A Sparse Grid Stochastic Collocation Method for Partial Differential
3107 // Equations with Random Input Data,
3108 // SIAM Journal on Numerical Analysis,
3109 // Volume 46, Number 5, 2008, pages 2309-2345.
3110 //
3111 // Fabio Nobile, Raul Tempone, Clayton Webster,
3112 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
3113 // Differential Equations with Random Input Data,
3114 // SIAM Journal on Numerical Analysis,
3115 // Volume 46, Number 5, 2008, pages 2411-2442.
3116 //
3117 // Parameters:
3118 //
3119 // Input, int DIM_NUM, the number of components in the vector.
3120 //
3121 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
3122 //
3123 // Input, int X_MAX[DIM_NUM], the maximum values allowed in each component.
3124 //
3125 // Input/output, int X[DIM_NUM]. On first call (with MORE = FALSE),
3126 // the input value of X is not important. On subsequent calls, the
3127 // input value of X should be the output value from the previous call.
3128 // On output, (with MORE = TRUE), the value of X will be the "next"
3129 // vector in the reverse lexicographical list of vectors that satisfy
3130 // the condition. However, on output with MORE = FALSE, the vector
3131 // X is meaningless, because there are no more vectors in the list.
3132 //
3133 // Input, double Q_MIN, Q_MAX, the lower and upper
3134 // limits on the sum.
3135 //
3136 // Input/output, bool *MORE. On input, if the user has set MORE
3137 // FALSE, the user is requesting the initiation of a new sequence
3138 // of values. If MORE is TRUE, then the user is requesting "more"
3139 // values in the current sequence. On output, if MORE is TRUE,
3140 // then another value was found and returned in X, but if MORE is
3141 // FALSE, then there are no more values in the sequence, and X is
3142 // NOT the next value.
3143 //
3144 {
3145  //double q;
3146  static double q_max2;
3147  static double q_min2;
3148 //
3149 // On first call, initialize the subrange.
3150 //
3151  if ( !(*more) )
3152  {
3153  q_min2 = q_min;
3154  q_max2 = webbur->r8_min ( q_min + 1.0, q_max );
3155  }
3156 //
3157 // Call a lower level function to search the subrange.
3158 //
3159  for ( ; ; )
3160  {
3161  sgmga_vcn ( dim_num, level_weight, x, q_min2, q_max2, more );
3162 //
3163 // If another solution was found, return it.
3164 //
3165  if ( *more )
3166  {
3167  return;
3168  }
3169 //
3170 // If the current subrange is exhausted, try to move to the next one.
3171 //
3172  if ( q_max2 < q_max )
3173  {
3174  q_min2 = q_max2;
3175  q_max2 = webbur->r8_min ( q_max2 + 1.0, q_max );
3176  }
3177 //
3178 // If there are no more subranges, we're done.
3179 //
3180  else
3181  {
3182  break;
3183  }
3184  }
3185 
3186  return;
3187 }
3188 
3189 
3190 //**************************************************************************80
3192  double level_weight[],
3193  int x_max[],
3194  int x[],
3195  double q_min,
3196  double q_max,
3197  bool *more )
3198 //**************************************************************************80
3199 //
3200 // Purpose:
3201 //
3202 // SGMGA_VCN_ORDERED_NAIVE returns the "next" constrained vector, with ordering.
3203 //
3204 // Discussion:
3205 //
3206 // We consider vectors X of dimension DIM_NUM satisfying:
3207 //
3208 // 0 <= X(1:DIM_NUM) <= X_MAX(1:DIM_NUM).
3209 //
3210 // and define
3211 //
3212 // Q = sum ( 1 <= I <= DIM_NUM ) LEVEL_WEIGHT(I) * X(I)
3213 //
3214 // and seek X's satisfying the constraint:
3215 //
3216 // Q_MIN < Q <= Q_MAX
3217 //
3218 // For sparse grid applications, we compute
3219 //
3220 // LEVEL_WEIGHT_MIN_POS = minimum positive entry in LEVEL_WEIGHT
3221 //
3222 // and assume there is an underlying LEVEL used to index the sets of
3223 // constrained vectors, and that
3224 //
3225 // Q_MAX = LEVEL * LEVEL_WEIGHT_MIN_POS
3226 // Q_MIN = LEVEL - LEVEL_WEIGHT_MIN_POS * sum ( LEVEL_WEIGHT(:) )
3227 // X_MAX(I) = LEVEL * LEVEL_WEIGHT_MIN_POS / LEVEL_WEIGHT(I)
3228 //
3229 // This function returns, one at a time exactly those X which satisfy
3230 // the constraint.
3231 //
3232 // A weak ordering is imposed on the solution vectors. This function
3233 // subdivides the range Q_MIN through Q_MAX into subintervals of width 1, so
3234 // that the X vectors returned are roughly sorted (or at least binned)
3235 // by Q value.
3236 //
3237 // Example:
3238 //
3239 // If the weights are also integral, then the X vectors are in fact SORTED
3240 // by Q value:
3241 //
3242 // LEVEL_WEIGHT: 1.000000 1.000000
3243 // Q_MIN: 0.000000
3244 // Q_MAX: 2.000000
3245 // X_MAX: 2 2
3246 //
3247 // 1 1.000000 1 0
3248 // 2 1.000000 0 1
3249 // 3 2.000000 2 0
3250 // 4 2.000000 1 1
3251 // 5 2.000000 0 2
3252 //
3253 // When the weights are not integral, then the X values are only BINNED
3254 // by Q value, that is, we first get all X's with Q values between Q_MIN
3255 // and Q_MIN+1, then Q_MIN+1 to Q_MIN+2 and so on, as demonstrated here:
3256 //
3257 // LEVEL_WEIGHT: 1.5 1
3258 // Q_MIN: 0.5
3259 // Q_MAX: 3
3260 // X_MAX: 2 3
3261 //
3262 // 1 1.5 1 0
3263 // 2 1 0 1
3264 // 3 2.5 1 1
3265 // 4 2 0 2
3266 // 5 3 2 0
3267 // 6 3 0 3
3268 //
3269 // Licensing:
3270 //
3271 // This code is distributed under the GNU LGPL license.
3272 //
3273 // Modified:
3274 //
3275 // 30 October 2009
3276 //
3277 // Author:
3278 //
3279 // John Burkardt
3280 //
3281 // Reference:
3282 //
3283 // Fabio Nobile, Raul Tempone, Clayton Webster,
3284 // A Sparse Grid Stochastic Collocation Method for Partial Differential
3285 // Equations with Random Input Data,
3286 // SIAM Journal on Numerical Analysis,
3287 // Volume 46, Number 5, 2008, pages 2309-2345.
3288 //
3289 // Fabio Nobile, Raul Tempone, Clayton Webster,
3290 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
3291 // Differential Equations with Random Input Data,
3292 // SIAM Journal on Numerical Analysis,
3293 // Volume 46, Number 5, 2008, pages 2411-2442.
3294 //
3295 // Parameters:
3296 //
3297 // Input, int DIM_NUM, the number of components in the vector.
3298 //
3299 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
3300 //
3301 // Input, int X_MAX[DIM_NUM], the maximum values allowed in each component.
3302 //
3303 // Input/output, int X[DIM_NUM]. On first call (with MORE = FALSE),
3304 // the input value of X is not important. On subsequent calls, the
3305 // input value of X should be the output value from the previous call.
3306 // On output, (with MORE = TRUE), the value of X will be the "next"
3307 // vector in the reverse lexicographical list of vectors that satisfy
3308 // the condition. However, on output with MORE = FALSE, the vector
3309 // X is meaningless, because there are no more vectors in the list.
3310 //
3311 // Input, double Q_MIN, Q_MAX, the lower and upper
3312 // limits on the sum.
3313 //
3314 // Input/output, bool *MORE. On input, if the user has set MORE
3315 // FALSE, the user is requesting the initiation of a new sequence
3316 // of values. If MORE is TRUE, then the user is requesting "more"
3317 // values in the current sequence. On output, if MORE is TRUE,
3318 // then another value was found and returned in X, but if MORE is
3319 // FALSE, then there are no more values in the sequence, and X is
3320 // NOT the next value.
3321 //
3322 {
3323  //double q;
3324  static double q_max2;
3325  static double q_min2;
3326 //
3327 // On first call, initialize the subrange.
3328 //
3329  if ( !(*more) )
3330  {
3331  q_min2 = q_min;
3332  q_max2 = webbur->r8_min ( q_min + 1.0, q_max );
3333  }
3334 //
3335 // Call a lower level function to search the subrange.
3336 //
3337  for ( ; ; )
3338  {
3339  sgmga_vcn_naive ( dim_num, level_weight, x_max, x, q_min2, q_max2,
3340  more );
3341 //
3342 // If another solution was found, return it.
3343 //
3344  if ( *more )
3345  {
3346  return;
3347  }
3348 //
3349 // If the current subrange is exhausted, try to move to the next one.
3350 //
3351  if ( q_max2 < q_max )
3352  {
3353  q_min2 = q_max2;
3354  q_max2 = webbur->r8_min ( q_max2 + 1.0, q_max );
3355  }
3356 //
3357 // If there are no more subranges, we're done.
3358 //
3359  else
3360  {
3361  break;
3362  }
3363  }
3364 
3365  return;
3366 }
3367 
3368 
3369 //**************************************************************************80
3370 void sgmga::sgmga_weight ( int dim_num,
3371  double level_weight[],
3372  int level_max,
3373  int rule[],
3374  int np[],
3375  double p[],
3376  void ( *gw_compute_weights[] ) ( int order,
3377  int np,
3378  double p[],
3379  double w[] ),
3380  int point_num,
3381  int point_total_num,
3382  int sparse_unique_index[],
3383  int growth[],
3384  double sparse_weight[] )
3385 //**************************************************************************80
3386 //
3387 // Purpose:
3388 //
3389 // SGMGA_WEIGHT computes weights for an SGMGA grid.
3390 //
3391 // Discussion:
3392 //
3393 // The user must preallocate space for the output array SPARSE_WEIGHT.
3394 //
3395 // Licensing:
3396 //
3397 // This code is distributed under the GNU LGPL license.
3398 //
3399 // Modified:
3400 //
3401 // 26 April 2011
3402 //
3403 // Author:
3404 //
3405 // John Burkardt
3406 //
3407 // Reference:
3408 //
3409 // Fabio Nobile, Raul Tempone, Clayton Webster,
3410 // A Sparse Grid Stochastic Collocation Method for Partial Differential
3411 // Equations with Random Input Data,
3412 // SIAM Journal on Numerical Analysis,
3413 // Volume 46, Number 5, 2008, pages 2309-2345.
3414 //
3415 // Fabio Nobile, Raul Tempone, Clayton Webster,
3416 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
3417 // Differential Equations with Random Input Data,
3418 // SIAM Journal on Numerical Analysis,
3419 // Volume 46, Number 5, 2008, pages 2411-2442.
3420 //
3421 // Parameters:
3422 //
3423 // Input, int DIM_NUM, the spatial dimension.
3424 //
3425 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
3426 //
3427 // Input, int LEVEL_MAX, the maximum value of LEVEL.
3428 //
3429 // Input, int RULE[DIM_NUM], the rule in each dimension.
3430 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
3431 // 2, "F2", Fejer Type 2, Open Fully Nested.
3432 // 3, "GP", Gauss Patterson, Open Fully Nested.
3433 // 4, "GL", Gauss Legendre, Open Weakly Nested.
3434 // 5, "GH", Gauss Hermite, Open Weakly Nested.
3435 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
3436 // 7, "LG", Gauss Laguerre, Open Non Nested.
3437 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
3438 // 9, "GJ", Gauss Jacobi, Open Non Nested.
3439 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
3440 // 11, "UO", User supplied Open, presumably Non Nested.
3441 // 12, "UC", User supplied Closed, presumably Non Nested.
3442 //
3443 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
3444 //
3445 // Input, double P[sum(NP[*])], the parameters needed by each rule.
3446 //
3447 // Input, void ( *GW_COMPUTE_WEIGHTS[] ) ( int order, int np, double p[], double w[] ),
3448 // an array of pointers to functions which return the 1D quadrature weights
3449 // associated with each spatial dimension for which a Golub Welsch rule
3450 // is used.
3451 //
3452 // Input, int POINT_NUM, the number of unique points
3453 // in the grid.
3454 //
3455 // Input, int POINT_TOTAL_NUM, the total number of points
3456 // in the grid.
3457 //
3458 // Input, int SPARSE UNIQUE_INDEX[POINT_TOTAL_NUM], lists,
3459 // for each (nonunique) point, the corresponding index of the same point in
3460 // the unique listing.
3461 //
3462 // Input, int GROWTH[DIM_NUM], the desired growth in each dimension.
3463 // 0, "DF", default growth associated with this quadrature rule;
3464 // 1, "SL", slow linear, L+1;
3465 // 2 "SO", slow linear odd, O=1+2((L+1)/2)
3466 // 3, "ML", moderate linear, 2L+1;
3467 // 4, "SE", slow exponential;
3468 // 5, "ME", moderate exponential;
3469 // 6, "FE", full exponential.
3470 //
3471 // Output, double SPARSE_WEIGHT[POINT_NUM], the weights
3472 // associated with the sparse grid points.
3473 //
3474 {
3475  double coef;
3476  int dim;
3477  double *grid_weight;
3478  //int level;
3479  int *level_1d;
3480  int *level_1d_max;
3481  double level_weight_min_pos;
3482  bool more_grids;
3483  int order;
3484  int *order_1d;
3485  int order_nd;
3486  int point;
3487  int point_total;
3488  int point_unique;
3489  double q_max;
3490  double q_min;
3491 
3492  for ( point = 0; point < point_num; point++ )
3493  {
3494  sparse_weight[point] = 0.0;
3495  }
3496 
3497  point_total = 0;
3498 
3499  level_1d = new int[dim_num];
3500  order_1d = new int[dim_num];
3501  level_1d_max = new int[dim_num];
3502 //
3503 // Initialization for SGMGA_VCN_ORDERED.
3504 //
3505  level_weight_min_pos = webbur->r8vec_min_pos ( dim_num, level_weight );
3506  q_min = ( double ) ( level_max ) * level_weight_min_pos
3507  - webbur->r8vec_sum ( dim_num, level_weight );
3508  q_max = ( double ) ( level_max ) * level_weight_min_pos;
3509  for ( dim = 0; dim < dim_num; dim++ )
3510  {
3511  if ( 0.0 < level_weight[dim] )
3512  {
3513  level_1d_max[dim] = (int)webbur->r8_floor(q_max/level_weight[dim]) + 1;
3514  if ( q_max <= ( level_1d_max[dim] - 1 ) * level_weight[dim] )
3515  {
3516  level_1d_max[dim] = level_1d_max[dim] - 1;
3517  }
3518  }
3519  else
3520  {
3521  level_1d_max[dim] = 0;
3522  }
3523  }
3524  more_grids = false;
3525 //
3526 // Seek all vectors LEVEL_1D which satisfy the constraint:
3527 //
3528 // LEVEL_MAX * LEVEL_WEIGHT_MIN_POS - sum ( LEVEL_WEIGHT )
3529 // < sum ( 0 <= I < DIM_NUM ) LEVEL_WEIGHT[I] * LEVEL_1D[I]
3530 // <= LEVEL_MAX * LEVEL_WEIGHT_MIN_POS.
3531 //
3532  for ( ; ; )
3533  {
3534  sgmga_vcn_ordered ( dim_num, level_weight, level_1d_max,
3535  level_1d, q_min, q_max, &more_grids );
3536 
3537  if ( !more_grids )
3538  {
3539  break;
3540  }
3541 //
3542 // Compute the combinatorial coefficient.
3543 //
3544  coef = sgmga_vcn_coef ( dim_num, level_weight, level_1d, q_max );
3545 
3546  if ( coef == 0.0 )
3547  {
3548  continue;
3549  }
3550 //
3551 // Transform each 1D level to a corresponding 1D order.
3552 //
3553  webbur->level_growth_to_order ( dim_num, level_1d, rule, growth, order_1d );
3554 //
3555 // The product of the 1D orders gives us the number of points in this grid.
3556 //
3557  order_nd = webbur->i4vec_product ( dim_num, order_1d );
3558 //
3559 // Compute the weights for this grid.
3560 //
3561 // The correct transfer of data from the product grid to the sparse grid
3562 // depends on the fact that the product rule weights are stored under colex
3563 // order of the points, and this is the same ordering implicitly used in
3564 // generating the SPARSE_UNIQUE_INDEX array.
3565 //
3566  grid_weight = new double[order_nd];
3567 
3568  sgmga_product_weight ( dim_num, order_1d, order_nd, rule,
3569  np, p, gw_compute_weights, grid_weight );
3570 //
3571 // Add these weights to the rule.
3572 //
3573  for ( order = 0; order < order_nd; order++ )
3574  {
3575  point_unique = sparse_unique_index[point_total];
3576 
3577  point_total = point_total + 1;
3578 
3579  sparse_weight[point_unique] = sparse_weight[point_unique]
3580  + coef * grid_weight[order];
3581  }
3582 
3583  delete [] grid_weight;
3584  }
3585 
3586  delete [] level_1d;
3587  delete [] level_1d_max;
3588  delete [] order_1d;
3589 
3590  return;
3591 }
3592 
3593 
3594 //**************************************************************************80
3595 void sgmga::sgmga_write ( int dim_num,
3596  double level_weight[],
3597  int rule[],
3598  int np[],
3599  double p[],
3600  int point_num,
3601  double sparse_weight[],
3602  double sparse_point[],
3603  std::string file_name )
3604 //**************************************************************************80
3605 //
3606 // Purpose:
3607 //
3608 // SGMGA_WRITE writes an SGMGA rule to six files.
3609 //
3610 // Discussion:
3611 //
3612 // The files are:
3613 // * the "A" file stores the anisotropic weights, as a DIM_NUM x 1 list.
3614 // * the "N" file stores the NP values, as a DIM_NUM x 1 list.
3615 // * the "P" file stores the P values, as a sum(NP[*]) x 1 list.
3616 // * the "R" file stores the region, as a DIM_NUM x 2 list;
3617 // * the "W" file stores the weights as a POINT_NUM list;
3618 // * the "X" file stores the abscissas as a DIM_NUM x POINT_NUM list.
3619 //
3620 // The entries in the "R" file are the two corners of the DIM_NUM dimensional
3621 // rectangle that constitutes the integration region. Coordinates that
3622 // should be infinite are set to 1.0E+30.
3623 //
3624 // Licensing:
3625 //
3626 // This code is distributed under the GNU LGPL license.
3627 //
3628 // Modified:
3629 //
3630 // 09 June 2010
3631 //
3632 // Author:
3633 //
3634 // John Burkardt
3635 //
3636 // Reference:
3637 //
3638 // Fabio Nobile, Raul Tempone, Clayton Webster,
3639 // A Sparse Grid Stochastic Collocation Method for Partial Differential
3640 // Equations with Random Input Data,
3641 // SIAM Journal on Numerical Analysis,
3642 // Volume 46, Number 5, 2008, pages 2309-2345.
3643 //
3644 // Fabio Nobile, Raul Tempone, Clayton Webster,
3645 // An Anisotropic Sparse Grid Stochastic Collocation Method for Partial
3646 // Differential Equations with Random Input Data,
3647 // SIAM Journal on Numerical Analysis,
3648 // Volume 46, Number 5, 2008, pages 2411-2442.
3649 //
3650 // Parameters:
3651 //
3652 // Input, int DIM_NUM, the spatial dimension.
3653 //
3654 // Input, double LEVEL_WEIGHT[DIM_NUM], the anisotropic weights.
3655 //
3656 // Input, int RULE[DIM_NUM], the rule in each dimension.
3657 // 1, "CC", Clenshaw Curtis, Closed Fully Nested.
3658 // 2, "F2", Fejer Type 2, Open Fully Nested.
3659 // 3, "GP", Gauss Patterson, Open Fully Nested.
3660 // 4, "GL", Gauss Legendre, Open Weakly Nested.
3661 // 5, "GH", Gauss Hermite, Open Weakly Nested.
3662 // 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
3663 // 7, "LG", Gauss Laguerre, Open Non Nested.
3664 // 8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
3665 // 9, "GJ", Gauss Jacobi, Open Non Nested.
3666 // 10, "HGK", Hermite Genz-Keister, Open Fully Nested.
3667 // 11, "UO", User supplied Open, presumably Non Nested.
3668 // 12, "UC", User supplied Closed, presumably Non Nested.
3669 //
3670 // Input, int NP[DIM_NUM], the number of parameters used by each rule.
3671 //
3672 // Input, double P[sum(NP[*])], the parameters needed by each rule.
3673 //
3674 // Input, int POINT_NUM, the number of unique points
3675 // in the grid.
3676 //
3677 // Input, double SPARSE_WEIGHT[POINT_NUM], the weights.
3678 //
3679 // Input, double SPARSE_POINT[DIM_NUM*POINT_NUM], the points.
3680 //
3681 // Input, string FILE_NAME, the main part of the file name.
3682 //
3683 {
3684  int dim;
3685  std::string file_name_a;
3686  std::string file_name_n;
3687  std::string file_name_p;
3688  std::string file_name_r;
3689  std::string file_name_w;
3690  std::string file_name_x;
3691  int np_sum;
3692  int point;
3693  double *sparse_region;
3694  double t1;
3695  double t2;
3696 
3697  sparse_region = new double[dim_num*2];
3698 
3699  for ( dim = 0; dim < dim_num; dim++ )
3700  {
3701  if ( rule[dim] == 1 )
3702  {
3703  sparse_region[dim+0*dim_num] = -1.0;
3704  sparse_region[dim+1*dim_num] = +1.0;
3705  }
3706  else if ( rule[dim] == 2 )
3707  {
3708  sparse_region[dim+0*dim_num] = -1.0;
3709  sparse_region[dim+1*dim_num] = +1.0;
3710  }
3711  else if ( rule[dim] == 3 )
3712  {
3713  sparse_region[dim+0*dim_num] = -1.0;
3714  sparse_region[dim+1*dim_num] = +1.0;
3715  }
3716  else if ( rule[dim] == 4 )
3717  {
3718  sparse_region[dim+0*dim_num] = -1.0;
3719  sparse_region[dim+1*dim_num] = +1.0;
3720  }
3721  else if ( rule[dim] == 5 )
3722  {
3723  sparse_region[dim+0*dim_num] = - webbur->r8_huge ( );
3724  sparse_region[dim+1*dim_num] = + webbur->r8_huge ( );
3725  }
3726  else if ( rule[dim] == 6 )
3727  {
3728  sparse_region[dim+0*dim_num] = - webbur->r8_huge ( );
3729  sparse_region[dim+1*dim_num] = + webbur->r8_huge ( );
3730  }
3731  else if ( rule[dim] == 7 )
3732  {
3733  sparse_region[dim+0*dim_num] = 0.0;
3734  sparse_region[dim+1*dim_num] = webbur->r8_huge ( );
3735  }
3736  else if ( rule[dim] == 8 )
3737  {
3738  sparse_region[dim+0*dim_num] = 0.0;
3739  sparse_region[dim+1*dim_num] = webbur->r8_huge ( );
3740  }
3741  else if ( rule[dim] == 9 )
3742  {
3743  sparse_region[dim+0*dim_num] = -1.0;
3744  sparse_region[dim+1*dim_num] = +1.0;
3745  }
3746  else if ( rule[dim] == 10 )
3747  {
3748  sparse_region[dim+0*dim_num] = - webbur->r8_huge ( );
3749  sparse_region[dim+1*dim_num] = + webbur->r8_huge ( );
3750  }
3751 //
3752 // Best guess as to region extent for rules of type 11 or 12.
3753 //
3754  else if ( rule[dim] == 11 )
3755  {
3756  t1 = webbur->r8_huge ( );
3757  t2 = - webbur->r8_huge ( );
3758  for ( point = 0; point < point_num; point++ )
3759  {
3760  t1 = webbur->r8_min ( t1, sparse_point[dim+point*dim_num] );
3761  t2 = webbur->r8_max ( t2, sparse_point[dim+point*dim_num] );
3762  }
3763  sparse_region[dim+0*dim_num] = t1;
3764  sparse_region[dim+1*dim_num] = t2;
3765  }
3766  else if ( rule[dim] == 12 )
3767  {
3768  t1 = webbur->r8_huge ( );
3769  t2 = - webbur->r8_huge ( );
3770  for ( point = 0; point < point_num; point++ )
3771  {
3772  t1 = webbur->r8_min ( t1, sparse_point[dim+point*dim_num] );
3773  t2 = webbur->r8_max ( t2, sparse_point[dim+point*dim_num] );
3774  }
3775  sparse_region[dim+0*dim_num] = t1;
3776  sparse_region[dim+1*dim_num] = t2;
3777  }
3778  else
3779  {
3780  std::cerr << "\n";
3781  std::cerr << "SGMGA_WRITE - Fatal error!\n";
3782  std::cerr << " Unexpected value of RULE[" << dim << "] = "
3783  << rule[dim] << ".\n";
3784  std::exit ( 1 );
3785  }
3786  }
3787  std::cout << "\n";
3788  std::cout << "SGMGA_WRITE:\n";
3789 
3790  file_name_a = file_name + "_a.txt";
3791  webbur->r8mat_write ( file_name_a, 1, dim_num, level_weight );
3792  std::cout << " Wrote the A file = \"" << file_name_a << "\".\n";
3793 
3794  file_name_n = file_name + "_n.txt";
3795  webbur->i4mat_write ( file_name_n, 1, dim_num, np );
3796  std::cout << " Wrote the N file = \"" << file_name_n << "\".\n";
3797 
3798  np_sum = webbur->i4vec_sum ( dim_num, np );
3799  file_name_p = file_name + "_p.txt";
3800  webbur->r8mat_write ( file_name_p, 1, np_sum, p );
3801  std::cout << " Wrote the P file = \"" << file_name_p << "\".\n";
3802 
3803  file_name_r = file_name + "_r.txt";
3804  webbur->r8mat_write ( file_name_r, dim_num, 2, sparse_region );
3805  std::cout << " Wrote the R file = \"" << file_name_r << "\".\n";
3806 
3807  file_name_w = file_name + "_w.txt";
3808  webbur->r8mat_write ( file_name_w, 1, point_num, sparse_weight );
3809  std::cout << " Wrote the W file = \"" << file_name_w << "\".\n";
3810 
3811  file_name_x = file_name + "_x.txt";
3812  webbur->r8mat_write ( file_name_x, dim_num, point_num, sparse_point );
3813  std::cout << " Wrote the X file = \"" << file_name_x << "\".\n";
3814 
3815  delete [] sparse_region;
3816 
3817  return;
3818 }
3819 
3820 } // namespace ROL
void sgmga_index(int dim_num, double level_weight[], int level_max, int rule[], int point_num, int point_total_num, int sparse_unique_index[], int growth[], int sparse_order[], int sparse_index[])
void sgmga_point(int dim_num, double level_weight[], int level_max, int rule[], int np[], double p[], void(*gw_compute_points[])(int order, int np, double p[], double x[]), int point_num, int sparse_order[], int sparse_index[], int growth[], double sparse_point[])
double sgmga_vcn_coef_naive(int n, double level_weight[], int x_max[], int x[], double q_min, double q_max)
void sgmga_importance_to_aniso(int dim_num, double importance[], double level_weight[])
int sgmga_size_total(int dim_num, double level_weight[], int level_max, int rule[], int growth[])
void sgmga_product_weight(int dim_num, int order_1d[], int order_nd, int rule[], int np[], double p[], void(*gw_compute_weights[])(int order, int np, double p[], double w[]), double weight_nd[])
double sgmga_vcn_coef(int n, double level_weight[], int x[], double q_max)
double * sgmga_aniso_balance(double alpha_max, int dim_num, double level_weight[])
void sgmga_weight(int dim_num, double level_weight[], int level_max, int rule[], int np[], double p[], void(*gw_compute_weights[])(int order, int np, double p[], double w[]), int point_num, int point_total_num, int sparse_unique_index[], int growth[], double sparse_weight[])
void sgmga_unique_index(int dim_num, double level_weight[], int level_max, int rule[], int np[], double p[], void(*gw_compute_points[])(int order, int np, double p[], double x[]), double tol, int point_num, int point_total_num, int growth[], int sparse_unique_index[])
Teuchos::RCP< SandiaRules > webbur
Definition: ROL_SGMGA.hpp:61
void sgmga_aniso_normalize(int option, int dim_num, double level_weight[])
void sgmga_write(int dim_num, double level_weight[], int rule[], int np[], double p[], int point_num, double sparse_weight[], double sparse_point[], std::string file_name)
int sgmga_size(int dim_num, double level_weight[], int level_max, int rule[], int np[], double p[], void(*gw_compute_points[])(int order, int np, double p[], double x[]), double tol, int growth[])
void sgmga_vcn_ordered(int dim_num, double level_weight[], int x_max[], int x[], double q_min, double q_max, bool *more)
void sgmga_vcn_ordered_naive(int dim_num, double level_weight[], int x_max[], int x[], double q_min, double q_max, bool *more)
void sgmga_vcn_naive(int n, double level_weight[], int x_max[], int x[], double q_min, double q_max, bool *more)
void sgmga_vcn(int n, double level_weight[], int x[], double q_min, double q_max, bool *more)