# include # include # include # include # include # include using namespace std; # include "sparse_grid_hermite.hpp" //****************************************************************************80 int choose ( int n, int k ) //****************************************************************************80 // // Purpose: // // CHOOSE computes the binomial coefficient C(N,K). // // Discussion: // // The value is calculated in such a way as to avoid overflow and // roundoff. The calculation is done in integer arithmetic. // // The formula used is: // // C(N,K) = N! / ( K! * (N-K)! ) // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 22 May 2007 // // Author: // // John Burkardt // // Reference: // // ML Wolfson, HV Wright, // Algorithm 160: // Combinatorial of M Things Taken N at a Time, // Communications of the ACM, // Volume 6, Number 4, April 1963, page 161. // // Parameters: // // Input, int N, K, are the values of N and K. // // Output, int CHOOSE, the number of combinations of N // things taken K at a time. // { int i; int mn; int mx; int value; mn = i4_min ( k, n - k ); if ( mn < 0 ) { value = 0; } else if ( mn == 0 ) { value = 1; } else { mx = i4_max ( k, n - k ); value = mx + 1; for ( i = 2; i <= mn; i++ ) { value = ( value * ( mx + i ) ) / i; } } return value; } //****************************************************************************80 void comp_next ( int n, int k, int a[], bool *more, int *h, int *t ) //****************************************************************************80 // // Purpose: // // COMP_NEXT computes the compositions of the integer N into K parts. // // Discussion: // // A composition of the integer N into K parts is an ordered sequence // of K nonnegative integers which sum to N. The compositions (1,2,1) // and (1,1,2) are considered to be distinct. // // The routine computes one composition on each call until there are no more. // For instance, one composition of 6 into 3 parts is // 3+2+1, another would be 6+0+0. // // On the first call to this routine, set MORE = FALSE. The routine // will compute the first element in the sequence of compositions, and // return it, as well as setting MORE = TRUE. If more compositions // are desired, call again, and again. Each time, the routine will // return with a new composition. // // However, when the LAST composition in the sequence is computed // and returned, the routine will reset MORE to FALSE, signaling that // the end of the sequence has been reached. // // This routine originally used a SAVE statement to maintain the // variables H and T. I have decided that it is safer // to pass these variables as arguments, even though the user should // never alter them. This allows this routine to safely shuffle // between several ongoing calculations. // // // There are 28 compositions of 6 into three parts. This routine will // produce those compositions in the following order: // // I A // - --------- // 1 6 0 0 // 2 5 1 0 // 3 4 2 0 // 4 3 3 0 // 5 2 4 0 // 6 1 5 0 // 7 0 6 0 // 8 5 0 1 // 9 4 1 1 // 10 3 2 1 // 11 2 3 1 // 12 1 4 1 // 13 0 5 1 // 14 4 0 2 // 15 3 1 2 // 16 2 2 2 // 17 1 3 2 // 18 0 4 2 // 19 3 0 3 // 20 2 1 3 // 21 1 2 3 // 22 0 3 3 // 23 2 0 4 // 24 1 1 4 // 25 0 2 4 // 26 1 0 5 // 27 0 1 5 // 28 0 0 6 // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 02 July 2008 // // Author: // // Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf. // C++ version by John Burkardt. // // Reference: // // Albert Nijenhuis, Herbert Wilf, // Combinatorial Algorithms for Computers and Calculators, // Second Edition, // Academic Press, 1978, // ISBN: 0-12-519260-6, // LC: QA164.N54. // // Parameters: // // Input, int N, the integer whose compositions are desired. // // Input, int K, the number of parts in the composition. // // Input/output, int A[K], the parts of the composition. // // Input/output, bool *MORE. // Set MORE = FALSE on first call. It will be reset to TRUE on return // with a new composition. Each new call returns another composition until // MORE is set to FALSE when the last composition has been computed // and returned. // // Input/output, int *H, *T, two internal parameters needed for the // computation. The user should allocate space for these in the calling // program, include them in the calling sequence, but never alter them! // { int i; if ( !( *more ) ) { *t = n; *h = 0; a[0] = n; for ( i = 1; i < k; i++ ) { a[i] = 0; } } else { if ( 1 < *t ) { *h = 0; } *h = *h + 1; *t = a[*h-1]; a[*h-1] = 0; a[0] = *t - 1; a[*h] = a[*h] + 1; } *more = ( a[k-1] != n ); return; } //****************************************************************************80 void hermite_abscissa ( int dim_num, int point_num, int grid_index[], int grid_base[], double grid_point[] ) //****************************************************************************80 // // Purpose: // // HERMITE_ABSCISSA sets abscissas for multidimensional Gauss-Hermite quadrature. // // Discussion: // // The "nesting" as it occurs for Gauss-Hermite sparse grids simply // involves the use of a specified set of permissible orders for the // rule. // // The X array lists the (complete) Gauss-Legendre abscissas for rules // of order 1, 3, 7, 15, 31, 63 or 127, in order. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 08 October 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int POINT_NUM, the number of points. // // Input, int GRID_INDEX[DIM_NUM*POINT_NUM], the index of the abscissa // from the rule, for each dimension and point. // // Input, int GRID_BASE[DIM_NUM], the number of points used in the // rule for a given dimension. // // Output, double GRID_POINT[DIM_NUM*POINT_NUM], the grid points of abscissas. // { int dim; int level; int point; int pointer; int skip[8] = { 0, 1, 4, 11, 26, 57, 120, 247 }; double x[247] = { 0.0E+00, -0.122474487139158904909864203735E+01, 0.0E+00, 0.122474487139158904909864203735E+01, -0.265196135683523349244708200652E+01, -0.167355162876747144503180139830E+01, -0.816287882858964663038710959027E+00, 0.0E+00, 0.816287882858964663038710959027E+00, 0.167355162876747144503180139830E+01, 0.265196135683523349244708200652E+01, -0.449999070730939155366438053053E+01, -0.366995037340445253472922383312E+01, -0.296716692790560324848896036355E+01, -0.232573248617385774545404479449E+01, -0.171999257518648893241583152515E+01, -0.113611558521092066631913490556E+01, -0.565069583255575748526020337198E+00, 0.0E+00, 0.565069583255575748526020337198E+00, 0.113611558521092066631913490556E+01, 0.171999257518648893241583152515E+01, 0.232573248617385774545404479449E+01, 0.296716692790560324848896036355E+01, 0.366995037340445253472922383312E+01, 0.449999070730939155366438053053E+01, -6.9956801237185402753248521473232E+00, -6.2750787049428601427036567812530E+00, -5.6739614446185883296332558789276E+00, -5.1335955771123807045862968913996E+00, -4.6315595063128599420667997654336E+00, -4.1562717558181451724831352315314E+00, -3.7007434032314694224497164589673E+00, -3.2603207323135408104645401509648E+00, -2.8316804533902054557015640151425E+00, -2.4123177054804201051740184582119E+00, -2.0002585489356389657975562598571E+00, -1.5938858604721398261388419455550E+00, -1.1918269983500464260821358649242E+00, -0.79287697691530893968593032998830E+00, -0.39594273647142311094670041663436E+00, 0.0000000000000000000000000000000E+00, 0.39594273647142311094670041663436E+00, 0.79287697691530893968593032998830E+00, 1.1918269983500464260821358649242E+00, 1.5938858604721398261388419455550E+00, 2.0002585489356389657975562598571E+00, 2.4123177054804201051740184582119E+00, 2.8316804533902054557015640151425E+00, 3.2603207323135408104645401509648E+00, 3.7007434032314694224497164589673E+00, 4.1562717558181451724831352315314E+00, 4.6315595063128599420667997654336E+00, 5.1335955771123807045862968913996E+00, 5.6739614446185883296332558789276E+00, 6.2750787049428601427036567812530E+00, 6.9956801237185402753248521473232E+00, -10.435499877854168053468115427285E+00, -9.8028759912974963635223935286507E+00, -9.2792019543050391319404745506496E+00, -8.8118581437284546442526628275570E+00, -8.3807683451863219343010651043788E+00, -7.9755950801420373181541806298501E+00, -7.5901395198641066762479783194468E+00, -7.2203167078889678461161324222529E+00, -6.8632544331795368527353285876066E+00, -6.5168348106821160605273395854042E+00, -6.1794379922705969862418461787263E+00, -5.8497884000810673462526582961482E+00, -5.5268572526403031425047575122840E+00, -5.2097979830408354861575136416263E+00, -4.8979018644975742350745099214868E+00, -4.5905665744435190229271294569091E+00, -4.2872733352824404031727616199454E+00, -3.9875699104197157485227052068068E+00, -3.6910577000963465117322810559754E+00, -3.3973817713303911852755941806287E+00, -3.1062230279282566329138616746036E+00, -2.8172919672837977750747135657355E+00, -2.5303236304712010926855221718499E+00, -2.2450734604812066298995918179330E+00, -1.9613138583081485293922008411321E+00, -1.6788312791720137520802800622638E+00, -1.3974237486049625107570752063702E+00, -1.1168987050996462690510970277840E+00, -0.83707109558947615977737795461293E+00, -0.55776166427908221668763665253822E+00, -0.27879538567115223986687628627202E+00, 0.00000000000000000000000000000000E+00, 0.27879538567115223986687628627202E+00, 0.55776166427908221668763665253822E+00, 0.83707109558947615977737795461293E+00, 1.1168987050996462690510970277840E+00, 1.3974237486049625107570752063702E+00, 1.6788312791720137520802800622638E+00, 1.9613138583081485293922008411321E+00, 2.2450734604812066298995918179330E+00, 2.5303236304712010926855221718499E+00, 2.8172919672837977750747135657355E+00, 3.1062230279282566329138616746036E+00, 3.3973817713303911852755941806287E+00, 3.6910577000963465117322810559754E+00, 3.9875699104197157485227052068068E+00, 4.2872733352824404031727616199454E+00, 4.5905665744435190229271294569091E+00, 4.8979018644975742350745099214868E+00, 5.2097979830408354861575136416263E+00, 5.5268572526403031425047575122840E+00, 5.8497884000810673462526582961482E+00, 6.1794379922705969862418461787263E+00, 6.5168348106821160605273395854042E+00, 6.8632544331795368527353285876066E+00, 7.2203167078889678461161324222529E+00, 7.5901395198641066762479783194468E+00, 7.9755950801420373181541806298501E+00, 8.3807683451863219343010651043788E+00, 8.8118581437284546442526628275570E+00, 9.2792019543050391319404745506496E+00, 9.8028759912974963635223935286507E+00, 10.435499877854168053468115427285E+00, -15.228338148167350978246954433464E+00, -14.669595158833972632746354112896E+00, -14.209085995284870755168244250887E+00, -13.799722290211676634645246746673E+00, -13.423518590070950062438258321855E+00, -13.071208660474601901583995439649E+00, -12.737235652415686338138003924072E+00, -12.417939378869715805445879624069E+00, -12.110749020947747600132123508132E+00, -11.813772198267727195134584136191E+00, -11.525565112572696599167888588564E+00, -11.244994583785543445194384194300E+00, -10.971150569840247423423040263881E+00, -10.703288201027481347670940744690E+00, -10.440787957772772867742591798027E+00, -10.183127473450343888624126450357E+00, -9.9298610495114250736847004273684E+00, -9.6806044412474728038150712732737E+00, -9.4350233389881650135019598506287E+00, -9.1928244988460305715774195052527E+00, -8.9537488108565404323807890169970E+00, -8.7175658087076307363833999548548E+00, -8.4840692689832473326097180339984E+00, -8.2530736454457156579694124243888E+00, -8.0244111514703375578594739796798E+00, -7.7979293513870105420829120455591E+00, -7.5734891556083454022834960763301E+00, -7.3509631392269052701961258043733E+00, -7.1302341220350710668064025713431E+00, -6.9111939615465713197465633109366E+00, -6.6937425208758294190074417381666E+00, -6.4777867811645365448144903821487E+00, -6.2632400742737354345609723857092E+00, -6.0500214161419845694465474482388E+00, -5.8380549248774187386601690807757E+00, -5.6272693105464816659423455794909E+00, -5.4175974259243240722848425872924E+00, -5.2089758693153983587570258372239E+00, -5.0013446320386360038520809107373E+00, -4.7946467843764925009748509930857E+00, -4.5888281947698372951606485031212E+00, -4.3838372778464736294253744407459E+00, -4.1796247675352031349421189892408E+00, -3.9761435120673355916035814195920E+00, -3.7733482881250526721004678400057E+00, -3.5711956317782180447199756485249E+00, -3.3696436841717397896643629240035E+00, -3.1686520501953630191857798261495E+00, -2.9681816685955910267761649521505E+00, -2.7681946921824058801226545958892E+00, -2.5686543769473501723144013022363E+00, -2.3695249790490401080012474645702E+00, -2.1707716587411506879498498083695E+00, -1.9723603904195020079324743227565E+00, -1.7742578780516791584676442103681E+00, -1.5764314753267801315519597621879E+00, -1.3788491099261778091441557053728E+00, -1.1814792113700685848678583598423E+00, -0.98429064194027277726568984213773E+00, -0.78725263021825034151596831878971E+00, -0.59033470680942102142230439346102E+00, -0.39350664185130136568037826200185E+00, -0.19673838392423251964272239737078E+00, 0.0000000000000000000000000000000E+00, 0.19673838392423251964272239737078E+00, 0.39350664185130136568037826200185E+00, 0.59033470680942102142230439346102E+00, 0.78725263021825034151596831878971E+00, 0.98429064194027277726568984213773E+00, 1.1814792113700685848678583598423E+00, 1.3788491099261778091441557053728E+00, 1.5764314753267801315519597621879E+00, 1.7742578780516791584676442103681E+00, 1.9723603904195020079324743227565E+00, 2.1707716587411506879498498083695E+00, 2.3695249790490401080012474645702E+00, 2.5686543769473501723144013022363E+00, 2.7681946921824058801226545958892E+00, 2.9681816685955910267761649521505E+00, 3.1686520501953630191857798261495E+00, 3.3696436841717397896643629240035E+00, 3.5711956317782180447199756485249E+00, 3.7733482881250526721004678400057E+00, 3.9761435120673355916035814195920E+00, 4.1796247675352031349421189892408E+00, 4.3838372778464736294253744407459E+00, 4.5888281947698372951606485031212E+00, 4.7946467843764925009748509930857E+00, 5.0013446320386360038520809107373E+00, 5.2089758693153983587570258372239E+00, 5.4175974259243240722848425872924E+00, 5.6272693105464816659423455794909E+00, 5.8380549248774187386601690807757E+00, 6.0500214161419845694465474482388E+00, 6.2632400742737354345609723857092E+00, 6.4777867811645365448144903821487E+00, 6.6937425208758294190074417381666E+00, 6.9111939615465713197465633109366E+00, 7.1302341220350710668064025713431E+00, 7.3509631392269052701961258043733E+00, 7.5734891556083454022834960763301E+00, 7.7979293513870105420829120455591E+00, 8.0244111514703375578594739796798E+00, 8.2530736454457156579694124243888E+00, 8.4840692689832473326097180339984E+00, 8.7175658087076307363833999548548E+00, 8.9537488108565404323807890169970E+00, 9.1928244988460305715774195052527E+00, 9.4350233389881650135019598506287E+00, 9.6806044412474728038150712732737E+00, 9.9298610495114250736847004273684E+00, 10.183127473450343888624126450357E+00, 10.440787957772772867742591798027E+00, 10.703288201027481347670940744690E+00, 10.971150569840247423423040263881E+00, 11.244994583785543445194384194300E+00, 11.525565112572696599167888588564E+00, 11.813772198267727195134584136191E+00, 12.110749020947747600132123508132E+00, 12.417939378869715805445879624069E+00, 12.737235652415686338138003924072E+00, 13.071208660474601901583995439649E+00, 13.423518590070950062438258321855E+00, 13.799722290211676634645246746673E+00, 14.209085995284870755168244250887E+00, 14.669595158833972632746354112896E+00, 15.228338148167350978246954433464E+00 }; for ( dim = 0; dim < dim_num; dim++ ) { if ( grid_base[dim] < 0 ) { cout << "\n"; cout << "HERMITE_ABSCISSA - Fatal error!\n"; cout << " Some base values are less than 0.\n"; exit ( 1 ); } } for ( dim = 0; dim < dim_num; dim++ ) { if ( 63 < grid_base[dim] ) { cout << "\n"; cout << "HERMITE_ABSCISSA - Fatal error!\n"; cout << " Some base values are greater than 63.\n"; exit ( 1 ); } } for ( point = 0; point < point_num; point++ ) { for ( dim = 0; dim < dim_num; dim++ ) { level = i4_log_2 ( grid_base[dim] + 1 ); pointer = skip[level] + ( grid_index[dim+point*dim_num] + grid_base[dim] ); grid_point[dim+point*dim_num] = x[pointer]; } } return; } //****************************************************************************80 double hermite_integral_nd ( int dim_num, int expon[] ) //****************************************************************************80 // // Purpose: // // HERMITE_INTEGRAL_ND evaluates a multidimensional Hermite polynomial integral. // // Discussion: // // H(d,n) = Integral ( -Infinity < x < Infinity ) // x1^n1 * x2^n2...*xd^nd * exp(-x1^2-x2^2...-xd^2 ) dx // // H(d,n) is 0 if any n(i) odd. // // H(d,n) = product ( 1 <= i <= d ) // ( (n(i)-1)!! * sqrt(pi) / 2^(n(i)/2) for all n(i) even. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 03 October 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the dimension of the integral. // // Input, int EXPON[DIM_NUM], the order of the integral. // 0 <= EXPON(1:DIM_NUM). // // Output, double HERMITE_INTEGRAL, the value of the integral. // { int dim; double pi = 3.141592653589793; double value; for ( dim = 0; dim < dim_num; dim++ ) { if ( expon[dim] < 0 ) { value = - r8_huge ( ); return value; } } for ( dim = 0; dim < dim_num; dim++ ) { if ( ( expon[dim] % 2 ) == 1 ) { value = 0.0; return value; } } value = 1.0; for ( dim = 0; dim < dim_num; dim++ ) { value = value * r8_factorial2 ( expon[dim] - 1 ) * sqrt ( pi ) / ( double ) i4_power ( 2, expon[dim] / 2 ); } return value; } //****************************************************************************80 void hermite_weights ( int order, double weight[] ) //****************************************************************************80 // // Purpose: // // HERMITE_WEIGHTS returns weights for certain Gauss-Hermite quadrature rules. // // Discussion: // // The allowed orders are 1, 3, 7, 15, 31, 63 and 127. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 07 October 2007 // // Author: // // John Burkardt // // Reference: // // Milton Abramowitz, Irene Stegun, // Handbook of Mathematical Functions, // National Bureau of Standards, 1964, // ISBN: 0-486-61272-4, // LC: QA47.A34. // // Arthur Stroud, Don Secrest, // Gaussian Quadrature Formulas, // Prentice Hall, 1966, // LC: QA299.4G3S7. // // Parameters: // // Input, int ORDER, the order of the rule. // ORDER must be 1, 3, 7, 15, 31, 63 or 127. // // Output, double WEIGHT[ORDER], the weights. // The weights are positive, symmetric and should sum to SQRT(PI). // { if ( order == 1 ) { weight[1-1] = 1.77245385090551602729816748334E+00; } else if ( order == 3 ) { weight[1-1] = 0.295408975150919337883027913890E+00; weight[2-1] = 0.118163590060367735153211165556E+01; weight[3-1] = 0.295408975150919337883027913890E+00; } else if ( order == 7 ) { weight[1-1] = 0.971781245099519154149424255939E-03; weight[2-1] = 0.545155828191270305921785688417E-01; weight[3-1] = 0.425607252610127800520317466666E+00; weight[4-1] = 0.810264617556807326764876563813E+00; weight[5-1] = 0.425607252610127800520317466666E+00; weight[6-1] = 0.545155828191270305921785688417E-01; weight[7-1] = 0.971781245099519154149424255939E-03; } else if ( order == 15 ) { weight[1-1] = 0.152247580425351702016062666965E-08; weight[2-1] = 0.105911554771106663577520791055E-05; weight[3-1] = 0.100004441232499868127296736177E-03; weight[4-1] = 0.277806884291277589607887049229E-02; weight[5-1] = 0.307800338725460822286814158758E-01; weight[6-1] = 0.158488915795935746883839384960E+00; weight[7-1] = 0.412028687498898627025891079568E+00; weight[8-1] = 0.564100308726417532852625797340E+00; weight[9-1] = 0.412028687498898627025891079568E+00; weight[10-1] = 0.158488915795935746883839384960E+00; weight[11-1] = 0.307800338725460822286814158758E-01; weight[12-1] = 0.277806884291277589607887049229E-02; weight[13-1] = 0.100004441232499868127296736177E-03; weight[14-1] = 0.105911554771106663577520791055E-05; weight[15-1] = 0.152247580425351702016062666965E-08; } else if ( order == 31 ) { weight[ 1-1] = 0.46189683944498305857470556847735E-21; weight[ 2-1] = 0.51106090079112519643027197715274E-17; weight[ 3-1] = 0.58995564987355133075257722133966E-14; weight[ 4-1] = 0.18603735214463569590294465062239E-11; weight[ 5-1] = 0.23524920032013205739850619940094E-09; weight[ 6-1] = 0.14611988344865057576066495091513E-07; weight[ 7-1] = 0.50437125589241034841778074689627E-06; weight[ 8-1] = 0.10498602757642934202945441341697E-04; weight[ 9-1] = 0.13952090395003623854995664958146E-03; weight[ 10-1] = 0.12336833073030489880608311394968E-02; weight[ 11-1] = 0.74827999140119116765002499116934E-02; weight[ 12-1] = 0.31847230731201222775249585776902E-01; weight[ 13-1] = 0.96717948160569462991143316029341E-01; weight[ 14-1] = 0.21213278866810461318136114862419E+00; weight[ 15-1] = 0.33877265789305344906000174083214E+00; weight[ 16-1] = 0.39577855609737786462923720809676E+00; weight[ 17-1] = 0.33877265789305344906000174083214E+00; weight[ 18-1] = 0.21213278866810461318136114862419E+00; weight[ 19-1] = 0.96717948160569462991143316029341E-01; weight[ 20-1] = 0.31847230731201222775249585776902E-01; weight[ 21-1] = 0.74827999140119116765002499116934E-02; weight[ 22-1] = 0.12336833073030489880608311394968E-02; weight[ 23-1] = 0.13952090395003623854995664958146E-03; weight[ 24-1] = 0.10498602757642934202945441341697E-04; weight[ 25-1] = 0.50437125589241034841778074689627E-06; weight[ 26-1] = 0.14611988344865057576066495091513E-07; weight[ 27-1] = 0.23524920032013205739850619940094E-09; weight[ 28-1] = 0.18603735214463569590294465062239E-11; weight[ 29-1] = 0.58995564987355133075257722133966E-14; weight[ 30-1] = 0.51106090079112519643027197715274E-17; weight[ 31-1] = 0.46189683944498305857470556847735E-21; } else if ( order == 63 ) { weight[ 1-1] = 0.37099206434787551197827130470031E-47; weight[ 2-1] = 0.10400778615192299534481914814892E-41; weight[ 3-1] = 0.19796804708258311251124226474396E-37; weight[ 4-1] = 0.84687478191640015120141181138947E-34; weight[ 5-1] = 0.13071305930779945903630127634063E-30; weight[ 6-1] = 0.93437837175367456929765381518998E-28; weight[ 7-1] = 0.36027426635173044862245783257252E-25; weight[ 8-1] = 0.82963863115951789374753323156164E-23; weight[ 9-1] = 0.12266629909105281472971700203949E-20; weight[ 10-1] = 0.12288435628797061539461585325494E-18; weight[ 11-1] = 0.86925536958188009075932426691516E-17; weight[ 12-1] = 0.44857058689176221240330804981619E-15; weight[ 13-1] = 0.17335817955735154599902643794700E-13; weight[ 14-1] = 0.51265062385038307838565047455223E-12; weight[ 15-1] = 0.11808921844532942490513037158404E-10; weight[ 16-1] = 0.21508698297808025739828859845140E-09; weight[ 17-1] = 0.31371929535285447801497640621672E-08; weight[ 18-1] = 0.37041625984781705796752840204084E-07; weight[ 19-1] = 0.35734732949879669663960738150956E-06; weight[ 20-1] = 0.28393114498380927832990899215541E-05; weight[ 21-1] = 0.18709113003730498008961134765721E-04; weight[ 22-1] = 0.10284880800653635546698378640623E-03; weight[ 23-1] = 0.47411702610173128107201781718693E-03; weight[ 24-1] = 0.18409222622384813438539657470055E-02; weight[ 25-1] = 0.60436044551187631655712178246467E-02; weight[ 26-1] = 0.16829299199599730926458559757600E-01; weight[ 27-1] = 0.39858264027692992170237391875317E-01; weight[ 28-1] = 0.80467087993950415219587554532823E-01; weight[ 29-1] = 0.13871950817615293377792092082674E+00; weight[ 30-1] = 0.20448695346833761570957197160475E+00; weight[ 31-1] = 0.25799889943058042204920467417642E+00; weight[ 32-1] = 0.27876694884838411919175686949858E+00; weight[ 33-1] = 0.25799889943058042204920467417642E+00; weight[ 34-1] = 0.20448695346833761570957197160475E+00; weight[ 35-1] = 0.13871950817615293377792092082674E+00; weight[ 36-1] = 0.80467087993950415219587554532823E-01; weight[ 37-1] = 0.39858264027692992170237391875317E-01; weight[ 38-1] = 0.16829299199599730926458559757600E-01; weight[ 39-1] = 0.60436044551187631655712178246467E-02; weight[ 40-1] = 0.18409222622384813438539657470055E-02; weight[ 41-1] = 0.47411702610173128107201781718693E-03; weight[ 42-1] = 0.10284880800653635546698378640623E-03; weight[ 43-1] = 0.18709113003730498008961134765721E-04; weight[ 44-1] = 0.28393114498380927832990899215541E-05; weight[ 45-1] = 0.35734732949879669663960738150956E-06; weight[ 46-1] = 0.37041625984781705796752840204084E-07; weight[ 47-1] = 0.31371929535285447801497640621672E-08; weight[ 48-1] = 0.21508698297808025739828859845140E-09; weight[ 49-1] = 0.11808921844532942490513037158404E-10; weight[ 50-1] = 0.51265062385038307838565047455223E-12; weight[ 51-1] = 0.17335817955735154599902643794700E-13; weight[ 52-1] = 0.44857058689176221240330804981619E-15; weight[ 53-1] = 0.86925536958188009075932426691516E-17; weight[ 54-1] = 0.12288435628797061539461585325494E-18; weight[ 55-1] = 0.12266629909105281472971700203949E-20; weight[ 56-1] = 0.82963863115951789374753323156164E-23; weight[ 57-1] = 0.36027426635173044862245783257252E-25; weight[ 58-1] = 0.93437837175367456929765381518998E-28; weight[ 59-1] = 0.13071305930779945903630127634063E-30; weight[ 60-1] = 0.84687478191640015120141181138947E-34; weight[ 61-1] = 0.19796804708258311251124226474396E-37; weight[ 62-1] = 0.10400778615192299534481914814892E-41; weight[ 63-1] = 0.37099206434787551197827130470031E-47; } else if ( order == 127 ) { weight[ 1-1] = 0.12504497577050595552677230002883E-100; weight[ 2-1] = 0.17272798059419131415318615789672E-93; weight[ 3-1] = 0.89321681571986548608031150791499E-88; weight[ 4-1] = 0.77306185240893578449625186483810E-83; weight[ 5-1] = 0.20143957652648255497735460506196E-78; weight[ 6-1] = 0.21503714733610239701351039429345E-74; weight[ 7-1] = 0.11341924208594594813715533569504E-70; weight[ 8-1] = 0.33489139011795051950683388483136E-67; weight[ 9-1] = 0.60486548964016681064424451668405E-64; weight[ 10-1] = 0.71375092946352177824971347343892E-61; weight[ 11-1] = 0.57884563374885556636801095624030E-58; weight[ 12-1] = 0.33581166223858230300409326551248E-55; weight[ 13-1] = 0.14394641949253923568603163698953E-52; weight[ 14-1] = 0.46821808383216117724080263903889E-50; weight[ 15-1] = 0.11817054440684264071348471955361E-47; weight[ 16-1] = 0.23581659156008927203181682045005E-45; weight[ 17-1] = 0.37814427940797540210712758405540E-43; weight[ 18-1] = 0.49411031115771638145610738414006E-41; weight[ 19-1] = 0.53255303775425059266087298458297E-39; weight[ 20-1] = 0.47854390680131484999315199332765E-37; weight[ 21-1] = 0.36191883445952356128627543209554E-35; weight[ 22-1] = 0.23232083386343554805352497446119E-33; weight[ 23-1] = 0.12753331411008716683688974281454E-31; weight[ 24-1] = 0.60277753850758742112436095241270E-30; weight[ 25-1] = 0.24679773241777200207460855084439E-28; weight[ 26-1] = 0.88019567691698482573264198727415E-27; weight[ 27-1] = 0.27482489212040561315005725890593E-25; weight[ 28-1] = 0.75468218903085486125222816438456E-24; weight[ 29-1] = 0.18303134636280466270545996891835E-22; weight[ 30-1] = 0.39355990860860813085582448449811E-21; weight[ 31-1] = 0.75293161638581191068419292570042E-20; weight[ 32-1] = 0.12857997786722855037584105682618E-18; weight[ 33-1] = 0.19659326888445857792541925311450E-17; weight[ 34-1] = 0.26986511907214101894995783364250E-16; weight[ 35-1] = 0.33344414303198856330118301113874E-15; weight[ 36-1] = 0.37173303125150639885726463109574E-14; weight[ 37-1] = 0.37473954472839737091885387788983E-13; weight[ 38-1] = 0.34230094493397259538669512076007E-12; weight[ 39-1] = 0.28385303724993373166810860630552E-11; weight[ 40-1] = 0.21406920290454669208938772802828E-10; weight[ 41-1] = 0.14706331273431716244229273183839E-09; weight[ 42-1] = 0.92173940967434659264335883218167E-09; weight[ 43-1] = 0.52781663936972714041837056042506E-08; weight[ 44-1] = 0.27650497044951117835905283127679E-07; weight[ 45-1] = 0.13267855842539464770913063113371E-06; weight[ 46-1] = 0.58380944276113062188573331195042E-06; weight[ 47-1] = 0.23581561724775629112332165335800E-05; weight[ 48-1] = 0.87524468034280444703919485644809E-05; weight[ 49-1] = 0.29876790535909012274846532159647E-04; weight[ 50-1] = 0.93874435720072545206729594267039E-04; weight[ 51-1] = 0.27170762627931172053444716883938E-03; weight[ 52-1] = 0.72493929742498358979684249380921E-03; weight[ 53-1] = 0.17841208326763432884316727108264E-02; weight[ 54-1] = 0.40524855186046131499765636276283E-02; weight[ 55-1] = 0.85000263041544110385806705526917E-02; weight[ 56-1] = 0.16471142241609687824005585301760E-01; weight[ 57-1] = 0.29499296248213632269675010319119E-01; weight[ 58-1] = 0.48847387114300011006959603975676E-01; weight[ 59-1] = 0.74807989768583731416517226905270E-01; weight[ 60-1] = 0.10598520508090929403834368934301E+00; weight[ 61-1] = 0.13893945309051540832066283010510E+00; weight[ 62-1] = 0.16856236074207929740526975049765E+00; weight[ 63-1] = 0.18927849580120432177170145550076E+00; weight[ 64-1] = 0.19673340688823289786163676995151E+00; weight[ 65-1] = 0.18927849580120432177170145550076E+00; weight[ 66-1] = 0.16856236074207929740526975049765E+00; weight[ 67-1] = 0.13893945309051540832066283010510E+00; weight[ 68-1] = 0.10598520508090929403834368934301E+00; weight[ 69-1] = 0.74807989768583731416517226905270E-01; weight[ 70-1] = 0.48847387114300011006959603975676E-01; weight[ 71-1] = 0.29499296248213632269675010319119E-01; weight[ 72-1] = 0.16471142241609687824005585301760E-01; weight[ 73-1] = 0.85000263041544110385806705526917E-02; weight[ 74-1] = 0.40524855186046131499765636276283E-02; weight[ 75-1] = 0.17841208326763432884316727108264E-02; weight[ 76-1] = 0.72493929742498358979684249380921E-03; weight[ 77-1] = 0.27170762627931172053444716883938E-03; weight[ 78-1] = 0.93874435720072545206729594267039E-04; weight[ 79-1] = 0.29876790535909012274846532159647E-04; weight[ 80-1] = 0.87524468034280444703919485644809E-05; weight[ 81-1] = 0.23581561724775629112332165335800E-05; weight[ 82-1] = 0.58380944276113062188573331195042E-06; weight[ 83-1] = 0.13267855842539464770913063113371E-06; weight[ 84-1] = 0.27650497044951117835905283127679E-07; weight[ 85-1] = 0.52781663936972714041837056042506E-08; weight[ 86-1] = 0.92173940967434659264335883218167E-09; weight[ 87-1] = 0.14706331273431716244229273183839E-09; weight[ 88-1] = 0.21406920290454669208938772802828E-10; weight[ 89-1] = 0.28385303724993373166810860630552E-11; weight[ 90-1] = 0.34230094493397259538669512076007E-12; weight[ 91-1] = 0.37473954472839737091885387788983E-13; weight[ 92-1] = 0.37173303125150639885726463109574E-14; weight[ 93-1] = 0.33344414303198856330118301113874E-15; weight[ 94-1] = 0.26986511907214101894995783364250E-16; weight[ 95-1] = 0.19659326888445857792541925311450E-17; weight[ 96-1] = 0.12857997786722855037584105682618E-18; weight[ 97-1] = 0.75293161638581191068419292570042E-20; weight[ 98-1] = 0.39355990860860813085582448449811E-21; weight[ 99-1] = 0.18303134636280466270545996891835E-22; weight[100-1] = 0.75468218903085486125222816438456E-24; weight[101-1] = 0.27482489212040561315005725890593E-25; weight[102-1] = 0.88019567691698482573264198727415E-27; weight[103-1] = 0.24679773241777200207460855084439E-28; weight[104-1] = 0.60277753850758742112436095241270E-30; weight[105-1] = 0.12753331411008716683688974281454E-31; weight[106-1] = 0.23232083386343554805352497446119E-33; weight[107-1] = 0.36191883445952356128627543209554E-35; weight[108-1] = 0.47854390680131484999315199332765E-37; weight[109-1] = 0.53255303775425059266087298458297E-39; weight[110-1] = 0.49411031115771638145610738414006E-41; weight[111-1] = 0.37814427940797540210712758405540E-43; weight[112-1] = 0.23581659156008927203181682045005E-45; weight[113-1] = 0.11817054440684264071348471955361E-47; weight[114-1] = 0.46821808383216117724080263903889E-50; weight[115-1] = 0.14394641949253923568603163698953E-52; weight[116-1] = 0.33581166223858230300409326551248E-55; weight[117-1] = 0.57884563374885556636801095624030E-58; weight[118-1] = 0.71375092946352177824971347343892E-61; weight[119-1] = 0.60486548964016681064424451668405E-64; weight[120-1] = 0.33489139011795051950683388483136E-67; weight[121-1] = 0.11341924208594594813715533569504E-70; weight[122-1] = 0.21503714733610239701351039429345E-74; weight[123-1] = 0.20143957652648255497735460506196E-78; weight[124-1] = 0.77306185240893578449625186483810E-83; weight[125-1] = 0.89321681571986548608031150791499E-88; weight[126-1] = 0.17272798059419131415318615789672E-93; weight[127-1] = 0.12504497577050595552677230002883E-100; } else { cout << "\n"; cout << "HERMITE_WEIGHTS - Fatal error!\n"; cout << " Illegal value of ORDER = " << order << "\n"; cout << " Legal values are 1, 3, 7, 15, 31, 63 and 127.\n"; exit ( 1 ); } return; } //****************************************************************************80 int i4_log_2 ( int i ) //****************************************************************************80 // // Purpose: // // I4_LOG_2 returns the integer part of the logarithm base 2 of an I4. // // Example: // // I I4_LOG_10 // ----- -------- // 0 0 // 1 0 // 2 1 // 3 1 // 4 2 // 5 2 // 7 2 // 8 3 // 9 3 // 1000 9 // 1024 10 // // Discussion: // // I4_LOG_2 ( I ) + 1 is the number of binary digits in I. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 04 January 2004 // // Author: // // John Burkardt // // Parameters: // // Input, int I, the number whose logarithm base 2 is desired. // // Output, int I4_LOG_2, the integer part of the logarithm base 2 of // the absolute value of X. // { int i_abs; int two_pow; int value; if ( i == 0 ) { value = 0; } else { value = 0; two_pow = 2; i_abs = abs ( i ); while ( two_pow <= i_abs ) { value = value + 1; two_pow = two_pow * 2; } } return value; } //****************************************************************************80 int i4_max ( int i1, int i2 ) //****************************************************************************80 // // Purpose: // // I4_MAX returns the maximum of two I4's. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 May 2003 // // Author: // // John Burkardt // // Parameters: // // Input, int I1, I2, two integers to be compared. // // Output, int I4_MAX, the larger of i1 and i2. // { int value; if ( i2 < i1 ) { value = i1; } else { value = i2; } return value; } //****************************************************************************80 int i4_min ( int i1, int i2 ) //****************************************************************************80 // // Purpose: // // I4_MIN returns the smaller of two I4's. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 May 2003 // // Author: // // John Burkardt // // Parameters: // // Input, int I1, I2, two integers to be compared. // // Output, int I4_MIN, the smaller of i1 and i2. // { int value; if ( i1 < i2 ) { value = i1; } else { value = i2; } return value; } //****************************************************************************80 int i4_modp ( int i, int j ) //****************************************************************************80 // // Purpose: // // I4_MODP returns the nonnegative remainder of I4 division. // // Discussion: // // If // NREM = I4_MODP ( I, J ) // NMULT = ( I - NREM ) / J // then // I = J * NMULT + NREM // where NREM is always nonnegative. // // The MOD function computes a result with the same sign as the // quantity being divided. Thus, suppose you had an angle A, // and you wanted to ensure that it was between 0 and 360. // Then mod(A,360) would do, if A was positive, but if A // was negative, your result would be between -360 and 0. // // On the other hand, I4_MODP(A,360) is between 0 and 360, always. // // Examples: // // I J MOD I4_MODP I4_MODP Factorization // // 107 50 7 7 107 = 2 * 50 + 7 // 107 -50 7 7 107 = -2 * -50 + 7 // -107 50 -7 43 -107 = -3 * 50 + 43 // -107 -50 -7 43 -107 = 3 * -50 + 43 // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 26 May 1999 // // Author: // // John Burkardt // // Parameters: // // Input, int I, the number to be divided. // // Input, int J, the number that divides I. // // Output, int I4_MODP, the nonnegative remainder when I is // divided by J. // { int value; if ( j == 0 ) { cout << "\n"; cout << "I4_MODP - Fatal error!\n"; cout << " I4_MODP ( I, J ) called with J = " << j << "\n"; exit ( 1 ); } value = i % j; if ( value < 0 ) { value = value + abs ( j ); } return value; } //****************************************************************************80 int i4_power ( int i, int j ) //****************************************************************************80 // // Purpose: // // I4_POWER returns the value of I^J. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 17 August 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int I, J, the base and the power. J should be nonnegative. // // Output, int I4_POWER, the value of I^J. // { int k; int value; if ( j < 0 ) { if ( i == 1 ) { value = 1; } else if ( i == 0 ) { cout << "\n"; cout << "I4_POWER - Fatal error!\n"; cout << " I^J requested, with I = 0 and J negative.\n"; exit ( 1 ); } else { value = 0; } } else if ( j == 0 ) { if ( i == 0 ) { cout << "\n"; cout << "I4_POWER - Fatal error!\n"; cout << " I^J requested, with I = 0 and J = 0.\n"; exit ( 1 ); } else { value = 1; } } else if ( j == 1 ) { value = i; } else { value = 1; for ( k = 1; k <= j; k++ ) { value = value * i; } } return value; } //****************************************************************************80 string i4_to_string ( int i4, string format ) //****************************************************************************80 // // Purpose: // // I4_TO_STRING converts an I4 to a C++ string. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 09 July 2009 // // Author: // // John Burkardt // // Parameters: // // Input, int I4, an integer. // // Input, string FORMAT, the format string. // // Output, string I4_TO_STRING, the string. // { char i4_char[80]; string i4_string; sprintf ( i4_char, format.c_str ( ), i4 ); i4_string = string ( i4_char ); return i4_string; } //****************************************************************************80 int i4vec_product ( int n, int a[] ) //****************************************************************************80 // // Purpose: // // I4VEC_PRODUCT multiplies the entries of an I4VEC. // // Example: // // A = ( 1, 2, 3, 4 ) // // I4VEC_PRODUCT = 24 // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 17 August 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int N, the number of entries in the vector. // // Input, int A[N], the vector // // Output, int I4VEC_PRODUCT, the product of the entries of A. // { int i; int product; product = 1; for ( i = 0; i < n; i++ ) { product = product * a[i]; } return product; } //****************************************************************************80 int *index_level_hermite ( int level, int level_max, int dim_num, int point_num, int grid_index[], int grid_base[] ) //****************************************************************************80 // // Purpose: // // INDEX_LEVEL_HERMITE: determine first level at which given index is generated. // // Discussion: // // We are constructing a sparse grid of Gauss-Hermite points. The grid // is built up of product grids, with a characteristic LEVEL. // // We are concerned with identifying points in this product grid which // have actually been generated previously, on a lower value of LEVEL. // // This routine determines the lowest value of LEVEL at which each of // the input points would be generated. // // In 1D, given LEVEL, the number of points is ORDER = 2**(LEVEL+1) + 1, // (except that LEVEL = 0 implies ORDER = 1), the BASE is (ORDER-1)/2, // and the point INDEX values range from -BASE to +BASE. // // The values of INDEX and BASE allow us to determine the abstract // properties of the point. In particular, if INDEX is 0, the corresponding // Gauss-Legendre abscissa is 0, the special "nested" value we need // to take care of. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 07 October 2007 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int LEVEL, the level at which these points were // generated. LEVEL_MIN <= LEVEL <= LEVEL_MAX. // // Input, int LEVEL_MAX, the maximum level. // // Input, int DIM_NUM, the spatial dimension. // // Input, int POINT_NUM, the number of points to be tested. // // Input, int GRID_INDEX[DIM_NUM*POINT_NUM], the indices of the // points to be tested. // // Input, int GRID_BASE[DIM_NUM], the "base", which is essentially // the denominator of the index. // // Output, int INDEX_LEVEL_HERM[POINT_NUM], the value of LEVEL at // which the point would first be generated. This will be the same as // the input value of LEVEL, unless the point has an INDEX of 0 and // a corresponding BASE that is NOT zero. // { int dim; int *grid_level; int level_min; int point; grid_level = new int[point_num]; level_min = i4_max ( 0, level_max + 1 - dim_num ); // // If a point has a DIM-th component whose INDEX is 0, then the // value of LEVEL at which this point would first be generated is // less than LEVEL, unless the DIM-th component of GRID_BASE is 0. // for ( point = 0; point < point_num; point++ ) { grid_level[point] = i4_max ( level, level_min ); for ( dim = 0; dim < dim_num; dim++ ) { if ( grid_index[dim+point*dim_num] == 0 ) { grid_level[point] = i4_max ( grid_level[point] - grid_base[dim], level_min ); } } } return grid_level; } //****************************************************************************80 void level_to_order_open ( int dim_num, int level[], int order[] ) //****************************************************************************80 // // Purpose: // // LEVEL_TO_ORDER_OPEN converts a level to an order for open rules. // // Discussion: // // Sparse grids can naturally be nested. A natural scheme is to use // a series of one-dimensional rules arranged in a series of "levels" // whose order roughly doubles with each step. // // The arrangement described here works naturally for the Fejer Type 1, // Fejer Type 2, Newton Cotes Open, Newton Cotes Half Open, // and Gauss-Patterson rules. It also can be used, partially, to describe // the growth of Gauss-Legendre and Gauss-Hermite rules. // // The idea is that we start with LEVEL = 0, ORDER = 1 indicating the single // point at the center, and for all values afterwards, we use the // relationship // // ORDER = 2**(LEVEL+1) - 1. // // The following table shows how the growth will occur: // // Level Order // // 0 1 // 1 3 = 4 - 1 // 2 7 = 8 - 1 // 3 15 = 16 - 1 // 4 31 = 32 - 1 // 5 63 = 64 - 1 // // For the Fejer Type 1, Fejer Type 2, Newton Cotes Open, // Newton Cotes Open Half, and Gauss-Patterson rules, the point growth is // nested. If we have ORDER points on a particular LEVEL, the next level // includes all these old points, plus ORDER+1 new points, formed in the // gaps between successive pairs of old points plus an extra point at each // end. // // Level Order = New + Old // // 0 1 = 1 + 0 // 1 3 = 2 + 1 // 2 7 = 4 + 3 // 3 15 = 8 + 7 // 4 31 = 16 + 15 // 5 63 = 32 + 31 // // If we use a series of Gauss-Legendre or Gauss-Hermite rules, then there // is almost no nesting, except that the central point is shared. If we // insist on producing a comparable series of such points, then the // "nesting" behavior is as follows: // // Level Order = New + Old // // 0 1 = 1 + 0 // 1 3 = 2 + 1 // 2 7 = 6 + 1 // 3 15 = 14 + 1 // 4 31 = 30 + 1 // 5 63 = 62 + 1 // // Moreover, if we consider ALL the points used in such a set of "nested" // Gauss-Legendre or Gauss-Hermite rules, then we must sum the "NEW" column, // and we see that we get roughly twice as many points as for the truly // nested rules. // // In this routine, we assume that a vector of levels is given, // and the corresponding orders are desired. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 19 April 2007 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int LEVEL[DIM_NUM], the nesting level. // // Output, int ORDER[DIM_NUM], the order (number of points) // of the rule. // { int dim; for ( dim = 0; dim < dim_num; dim++ ) { if ( level[dim] < 0 ) { order[dim] = -1; } else if ( level[dim] == 0 ) { order[dim] = 1; } else { order[dim] = i4_power ( 2, level[dim] + 1 ) - 1 ; } } return; } //****************************************************************************80 double monomial_quadrature_hermite ( int dim_num, int expon[], int point_num, double weight[], double x[] ) //****************************************************************************80 // // Purpose: // // MONOMIAL_QUADRATURE_HERMITE applies Hermite quadrature to a monomial. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 07 October 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int EXPON[DIM_NUM], the exponents. // // Input, int POINT_NUM, the number of points in the rule. // // Input, double WEIGHT[POINT_NUM], the quadrature weights. // // Input, double X[DIM_NUM*POINT_NUM], the quadrature points. // // Output, double MONOMIAL_QUADRATURE, the quadrature error. // { double exact; int point; double quad; double quad_error; double *value; // // Get the exact value of the integral of the unscaled monomial. // exact = hermite_integral_nd ( dim_num, expon ); // // Evaluate the monomial at the quadrature points. // value = monomial_value ( dim_num, point_num, x, expon ); // // Compute the weighted sum. // quad = 0.0; for ( point = 0; point < point_num; point++ ) { quad = quad + weight[point] * value[point]; } // // If the exact value is nonzero, use it to scale the data. // if ( exact == 0.0 ) { quad_error = fabs ( quad ); } else { quad_error = fabs ( ( quad - exact ) / exact ); } return quad_error; } //****************************************************************************80 double *monomial_value ( int dim_num, int point_num, double x[], int expon[] ) //****************************************************************************80 // // Purpose: // // MONOMIAL_VALUE evaluates a monomial. // // Discussion: // // This routine evaluates a monomial of the form // // product ( 1 <= dim <= dim_num ) x(dim)^expon(dim) // // where the exponents are nonnegative integers. Note that // if the combination 0^0 is encountered, it should be treated // as 1. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 07 October 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int POINT_NUM, the number of points at which the // monomial is to be evaluated. // // Input, double X[DIM_NUM*POINT_NUM], the point coordinates. // // Input, int EXPON[DIM_NUM], the exponents. // // Output, double MONOMIAL_VALUE[POINT_NUM], the value of the monomial. // { int dim; int point; double *value; value = new double[point_num]; for ( point = 0; point < point_num; point++ ) { value[point] = 1.0; } for ( dim = 0; dim < dim_num; dim++ ) { for ( point = 0; point < point_num; point++ ) { if ( x[dim+point*dim_num] != 0.0 ) { value[point] = value[point] * pow ( x[dim+point*dim_num], expon[dim] ); } else if ( expon[dim] == 0 ) { } else { value[point] = 0.0; } } } return value; } //****************************************************************************80 int *multigrid_index_z ( int dim_num, int order_1d[], int order_nd ) //****************************************************************************80 // // Purpose: // // MULTIGRID_INDEX_Z returns an indexed multidimensional grid. // // Discussion: // // For dimension DIM, the number of points is ORDER_1D[DIM]. // // We assume that ORDER_1D[DIM] is an odd number, // ORDER_1D[DIM] = N = 2 * M + 1 // so that the points have coordinates // -M/M, -(M-1)/M, ..., -1/M, 0/M, 1/M, 2/M, 3/M, ..., (M-1)/M, M/M. // and we index them as // -M, -(M-1), -1, 0, 1, 2, 3, ..., M-1, M. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 24 September 2007 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int DIM_NUM, the spatial dimension of the points. // // Input, int ORDER_1D[DIM_NUM], the order of the // rule in each dimension. // // Input, int ORDER_ND, the product of the entries of ORDER_1D. // // Output, int INDX[DIM_NUM*ORDER_ND], the indices of the points in // the grid. The second dimension of this array is equal to the // product of the entries of ORDER_1D. // { int *a; int dim; bool more; int p; int *indx; indx = new int[dim_num*order_nd]; a = new int[dim_num]; more = false; p = 0; for ( ; ; ) { vec_colex_next2 ( dim_num, order_1d, a, &more ); if ( !more ) { break; } // // The values of A(DIM) are between 0 and ORDER_1D(DIM)-1 = N - 1 = 2 * M. // Subtracting M sets the range to -M to +M, as we wish. // for ( dim = 0; dim < dim_num; dim++ ) { indx[dim+p*dim_num] = a[dim] - ( order_1d[dim] - 1 ) / 2; } p = p + 1; } delete [] a; return indx; } //****************************************************************************80 double *product_weight_hermite ( int dim_num, int order_1d[], int order_nd ) //****************************************************************************80 // // Purpose: // // PRODUCT_WEIGHT_HERMITE: weights for a product Gauss-Hermite rule. // // Discussion: // // This routine computes the weights for a quadrature rule which is // a product of 1D Gauss-Hermite rules of varying order. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 07 October 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int ORDER_1D[DIM_NUM], the order of the 1D rules. // // Input, int ORDER_ND, the order of the product rule. // // Output, double PRODUCT_WEIGHT_HERM[ORDER_ND], the product rule weights. // { int dim; int order; double *w_1d; double *w_nd; w_nd = new double[order_nd]; for ( order = 0; order < order_nd; order++ ) { w_nd[order] = 1.0; } for ( dim = 0; dim < dim_num; dim++ ) { w_1d = new double[order_1d[dim]]; hermite_weights ( order_1d[dim], w_1d ); r8vec_direct_product2 ( dim, order_1d[dim], w_1d, dim_num, order_nd, w_nd ); delete [] w_1d; } return w_nd; } //****************************************************************************80 double r8_epsilon ( ) //****************************************************************************80 // // Purpose: // // R8_EPSILON returns the R8 roundoff unit. // // Discussion: // // The roundoff unit is a number R which is a power of 2 with the // property that, to the precision of the computer's arithmetic, // 1 < 1 + R // but // 1 = ( 1 + R / 2 ) // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 01 September 2012 // // Author: // // John Burkardt // // Parameters: // // Output, double R8_EPSILON, the R8 round-off unit. // { const double value = 2.220446049250313E-016; return value; } //****************************************************************************80 double r8_factorial2 ( int n ) //****************************************************************************80 // // Purpose: // // R8_FACTORIAL2 computes the double factorial function N!! // // Formula: // // FACTORIAL2( N ) = Product ( N * (N-2) * (N-4) * ... * 2 ) (N even) // = Product ( N * (N-2) * (N-4) * ... * 1 ) (N odd) // // Example: // // N N!! // // 0 1 // 1 1 // 2 2 // 3 3 // 4 8 // 5 15 // 6 48 // 7 105 // 8 384 // 9 945 // 10 3840 // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 02 September 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int N, the argument of the double factorial // function. If N is less than 1, R8_FACTORIAL2 is returned as 1.0. // // Output, double R8_FACTORIAL2, the value of N!!. // { double r8_n; double value; if ( n < 1 ) { value = 1.0; return value; } r8_n = ( double ) ( n ); value = 1.0; while ( 1.0 < r8_n ) { value = value * r8_n; r8_n = r8_n - 2.0; } return value; } //****************************************************************************80 double r8_huge ( ) //****************************************************************************80 // // Purpose: // // R8_HUGE returns a "huge" R8. // // Discussion: // // The value returned by this function is NOT required to be the // maximum representable R8. This value varies from machine to machine, // from compiler to compiler, and may cause problems when being printed. // We simply want a "very large" but non-infinite number. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 06 October 2007 // // Author: // // John Burkardt // // Parameters: // // Output, double R8_HUGE, a "huge" R8 value. // { double value; value = 1.0E+30; return value; } //****************************************************************************80 void r8mat_write ( string output_filename, int m, int n, double table[] ) //****************************************************************************80 // // Purpose: // // R8MAT_WRITE writes an R8MAT file. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 29 June 2009 // // Author: // // John Burkardt // // Parameters: // // Input, string OUTPUT_FILENAME, the output filename. // // Input, int M, the spatial dimension. // // Input, int N, the number of points. // // Input, double TABLE[M*N], the table data. // { int i; int j; ofstream output; // // Open the file. // output.open ( output_filename.c_str ( ) ); if ( !output ) { cerr << "\n"; cerr << "R8MAT_WRITE - Fatal error!\n"; cerr << " Could not open the output file.\n"; return; } // // Write the data. // for ( j = 0; j < n; j++ ) { for ( i = 0; i < m; i++ ) { output << " " << setw(24) << setprecision(16) << table[i+j*m]; } output << "\n"; } // // Close the file. // output.close ( ); return; } //****************************************************************************80 void r8vec_direct_product2 ( int factor_index, int factor_order, double factor_value[], int factor_num, int point_num, double w[] ) //****************************************************************************80 // // Purpose: // // R8VEC_DIRECT_PRODUCT2 creates a direct product of R8VEC's. // // Discussion: // // An R8VEC is a vector of R8's. // // To explain what is going on here, suppose we had to construct // a multidimensional quadrature rule as the product of K rules // for 1D quadrature. // // The product rule will be represented as a list of points and weights. // // The J-th item in the product rule will be associated with // item J1 of 1D rule 1, // item J2 of 1D rule 2, // ..., // item JK of 1D rule K. // // In particular, // X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK)) // and // W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK) // // So we can construct the quadrature rule if we can properly // distribute the information in the 1D quadrature rules. // // This routine carries out that task for the weights W. // // Another way to do this would be to compute, one by one, the // set of all possible indices (J1,J2,...,JK), and then index // the appropriate information. An advantage of the method shown // here is that you can process the K-th set of information and // then discard it. // // Example: // // Rule 1: // Order = 4 // W(1:4) = ( 2, 3, 5, 7 ) // // Rule 2: // Order = 3 // W(1:3) = ( 11, 13, 17 ) // // Rule 3: // Order = 2 // W(1:2) = ( 19, 23 ) // // Product Rule: // Order = 24 // W(1:24) = // ( 2 * 11 * 19 ) // ( 3 * 11 * 19 ) // ( 4 * 11 * 19 ) // ( 7 * 11 * 19 ) // ( 2 * 13 * 19 ) // ( 3 * 13 * 19 ) // ( 5 * 13 * 19 ) // ( 7 * 13 * 19 ) // ( 2 * 17 * 19 ) // ( 3 * 17 * 19 ) // ( 5 * 17 * 19 ) // ( 7 * 17 * 19 ) // ( 2 * 11 * 23 ) // ( 3 * 11 * 23 ) // ( 5 * 11 * 23 ) // ( 7 * 11 * 23 ) // ( 2 * 13 * 23 ) // ( 3 * 13 * 23 ) // ( 5 * 13 * 23 ) // ( 7 * 13 * 23 ) // ( 2 * 17 * 23 ) // ( 3 * 17 * 23 ) // ( 5 * 17 * 23 ) // ( 7 * 17 * 23 ) // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 24 April 2009 // // Author: // // John Burkardt // // Parameters: // // Input, int FACTOR_INDEX, the index of the factor being processed. // The first factor processed must be factor 0. // // Input, int FACTOR_ORDER, the order of the factor. // // Input, double FACTOR_VALUE[FACTOR_ORDER], the factor values for // factor FACTOR_INDEX. // // Input, int FACTOR_NUM, the number of factors. // // Input, int POINT_NUM, the number of elements in the direct product. // // Input/output, double W[POINT_NUM], the elements of the // direct product, which are built up gradually. // // Local Parameters: // // Local, integer START, the first location of a block of values to set. // // Local, integer CONTIG, the number of consecutive values to set. // // Local, integer SKIP, the distance from the current value of START // to the next location of a block of values to set. // // Local, integer REP, the number of blocks of values to set. // { static int contig = 0; int i; int j; int k; static int rep = 0; static int skip = 0; int start; if ( factor_index == 0 ) { contig = 1; skip = 1; rep = point_num; for ( i = 0; i < point_num; i++ ) { w[i] = 1.0; } } rep = rep / factor_order; skip = skip * factor_order; for ( j = 0; j < factor_order; j++ ) { start = 0 + j * contig; for ( k = 1; k <= rep; k++ ) { for ( i = start; i < start + contig; i++ ) { w[i] = w[i] * factor_value[j]; } start = start + skip; } } contig = contig * factor_order; return; } //****************************************************************************80 int s_len_trim ( string s ) //****************************************************************************80 // // Purpose: // // S_LEN_TRIM returns the length of a string to the last nonblank. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 July 2009 // // Author: // // John Burkardt // // Parameters: // // Input, string S, a string. // // Output, int S_LEN_TRIM, the length of the string to the last nonblank. // If S_LEN_TRIM is 0, then the string is entirely blank. // { int n; n = s.length ( ); while ( 0 < n ) { if ( s[n-1] != ' ' ) { return n; } n = n - 1; } return n; } //****************************************************************************80 void sparse_grid_hermite ( int dim_num, int level_max, int point_num, double grid_weight[], double grid_point[] ) //****************************************************************************80 // // Purpose: // // SPARSE_GRID_HERMITE computes a sparse grid of Gauss-Hermite points. // // Discussion: // // The quadrature rule is associated with a sparse grid derived from // a Smolyak construction using a 1D Gauss-Hermite quadrature rule. // // The user specifies: // * the spatial dimension of the quadrature region, // * the level that defines the Smolyak grid. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 July 2008 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int LEVEL_MAX, controls the size of the final sparse grid. // // Input, int POINT_NUM, the number of points in the grid, as determined // by SPARSE_GRID_HERM_SIZE. // // Output, double GRID_WEIGHT[POINT_NUM], the weights. // // Output, double GRID_POINT[DIM_NUM*POINT_NUM], the points. // { int coeff; int dim; int *grid_base2; int *grid_index2; int *grid_level; double *grid_point_temp; double *grid_weight2; int h; int level; int *level_1d; int level_min; bool more; int *order_1d; int order_nd; int point; int point_num2; int point2; int point3; int t; for ( point = 0; point < point_num; point++ ) { grid_weight[point] = 0.0; } // // The outer loop generates LEVELs from LEVEL_MIN to LEVEL_MAX. // point_num2 = 0; level_min = i4_max ( 0, level_max + 1 - dim_num ); grid_base2 = new int[dim_num]; level_1d = new int[dim_num]; order_1d = new int[dim_num]; for ( level = level_min; level <= level_max; level++ ) { // // The middle loop generates the next partition LEVEL_1D(1:DIM_NUM) // that adds up to LEVEL. // more = false; h = 0; t = 0; for ( ; ; ) { comp_next ( level, dim_num, level_1d, &more, &h, &t ); // // Transform each 1D level to a corresponding 1D order. // The relationship is the same as for other OPEN rules. // The GL rule differs from the other OPEN rules only in the nesting behavior. // level_to_order_open ( dim_num, level_1d, order_1d ); for ( dim = 0; dim < dim_num; dim++ ) { grid_base2[dim] = ( order_1d[dim] - 1 ) / 2; } // // The product of the 1D orders gives us the number of points in this grid. // order_nd = i4vec_product ( dim_num, order_1d ); // // Compute the weights for this product grid. // grid_weight2 = product_weight_hermite ( dim_num, order_1d, order_nd ); // // Now determine the coefficient of the weight. // coeff = i4_power ( -1, level_max - level ) * choose ( dim_num - 1, level_max - level ); // // The inner (hidden) loop generates all points corresponding to given grid. // The grid indices will be between -M to +M, where 2*M + 1 = ORDER_1D(DIM). // grid_index2 = multigrid_index_z ( dim_num, order_1d, order_nd ); // // Determine the first level of appearance of each of the points. // This allows us to flag certain points as being repeats of points // generated on a grid of lower level. // // This is SLIGHTLY tricky. // grid_level = index_level_hermite ( level, level_max, dim_num, order_nd, grid_index2, grid_base2 ); // // Only keep those points which first appear on this level. // for ( point = 0; point < order_nd; point++ ) { // // Either a "new" point (increase count, create point, create weight) // if ( grid_level[point] == level ) { hermite_abscissa ( dim_num, 1, grid_index2+point*dim_num, grid_base2, grid_point+point_num2*dim_num ); grid_weight[point_num2] = ( double ) ( coeff ) * grid_weight2[point]; point_num2 = point_num2 + 1; } // // or an already existing point (create point temporarily, find match, // add weight to matched point's weight). // else { grid_point_temp = new double[dim_num]; hermite_abscissa ( dim_num, 1, grid_index2+point*dim_num, grid_base2, grid_point_temp ); for ( point2 = 0; point2 < point_num2; point2++ ) { point3 = point2; for ( dim = 0; dim < dim_num; dim++ ) { if ( grid_point[dim+point2*dim_num] != grid_point_temp[dim] ) { point3 = -1; break; } } if ( point3 == point2 ) { break; } } if ( point3 == -1 ) { cout << "\n"; cout << "SPARSE_GRID_HERM - Fatal error!\n"; cout << " Could not match point.\n"; exit ( 1 ); } grid_weight[point3] = grid_weight[point3] + ( double ) ( coeff ) * grid_weight2[point]; } } delete [] grid_index2; delete [] grid_level; delete [] grid_weight2; if ( !more ) { break; } } } delete [] grid_base2; delete [] level_1d; delete [] order_1d; return; } //****************************************************************************80 void sparse_grid_hermite_index ( int dim_num, int level_max, int point_num, int grid_index [], int grid_base[] ) //****************************************************************************80 // // Purpose: // // SPARSE_GRID_HERMITE_INDEX indexes points in a Gauss-Hermite sparse grid. // // Discussion: // // The sparse grid is assumed to be formed from 1D Gauss-Hermite rules // of ODD order, which have the property that only the central abscissa, // X = 0.0, is "nested". // // The necessary dimensions of GRID_INDEX can be determined by // calling SPARSE_GRID_HERMITE_SIZE first. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 July 2008 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int LEVEL_MAX, the maximum value of LEVEL. // // Input, int POINT_NUM, the total number of points in the grids. // // Output, int GRID_INDEX[DIM_NUM*POINT_NUM], a list of // point indices, representing a subset of the product grid of level // LEVEL_MAX, representing (exactly once) each point that will show up in a // sparse grid of level LEVEL_MAX. // // Output, int GRID_BASE[DIM_NUM*POINT_NUM], a list of // the orders of the Gauss-Hermite rules associated with each point // and dimension. // { int dim; int *grid_base2; int *grid_index2; int *grid_level; int h; int level; int *level_1d; int level_min; bool more; int *order_1d; int order_nd; int point; int point_num2; int t; // // The outer loop generates LEVELs from LEVEL_MIN to LEVEL_MAX. // point_num2 = 0; level_min = i4_max ( 0, level_max + 1 - dim_num ); grid_base2 = new int[dim_num]; level_1d = new int[dim_num]; order_1d = new int[dim_num]; for ( level = level_min; level <= level_max; level++ ) { // // The middle loop generates the next partition LEVEL_1D(1:DIM_NUM) // that adds up to LEVEL. // more = false; h = 0; t = 0; for ( ; ; ) { comp_next ( level, dim_num, level_1d, &more, &h, &t ); // // Transform each 1D level to a corresponding 1D order. // level_to_order_open ( dim_num, level_1d, order_1d ); for ( dim = 0; dim < dim_num; dim++ ) { grid_base2[dim] = ( order_1d[dim] - 1 ) / 2; } // // The product of the 1D orders gives us the number of points in this grid. // order_nd = i4vec_product ( dim_num, order_1d ); // // The inner (hidden) loop generates all points corresponding to given grid. // grid_index2 = multigrid_index_z ( dim_num, order_1d, order_nd ); // // Determine the first level of appearance of each of the points. // This allows us to flag certain points as being repeats of points // generated on a grid of lower level. // // This is SLIGHTLY tricky. // grid_level = index_level_hermite ( level, level_max, dim_num, order_nd, grid_index2, grid_base2 ); // // Only keep those points which first appear on this level. // for ( point = 0; point < order_nd; point++ ) { if ( grid_level[point] == level ) { for ( dim = 0; dim < dim_num; dim++ ) { grid_index[dim+point_num2*dim_num] = grid_index2[dim+point*dim_num]; grid_base[dim+point_num2*dim_num] = grid_base2[dim]; } point_num2 = point_num2 + 1; } } delete [] grid_index2; delete [] grid_level; if ( !more ) { break; } } } delete [] grid_base2; delete [] level_1d; delete [] order_1d; return; } //****************************************************************************80 int sparse_grid_hermite_size ( int dim_num, int level_max ) //****************************************************************************80 // // Purpose: // // SPARSE_GRID_HERMITE_SIZE sizes a sparse grid of Gauss-Hermite points. // // Discussion: // // The grid is defined as the sum of the product rules whose LEVEL // satisfies: // // LEVEL_MIN <= LEVEL <= LEVEL_MAX. // // where LEVEL_MAX is user specified, and // // LEVEL_MIN = max ( 0, LEVEL_MAX + 1 - DIM_NUM ). // // The grids are only very weakly nested, since Gauss-Hermite rules // only have the origin in common. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 05 July 2008 // // Author: // // John Burkardt // // Reference: // // Fabio Nobile, Raul Tempone, Clayton Webster, // A Sparse Grid Stochastic Collocation Method for Partial Differential // Equations with Random Input Data, // SIAM Journal on Numerical Analysis, // Volume 46, Number 5, 2008, pages 2309-2345. // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int LEVEL_MAX, the maximum value of LEVEL. // // Output, int SPARSE_GRID_HERM_SIZE, the number of points in the grid. // { int dim; int h; int level; int *level_1d; int level_min; bool more; int *order_1d; int point_num; int t; // // Special case. // if ( level_max == 0 ) { point_num = 1; return point_num; } // // The outer loop generates LEVELs from 0 to LEVEL_MAX. // point_num = 0; level_min = i4_max ( 0, level_max + 1 - dim_num ); level_1d = new int[dim_num]; order_1d = new int[dim_num]; for ( level = level_min; level <= level_max; level++ ) { // // The middle loop generates the next partition that adds up to LEVEL. // more = false; h = 0; t = 0; for ( ; ; ) { comp_next ( level, dim_num, level_1d, &more, &h, &t ); // // Transform each 1D level to a corresponding 1D order. // level_to_order_open ( dim_num, level_1d, order_1d ); for ( dim = 0; dim < dim_num; dim++ ) { // // If we can reduce the level in this dimension by 1 and // still not go below LEVEL_MIN. // if ( level_min < level && 1 < order_1d[dim] ) { order_1d[dim] = order_1d[dim] - 1; } } point_num = point_num + i4vec_product ( dim_num, order_1d ); if ( !more ) { break; } } } delete [] level_1d; delete [] order_1d; return point_num; } //****************************************************************************80 void timestamp ( ) //****************************************************************************80 // // Purpose: // // TIMESTAMP prints the current YMDHMS date as a time stamp. // // Example: // // 31 May 2001 09:45:54 AM // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 08 July 2009 // // Author: // // John Burkardt // // Parameters: // // None // { # define TIME_SIZE 40 static char time_buffer[TIME_SIZE]; const struct std::tm *tm_ptr; std::time_t now; now = std::time ( NULL ); tm_ptr = std::localtime ( &now ); std::strftime ( time_buffer, TIME_SIZE, "%d %B %Y %I:%M:%S %p", tm_ptr ); std::cout << time_buffer << "\n"; return; # undef TIME_SIZE } //****************************************************************************80 void vec_colex_next2 ( int dim_num, int base[], int a[], bool *more ) //****************************************************************************80 // // Purpose: // // VEC_COLEX_NEXT2 generates vectors in colex order. // // Discussion: // // The vectors are produced in colexical order, starting with // // (0, 0, ...,0), // (1, 0, ...,0), // ... // (BASE(1)-1,0, ...,0) // // (0, 1, ...,0) // (1, 1, ...,0) // ... // (BASE(1)-1,1, ...,0) // // (0, 2, ...,0) // (1, 2, ...,0) // ... // (BASE(1)-1,BASE(2)-1,...,BASE(DIM_NUM)-1). // // Examples: // // DIM_NUM = 2, // BASE = { 3, 3 } // // 0 0 // 1 0 // 2 0 // 0 1 // 1 1 // 2 1 // 0 2 // 1 2 // 2 2 // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 25 May 2007 // // Author: // // John Burkardt // // Parameters: // // Input, int DIM_NUM, the spatial dimension. // // Input, int BASE[DIM_NUM], the bases to be used in each dimension. // In dimension I, entries will range from 0 to BASE[I]-1. // // Output, int A[DIM_NUM], the next vector. // // Input/output, bool *MORE. Set this variable false before // the first call. On return, MORE is TRUE if another vector has // been computed. If MORE is returned FALSE, ignore the output // vector and stop calling the routine. // { int i; if ( !( *more ) ) { for ( i = 0; i < dim_num; i++ ) { a[i] = 0; } *more = true; } else { for ( i = 0; i < dim_num; i++ ) { a[i] = a[i] + 1; if ( a[i] < base[i] ) { return; } a[i] = 0; } *more = false; } return; }