# include # include # include # include # include # include # include using namespace std; # include "quadrature_golub_welsch.hpp" //****************************************************************************80 void imtqlx ( int n, double d[], double e[], double z[] ) //****************************************************************************80 // // Purpose: // // IMTQLX diagonalizes a symmetric tridiagonal matrix. // // Discussion: // // This routine is a slightly modified version of the EISPACK routine to // perform the implicit QL algorithm on a symmetric tridiagonal matrix. // // The authors thank the authors of EISPACK for permission to use this // routine. // // It has been modified to produce the product Q' * Z, where Z is an input // vector and Q is the orthogonal matrix diagonalizing the input matrix. // The changes consist (essentially) of applying the orthogonal transformations // directly to Z as they are generated. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 08 January 2010 // // Author: // // Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. // C++ version by John Burkardt. // // Reference: // // Sylvan Elhay, Jaroslav Kautsky, // Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of // Interpolatory Quadrature, // ACM Transactions on Mathematical Software, // Volume 13, Number 4, December 1987, pages 399-415. // // Roger Martin, James Wilkinson, // The Implicit QL Algorithm, // Numerische Mathematik, // Volume 12, Number 5, December 1968, pages 377-383. // // Parameters: // // Input, int N, the order of the matrix. // // Input/output, double D(N), the diagonal entries of the matrix. // On output, the information in D has been overwritten. // // Input/output, double E(N), the subdiagonal entries of the // matrix, in entries E(1) through E(N-1). On output, the information in // E has been overwritten. // // Input/output, double Z(N). On input, a vector. On output, // the value of Q' * Z, where Q is the matrix that diagonalizes the // input symmetric tridiagonal matrix. // { double b; double c; double f; double g; int i; int ii; int itn = 30; int j; int k; int l; int m; int mml; double p; double prec; double r; double s; prec = DBL_EPSILON; if ( n == 1 ) { return; } e[n-1] = 0.0; for ( l = 1; l <= n; l++ ) { j = 0; for ( ; ; ) { for ( m = l; m <= n; m++ ) { if ( m == n ) { break; } if ( fabs ( e[m-1] ) <= prec * ( fabs ( d[m-1] ) + fabs ( d[m] ) ) ) { break; } } p = d[l-1]; if ( m == l ) { break; } if ( itn <= j ) { cerr << "\n"; cerr << "IMTQLX - Fatal error!\n"; cerr << " Iteration limit exceeded\n"; exit ( 1 ); } j = j + 1; g = ( d[l] - p ) / ( 2.0 * e[l-1] ); r = sqrt ( g * g + 1.0 ); g = d[m-1] - p + e[l-1] / ( g + fabs ( r ) * r8_sign ( g ) ); s = 1.0; c = 1.0; p = 0.0; mml = m - l; for ( ii = 1; ii <= mml; ii++ ) { i = m - ii; f = s * e[i-1]; b = c * e[i-1]; if ( fabs ( g ) <= fabs ( f ) ) { c = g / f; r = sqrt ( c * c + 1.0 ); e[i] = f * r; s = 1.0 / r; c = c * s; } else { s = f / g; r = sqrt ( s * s + 1.0 ); e[i] = g * r; c = 1.0 / r; s = s * c; } g = d[i] - p; r = ( d[i-1] - g ) * s + 2.0 * c * b; p = s * r; d[i] = g + p; g = c * r - b; f = z[i]; z[i] = s * z[i-1] + c * f; z[i-1] = c * z[i-1] - s * f; } d[l-1] = d[l-1] - p; e[l-1] = g; e[m-1] = 0.0; } } // // Sorting. // for ( ii = 2; ii <= m; ii++ ) { i = ii - 1; k = i; p = d[i-1]; for ( j = ii; j <= n; j++ ) { if ( d[j-1] < p ) { k = j; p = d[j-1]; } } if ( k != i ) { d[k-1] = d[i-1]; d[i-1] = p; p = z[i-1]; z[i-1] = z[k-1]; z[k-1] = p; } } return; } //****************************************************************************80 double r8_sign ( double x ) //****************************************************************************80 // // Purpose: // // R8_SIGN returns the sign of an R8. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 18 October 2004 // // Author: // // John Burkardt // // Parameters: // // Input, double X, the number whose sign is desired. // // Output, double R8_SIGN, the sign of X. // { double value; if ( x < 0.0 ) { value = -1.0; } else { value = 1.0; } return value; } //****************************************************************************80 void r8mat_print ( int m, int n, double a[], string title ) //****************************************************************************80 // // Purpose: // // R8MAT_PRINT prints an R8MAT. // // Discussion: // // An R8MAT is a doubly dimensioned array of R8 values, stored as a vector // in column-major order. // // Entry A(I,J) is stored as A[I+J*M] // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 10 September 2009 // // Author: // // John Burkardt // // Parameters: // // Input, int M, the number of rows in A. // // Input, int N, the number of columns in A. // // Input, double A[M*N], the M by N matrix. // // Input, string TITLE, a title. // { r8mat_print_some ( m, n, a, 1, 1, m, n, title ); return; } //****************************************************************************80 void r8mat_print_some ( int m, int n, double a[], int ilo, int jlo, int ihi, int jhi, string title ) //****************************************************************************80 // // Purpose: // // R8MAT_PRINT_SOME prints some of an R8MAT. // // Discussion: // // An R8MAT is a doubly dimensioned array of R8 values, stored as a vector // in column-major order. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 26 June 2013 // // Author: // // John Burkardt // // Parameters: // // Input, int M, the number of rows of the matrix. // M must be positive. // // Input, int N, the number of columns of the matrix. // N must be positive. // // Input, double A[M*N], the matrix. // // Input, int ILO, JLO, IHI, JHI, designate the first row and // column, and the last row and column to be printed. // // Input, string TITLE, a title. // { # define INCX 5 int i; int i2hi; int i2lo; int j; int j2hi; int j2lo; cout << "\n"; cout << title << "\n"; if ( m <= 0 || n <= 0 ) { cout << "\n"; cout << " (None)\n"; return; } // // Print the columns of the matrix, in strips of 5. // for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX ) { j2hi = j2lo + INCX - 1; if ( n < j2hi ) { j2hi = n; } if ( jhi < j2hi ) { j2hi = jhi; } cout << "\n"; // // For each column J in the current range... // // Write the header. // cout << " Col: "; for ( j = j2lo; j <= j2hi; j++ ) { cout << setw(7) << j - 1 << " "; } cout << "\n"; cout << " Row\n"; cout << "\n"; // // Determine the range of the rows in this strip. // if ( 1 < ilo ) { i2lo = ilo; } else { i2lo = 1; } if ( ihi < m ) { i2hi = ihi; } else { i2hi = m; } for ( i = i2lo; i <= i2hi; i++ ) { // // Print out (up to) 5 entries in row I, that lie in the current strip. // cout << setw(5) << i - 1 << ": "; for ( j = j2lo; j <= j2hi; j++ ) { cout << setw(12) << a[i-1+(j-1)*m] << " "; } cout << "\n"; } } return; # undef INCX } //****************************************************************************80 double *r8vec_even_new ( int n, double alo, double ahi ) //****************************************************************************80 // // Purpose: // // R8VEC_EVEN_NEW returns an R8VEC of values evenly spaced between ALO and AHI. // // Discussion: // // An R8VEC is a vector of R8's. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 18 May 2009 // // Author: // // John Burkardt // // Parameters: // // Input, int N, the number of values. // // Input, double ALO, AHI, the low and high values. // // Output, double R8VEC_EVEN_NEW[N], N evenly spaced values. // Normally, A[0] = ALO and A[N-1] = AHI. // However, if N = 1, then A[0] = 0.5*(ALO+AHI). // { double *a; int i; a = new double[n]; if ( n == 1 ) { a[0] = 0.5 * ( alo + ahi ); } else { for ( i = 0; i < n; i++ ) { a[i] = ( ( double ) ( n - i - 1 ) * alo + ( double ) ( i ) * ahi ) / ( double ) ( n - 1 ); } } return a; } //****************************************************************************80 void r8vec_print ( int n, double a[], string title ) //****************************************************************************80 // // Purpose: // // R8VEC_PRINT prints an R8VEC. // // Discussion: // // An R8VEC is a vector of R8's. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 16 August 2004 // // Author: // // John Burkardt // // Parameters: // // Input, int N, the number of components of the vector. // // Input, double A[N], the vector to be printed. // // Input, string TITLE, a title. // { int i; cout << "\n"; cout << title << "\n"; cout << "\n"; for ( i = 0; i < n; i++ ) { cout << " " << setw(8) << i << " " << setw(14) << a[i] << "\n"; } return; } //****************************************************************************80 void sgqf ( int nt, double aj[], double bj[], double zemu, double t[], double wts[] ) //****************************************************************************80 // // Purpose: // // SGQF computes knots and weights of a Gauss Quadrature formula. // // Discussion: // // This routine computes all the knots and weights of a Gauss quadrature // formula with simple knots from the Jacobi matrix and the zero-th // moment of the weight function, using the Golub-Welsch technique. // // Licensing: // // This code is distributed under the MIT license. // // Modified: // // 08 January 2010 // // Author: // // Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. // C++ version by John Burkardt. // // Reference: // // Sylvan Elhay, Jaroslav Kautsky, // Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of // Interpolatory Quadrature, // ACM Transactions on Mathematical Software, // Volume 13, Number 4, December 1987, pages 399-415. // // Parameters: // // Input, int NT, the number of knots. // // Input, double AJ[NT], the diagonal of the Jacobi matrix. // // Input/output, double BJ[NT], the subdiagonal of the Jacobi // matrix, in entries 1 through NT-1. On output, BJ has been overwritten. // // Input, double ZEMU, the zero-th moment of the weight function. // // Output, double T[NT], the knots. // // Output, double WTS[NT], the weights. // { int i; // // Exit if the zero-th moment is not positive. // if ( zemu <= 0.0 ) { cerr << "\n"; cerr << "SGQF - Fatal error!\n"; cerr << " ZEMU <= 0.\n"; exit ( 1 ); } // // Set up vectors for IMTQLX. // for ( i = 0; i < nt; i++ ) { t[i] = aj[i]; } wts[0] = sqrt ( zemu ); for ( i = 1; i < nt; i++ ) { wts[i] = 0.0; } // // Diagonalize the Jacobi matrix. // imtqlx ( nt, t, bj, wts ); for ( i = 0; i < nt; i++ ) { wts[i] = wts[i] * wts[i]; } return; } //****************************************************************************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 }