void test14 ( )
/******************************************************************************/
/*
Purpose:
TEST14 tests MASS_MATRIX_T6.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 January 2013
Author:
John Burkardt
*/
{
# define ELEMENT_NUM 2
# define NODE_NUM 9
double *a;
int element_node[6*ELEMENT_NUM] = {
1, 3, 7, 2, 5, 4,
9, 7, 3, 8, 5, 6 };
double node_xy[2*NODE_NUM] = {
0.0, 0.0,
0.0, 0.5,
0.0, 1.0,
0.5, 0.0,
0.5, 0.5,
0.5, 1.0,
1.0, 0.0,
1.0, 0.5,
1.0, 1.0 };
printf ( "\n" );
printf ( "TEST14\n" );
printf ( " MASS_MATRIX_T6 computes the mass matrix for\n" );
printf ( " a finite element system using T6 elements\n" );
printf ( " (quadratic triangles).\n" );
a = mass_matrix_t6 ( NODE_NUM, ELEMENT_NUM, element_node, node_xy );
r8mat_print ( NODE_NUM, NODE_NUM, a, " The T6 mass matrix:" );
free ( a );
return;
# undef ELEMENT_NUM
# undef NODE_NUM
}
void test04 ( )
/******************************************************************************/
/*
Purpose:
TEST04 tests DQRLS.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 September 2012
Author:
John Burkardt
*/
{
double *a;
double b[5] = { 1.0, 2.3, 4.6, 3.1, 1.2 };
int i;
int ind;
int itask;
int j;
int *jpvt;
int kr;
int m = 5;
int n = 3;
double *qraux;
double tol;
double *x;
a = ( double * ) malloc ( m * n * sizeof ( double ) );
jpvt = ( int * ) malloc ( n * sizeof ( int ) );
qraux = ( double * ) malloc ( n * sizeof ( double ) );
x = ( double * ) malloc ( n * sizeof ( double ) );
/*
Set up least-squares problem
quadratic model, equally-spaced points
*/
printf ( "\n" );
printf ( "TEST04\n" );
printf ( " DQRLS solves a linear system A*x = b in the least squares sense.\n" );
for ( i = 0; i < m; i++ )
{
a[i+0*m] = 1.0;
for ( j = 1; j < n; j++ )
{
a[i+j*m] = a[i+(j-1)*m] * ( double ) ( i + 1 );
}
}
tol = 1.0E-06;
r8mat_print ( m, n, a, " Coefficient matrix A:" );
r8vec_print ( m, b, " Right hand side b:" );
/*
Solve least-squares problem
*/
itask = 1;
ind = dqrls ( a, m, m, n, tol, &kr, b, x, b, jpvt, qraux, itask );
/*
Print results
*/
printf ( "\n" );
printf ( " Error code = %d\n", ind );
printf ( " Estimated matrix rank = %d\n", kr );
r8vec_print ( n, x, " Least squares solution x:" );
r8vec_print ( m, b, " Residuals A*x-b" );
free ( a );
free ( jpvt );
free ( qraux );
free ( x );
return;
}
void test01 ( )
/******************************************************************************/
/*
Purpose:
TEST01 uses a 4x4 test matrix.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
15 July 2013
Author:
John Burkardt
*/
{
# define N 4
double a[N*N] = {
4.0, -30.0, 60.0, -35.0,
-30.0, 300.0, -675.0, 420.0,
60.0, -675.0, 1620.0, -1050.0,
-35.0, 420.0, -1050.0, 700.0 };
double d[N];
double error_frobenius;
int it_max;
int it_num;
int n = N;
int rot_num;
double v[N*N];
printf ( "\n" );
printf ( "TEST01\n" );
printf ( " For a symmetric matrix A,\n" );
printf ( " JACOBI_EIGENVALUE computes the eigenvalues D\n" );
printf ( " and eigenvectors V so that A * V = D * V.\n" );
r8mat_print ( n, n, a, " Input matrix A:" );
it_max = 100;
jacobi_eigenvalue ( n, a, it_max, v, d, &it_num, &rot_num );
printf ( "\n" );
printf ( " Number of iterations = %d\n", it_num );
printf ( " Number of rotations = %d\n", rot_num );
r8vec_print ( n, d, " Eigenvalues D:" );
r8mat_print ( n, n, v, " Eigenvector matrix V:" );
/*
Compute eigentest.
*/
error_frobenius = r8mat_is_eigen_right ( n, n, a, v, d );
printf ( "\n" );
printf ( " Frobenius norm error in eigensystem A*V-D*V = %g\n",
error_frobenius );
return;
# undef N
}
void test03 ( )
/******************************************************************************/
/*
Purpose:
TEST03 uses a 5x5 test matrix.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
15 July 2013
Author:
John Burkardt
*/
{
# define N 5
double a[N*N];
double d[N];
double error_frobenius;
int i;
int it_max;
int it_num;
int j;
int n = N;
int rot_num;
double v[N*N];
printf ( "\n" );
printf ( "TEST03\n" );
printf ( " For a symmetric matrix A,\n" );
printf ( " JACOBI_EIGENVALUE computes the eigenvalues D\n" );
printf ( " and eigenvectors V so that A * V = D * V.\n" );
printf ( "\n" );
printf ( " Use the discretized second derivative matrix.\n" );
for ( j = 0; j < n; j++ )
{
for ( i = 0; i < n; i++ )
{
if ( i == j )
{
a[i+j*n] = -2.0;
}
else if ( i == j + 1 || i == j - 1 )
{
a[i+j*n] = 1.0;
}
else
{
a[i+j*n] = 0.0;
}
}
}
r8mat_print ( n, n, a, " Input matrix A:" );
it_max = 100;
jacobi_eigenvalue ( n, a, it_max, v, d, &it_num, &rot_num );
printf ( "\n" );
printf ( " Number of iterations = %d\n", it_num );
printf ( " Number of rotations = %d\n", rot_num );
r8vec_print ( n, d, " Eigenvalues D:" );
r8mat_print ( n, n, v, " Eigenvector matrix V:" );
/*
Compute eigentest.
*/
error_frobenius = r8mat_is_eigen_right ( n, n, a, v, d );
printf ( "\n" );
printf ( " Frobenius norm error in eigensystem A*V-D*V = %g\n",
error_frobenius );
return;
# undef N
}
void matrix_exponential_test01 ( void )
/******************************************************************************/
/*
Purpose:
MATRIX_EXPONENTIAL_TEST01 compares matrix exponential algorithms.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
02 December 2011
Author:
John Burkardt
*/
{
double *a;
double *a_exp;
int n;
int test;
int test_num;
printf ( "\n" );
printf ( "MATRIX_EXPONENTIAL_TEST01:\n" );
printf ( " EXPM is MATLAB's matrix exponential function\n" );
printf ( " EXPM11 is an equivalent to EXPM\n" );
printf ( " EXPM2 uses a Taylor series approach\n" );
printf ( " EXPM3 relies on an eigenvalue calculation.\n" );
test_num = mexp_test_num ( );
for ( test = 1; test <= test_num; test++ )
{
printf ( "\n" );
printf ( " Test #%d\n", test );
mexp_story ( test );
n = mexp_n ( test );
printf ( " Matrix order N = %d\n", n );
a = mexp_a ( test, n );
r8mat_print ( n, n, a, " Matrix:" );
a_exp = expm11 ( n, a );
r8mat_print ( n, n, a_exp, " EXPM1(A):" );
free ( a_exp );
a_exp = expm2 ( n, a );
r8mat_print ( n, n, a_exp, " EXPM2(A):" );
free ( a_exp );
/*
a_exp = expm3 ( n, a );
r8mat_print ( n, n, a_exp, " EXPM3(A):" );
free ( a_exp );
*/
a_exp = mexp_expa ( test, n );
r8mat_print ( n, n, a_exp, " Exact Exponential:" );
free ( a_exp );
free ( a );
}
return;
}
void test02 ( void )
/******************************************************************************/
/*
Purpose:
TEST02 tests R8MAT_FLOYD.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 July 2011
Author:
John Burkardt
*/
{
# define N 6
double a[N*N] = {
0.0, -1.0, -1.0, -1.0, -1.0, -1.0,
2.0, 0.0, -1.0, -1.0, -1.0, 5.0,
5.0, 7.0, 0.0, -1.0, 2.0, -1.0,
-1.0, 1.0, 4.0, 0.0, -1.0, 2.0,
-1.0, -1.0, -1.0, 3.0, 0.0, 4.0,
-1.0, 8.0, -1.0, -1.0, 3.0, 0.0 };
double huge;
int i;
int j;
int n = N;
printf ( "\n" );
printf ( "TEST02\n" );
printf ( " R8MAT_FLOYO uses Floyd's algorithm to find the\n" );
printf ( " shortest distance between all pairs of nodes\n" );
printf ( " in a directed graph, starting from the initial array\n" );
printf ( " of direct node-to-node distances.\n" );
printf ( "\n" );
printf ( " In the initial direct distance array, if\n" );
printf ( " A(I,J) = -1,\n" );
printf ( " this indicates there is NO directed link from\n" );
printf ( " node I to node J. In that case, the value of\n" );
printf ( " of A(I,J) is essentially \"infinity\".\n" );
r8mat_print ( n, n, a, " Initial direct distance array:" );
huge = r8_huge ( );
for ( j = 0; j < n; j++ )
{
for ( i = 0; i < n; i++ )
{
if ( a[i+j*n] == - 1.0 )
{
a[i+j*n] = huge;
}
}
}
r8mat_floyd ( n, a );
for ( j = 0; j < n; j++ )
{
for ( i = 0; i < n; i++ )
{
if ( a[i+j*n] == huge )
{
a[i+j*n] = - 1.0;
}
}
}
printf ( "\n" );
printf ( " In the final shortest distance array, if\n" );
printf ( " A(I,J) = -1,\n" );
printf ( " this indicates there is NO directed path from\n" );
printf ( " node I to node J.\n" );
r8mat_print ( n, n, a, " Final shortest distance array:" );
return;
# undef N
}
void test01 ( )
/******************************************************************************/
/*
Purpose:
TEST01 verifies LOCAL_BASIS_1D.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
04 July 2013
Author:
John Burkardt
Parameters:
None
*/
{
# define NODE_NUM 4
double a;
double b;
int i;
int j;
int node_num = NODE_NUM;
double node_x[NODE_NUM] = { 1.0, 2.0, 4.0, 4.5 };
double *phi;
double phi_matrix[NODE_NUM*NODE_NUM];
double s;
int seed;
double x;
printf ( "\n" );
printf ( "TEST01:\n" );
printf ( " LOCAL_BASIS_1D evaluates the local basis functions\n" );
printf ( " for a 1D element.\n" );
printf ( "\n" );
printf ( " Test that the basis functions, evaluated at the nodes,\n" );
printf ( " form the identity matrix.\n" );
printf ( "\n" );
printf ( " Number of nodes = %d\n", node_num );
printf ( "\n" );
printf ( " Node coordinates:\n" );
printf ( "\n" );
for ( j = 0; j < node_num; j++ )
{
printf ( " %8d %7g\n", j, node_x[j] );
}
for ( j = 0; j < node_num; j++ )
{
x = node_x[j];
phi = local_basis_1d ( node_num, node_x, x );
for ( i = 0; i < node_num; i++ )
{
phi_matrix[i+j*node_num] = phi[i];
}
free ( phi );
}
r8mat_print ( node_num, node_num, phi_matrix, " A(I,J) = PHI(I) at node (J):" );
seed = 123456789;
printf ( "\n" );
printf ( " The PHI functions should sum to 1 at random X values:\n" );
printf ( "\n" );
printf ( " X Sum ( PHI(:)(X) )\n" );
printf ( "\n" );
a = 1.0;
b = 4.5;
for ( j = 1; j <= 5; j++ )
{
x = r8_uniform_ab ( a, b, &seed );
phi = local_basis_1d ( node_num, node_x, x );
s = r8vec_sum ( node_num, phi );
printf ( " %14g %14g\n", x, s );
free ( phi );
}
return;
# undef NODE_NUM
}
void test135 ( )
/******************************************************************************/
/*
Purpose:
TEST135 tests MASS_MATRIX_T3.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 January 2013
Author:
John Burkardt
*/
{
# define ELEMENT_NUM 8
# define NODE_NUM 9
double *a;
int element_node[3*ELEMENT_NUM] = {
1, 4, 2,
5, 2, 4,
4, 7, 5,
8, 5, 7,
2, 5, 3,
6, 3, 5,
5, 8, 6,
9, 6, 8 };
double node_xy[2*NODE_NUM] = {
0.0, 0.0,
0.0, 0.5,
0.0, 1.0,
0.5, 0.0,
0.5, 0.5,
0.5, 1.0,
1.0, 0.0,
1.0, 0.5,
1.0, 1.0 };
printf ( "\n" );
printf ( "TEST135\n" );
printf ( " MASS_MATRIX_T3 computes the mass matrix for\n" );
printf ( " a finite element system using T3 elements\n" );
printf ( " (linear triangles).\n" );
a = mass_matrix_t3 ( NODE_NUM, ELEMENT_NUM, element_node, node_xy );
r8mat_print ( NODE_NUM, NODE_NUM, a, " The T3 mass matrix:" );
free ( a );
return;
# undef ELEMENT_NUM
# undef NODE_NUM
}
void dgesv_test ( )
/******************************************************************************/
/*
Purpose:
DGESV_TEST uses DGESV to solve a general linear system A*x=b.
Discussion:
Solve
1.0 -1.0 2.0 -1.0 x(0) -8.0
2.0 -2.0 3.0 -3.0 * x(1) = -20.0
1.0 1.0 1.0 0.0 x(2) -2.0
1.0 -1.0 4.0 3.0 x(3) 4.0
The solution is ( -7, 3, 2, 2 ).
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 January 2014
Author:
John Burkardt
*/
{
/*
The matrix must be stored in column-major form, so what you
see below looks like the transpose of the actual matrix.
*/
double A[4*4] = {
1.0, 2.0, 1.0, 1.0,
-1.0, -2.0, 1.0, -1.0,
2.0, 3.0, 1.0, 4.0,
-1.0, -3.0, 0.0, 3.0 };
double B[4] = {
-8.0, -20.0, -2.0, 4.0 };
int i;
static long int INFO;
int info2;
static long int IPIV[4];
int j;
long int LDA;
long int LDB;
long int N = 4;
long int NRHS;
printf ( "\n" );
printf ( "DGESV_TEST\n" );
printf ( " Demonstrate the use of DGESV to solve a linear system\n" );
printf ( " using double precision real arithmetic.\n" );
/*
Print the coefficient matrix.
*/
r8mat_print ( N, N, A, " Coefficient matrix A:" );
/*
Print the right hand side.
*/
r8vec_print ( N, B, " Right hand side B:\n" );
/*
Call DGESV to compute the solution.
*/
NRHS = 1;
LDA = N;
LDB = N;
dgesv_ ( &N, &NRHS, A, &LDA, IPIV, B, &LDB, &INFO );
printf ( "\n" );
printf ( " Return value of error flag INFO = %d\n", ( int ) INFO );
/*
Print the solution.
*/
r8vec_print ( N, B, " Computed solution X:\n" );
return;
}
void dsyev_test ( )
/******************************************************************************/
/*
Purpose:
DSYEV_TEST tests DSYEV.
Discussion:
For some reason, you can't use "int" variables as arguments to CLAPACK
functions; you have to use "integer" variables, which are apparently
a name for the standard "long int" datatype. If you also want to
use int variables here and there, you may need to declare two versions
of the same quantity.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
17 July 2013
Author:
John Burkardt
*/
{
double *a;
int info;
long int INFO;
char jobz;
double *lambda;
int lwork;
long int LWORK;
int n;
long int N = 7;
char uplo;
double *work;
printf ( "\n" );
printf ( "DSYEV_TEST\n" );
printf ( " For a double precision real matrix (D)\n" );
printf ( " in symmetric storage mode (SY):\n" );
printf ( "\n" );
printf ( " For a symmetric matrix in general storage,\n" );
printf ( " DSYEV computes eigenvalues and eigenvectors;\n" );
/*
Set A.
*/
n = ( int ) N;
a = clement2 ( n );
r8mat_print ( n, n, a, " The matrix A:" );
/*
Compute the eigenvalues and eigenvectors.
*/
jobz = 'V';
uplo = 'U';
lambda = ( double * ) malloc ( N * sizeof ( double ) );
LWORK = 3 * N - 1;
work = ( double * ) malloc ( LWORK * sizeof ( double ) );
dsyev_ ( &jobz, &uplo, &N, a, &N, lambda, work, &LWORK, &INFO );
info = ( int ) INFO;
if ( info != 0 )
{
printf ( "\n" );
printf ( " DSYEV returned nonzero INFO = %d\n", info );
}
else
{
r8vec_print ( n, lambda, " The eigenvalues:" );
if ( jobz == 'V' )
{
r8mat_print ( n, n, a, " The eigenvector matrix:" );
}
}
free ( a );
free ( lambda );
free ( work );
return;
}
void dgetri_test ( )
/******************************************************************************/
/*
Purpose:
DGETRI_TEST tests DGETRF and DGETRI.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 January 2014
Author:
John Burkardt
*/
{
double A[3*3] = {
1.0, 4.0, 7.0,
2.0, 5.0, 8.0,
3.0, 6.0, 0.0 };
long int INFO;
long int IPIV[3];
long int LDA;
long int LWORK;
long int N = 3;
double WORK[3];
printf ( "\n" );
printf ( "DGETRI_TEST\n" );
printf ( " For a double precision real matrix (D)\n" );
printf ( " in general storage mode (GE):\n" );
printf ( "\n" );
printf ( " DGETRF factors a general matrix;\n" );
printf ( " DGETRI computes the inverse.\n" );
r8mat_print ( N, N, A, " The matrix A:" );
/*
Factor the matrix.
*/
LDA = N;
dgetrf_ ( &N, &N, A, &LDA, IPIV, &INFO );
if ( ( int ) INFO != 0 )
{
printf ( "\n" );
printf ( " DGETRF returned INFO = %d\n", INFO );
printf ( " The matrix is numerically singular.\n" );
return;
}
/*
Compute the inverse matrix.
*/
LWORK = N;
dgetri_ ( &N, A, &LDA, IPIV, WORK, &LWORK, &INFO );
if ( ( int ) INFO != 0 )
{
printf ( "\n" );
printf ( " The inversion procedure failed!\n" );
printf ( " ' INFO = %d\n", INFO );
return;
}
/*
Print the inverse matrix.
*/
r8mat_print ( N, N, A, " The inverse matrix:" );
return;
}
void dgetrf_test ( )
/******************************************************************************/
/*
Purpose:
DGETRF_TEST demonstrates DGETRF and DGETRS.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 January 2014
Author:
John Burkardt
*/
{
double A[4*4] = {
1.0, 2.0, 1.0, 1.0,
-1.0, -2.0, 1.0, -1.0,
2.0, 3.0, 1.0, 4.0,
-1.0, -3.0, 0.0, 3.0 };
double B[4] = {
-8.0, -20.0, -2.0, 4.0 };
int i;
static long int INFO;
int info2;
static long int IPIV[4];
int j;
long int LDA;
long int LDB;
long int N = 4;
long int NRHS;
char TRANS;
printf ( "\n" );
printf ( "DGETRF_TEST\n" );
printf ( " Demonstrate the use of:\n" );
printf ( " DGETRF to factor a general matrix A,\n" );
printf ( " DGETRS to solve A*x=b after A has been factored,\n" );
printf ( " using double precision real arithmetic.\n" );
/*
Print the coefficient matrix.
*/
r8mat_print ( N, N, A, " Coefficient matrix A:" );
/*
Call DGETRF to factor the matrix.
*/
LDA = N;
dgetrf_ ( &N, &N, A, &LDA, IPIV, &INFO );
printf ( "\n" );
printf ( " Return value of DGETRF error flag INFO = %d\n", ( int ) INFO );
/*
Print the right hand side.
*/
r8vec_print ( N, B, " Right hand side B:\n" );
/*
Call DGETRS to solve the linear system A*x=b.
*/
TRANS = 'N';
NRHS = 1;
LDB = N;
dgetrs_ ( &TRANS, &N, &NRHS, A, &LDA, IPIV, B, &LDB, &INFO );
printf ( "\n" );
printf ( " Return value of DGETRS error flag INFO = %d\n", ( int ) INFO );
/*
Solution X is returned in B.
*/
r8vec_print ( N, B, " Computed solution X:\n" );
return;
}
void dgesvd_test ( )
/******************************************************************************/
/*
Purpose:
DGESVD_TEST demonstrates DGESVD.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 January 2014
Author:
John Burkardt
*/
{
# define MVAL 4
# define NVAL 4
/*
The entries of A are listed by columns, not rows!
*/
long int LWORK = 201;
double a[MVAL*NVAL] = {
16.0, 5.0, 9.0, 4.0,
2.0, 11.0, 7.0, 14.0,
3.0, 10.0, 6.0, 15.0,
13.0, 8.0, 12.0, 1.0 };
int i;
long int INFO;
int j;
char JOBU = 'A';
char JOBVT = 'A';
long int LDA = MVAL;
long int LDU = MVAL;
long int LDVT = NVAL;
long int M = MVAL;
long int N = NVAL;
long int mn = min ( MVAL, NVAL );
long int MN = max ( MVAL, NVAL );
double s[MVAL];
double uu[MVAL*MVAL];
double vt[NVAL*NVAL];
double wk[LWORK];
printf ( "\n" );
printf ( "DGESVD_TEST\n" );
printf ( " Demonstrate the use of DGESVD to compute the\n" );
printf ( " singular value decomposition A = U * S * V',\n" );
printf ( " using double precision real arithmetic.\n" );
/*
Print the coefficient matrix.
*/
r8mat_print ( M, N, a, " Coefficient matrix A:" );
/*
Call DGESVD for singular value decomposition A = U * S * V'.
*/
dgesvd_ ( &JOBU, &JOBVT, &M, &N, a, &LDA, s, uu, &LDU, vt, &LDVT, wk,
&LWORK, &INFO );
printf ( "\n" );
printf ( " Error flag INFO = %d\n", ( int ) INFO );
/*
Print the singular values.
*/
r8vec_print ( M, s, " Singular values:\n" );
return;
# undef MVAL
# undef NVAL
}
