private static void dgemm_test()
//****************************************************************************80
//
// Purpose:
//
// DGEMM_TEST tests DGEMM.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 10 February 2014
//
// Author:
//
// John Burkardt
//
{
Console.WriteLine("");
Console.WriteLine("DGEMM_TEST");
Console.WriteLine(" DGEMM carries out matrix multiplications");
Console.WriteLine(" for double precision real matrices.");
Console.WriteLine("");
Console.WriteLine(" 1: C = alpha * A * B + beta * C;");
Console.WriteLine(" 2: C = alpha * A' * B + beta * C;");
Console.WriteLine(" 3: C = alpha * A * B' + beta * C;");
Console.WriteLine(" 4: C = alpha * A' * B' + beta * C;");
Console.WriteLine("");
Console.WriteLine(" We carry out all four calculations, but in each case,");
Console.WriteLine(" we choose our input matrices so that we get the same result.");
//
// C = alpha * A * B + beta * C.
//
char transa = 'N';
char transb = 'N';
char transc = 'N';
int m = 4;
int n = 5;
int k = 3;
double alpha = 2.0;
int lda = m;
double[] a = BLASData.r8mat_test(transa, lda, m, k);
int ldb = k;
double[] b = BLASData.r8mat_test(transb, ldb, k, n);
double beta = 3.0;
int ldc = m;
double[] c = BLASData.r8mat_test(transc, ldc, m, n);
BLAS3D.dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, ref c, ldc);
typeMethods.r8mat_print(m, n, c, " C = alpha * A * B + beta * C:");
//
// C = alpha * A' * B + beta * C.
//
transa = 'T';
transb = 'N';
transc = 'N';
m = 4;
n = 5;
k = 3;
alpha = 2.0;
lda = k;
a = BLASData.r8mat_test(transa, lda, m, k);
ldb = k;
b = BLASData.r8mat_test(transb, ldb, k, n);
beta = 3.0;
ldc = m;
c = BLASData.r8mat_test(transc, ldc, m, n);
BLAS3D.dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, ref c, ldc);
typeMethods.r8mat_print(m, n, c, " C = alpha * A' * B + beta * C:");
//
// C = alpha * A * B' + beta * C.
//
transa = 'N';
transb = 'T';
transc = 'N';
m = 4;
n = 5;
k = 3;
alpha = 2.0;
lda = m;
a = BLASData.r8mat_test(transa, lda, m, k);
ldb = n;
b = BLASData.r8mat_test(transb, ldb, k, n);
beta = 3.0;
ldc = m;
c = BLASData.r8mat_test(transc, ldc, m, n);
BLAS3D.dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, ref c, ldc);
typeMethods.r8mat_print(m, n, c, " C = alpha * A * B' + beta * C:");
//
// C = alpha * A' * B' + beta * C.
//
transa = 'T';
transb = 'T';
transc = 'N';
m = 4;
n = 5;
k = 3;
alpha = 2.0;
lda = k;
a = BLASData.r8mat_test(transa, lda, m, k);
ldb = n;
b = BLASData.r8mat_test(transb, ldb, k, n);
beta = 3.0;
ldc = m;
c = BLASData.r8mat_test(transc, ldc, m, n);
BLAS3D.dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, ref c, ldc);
typeMethods.r8mat_print(m, n, c, " C = alpha * A' * B' + beta * C:");
}
private static void dtrmm_test()
//****************************************************************************80
//
// Purpose:
//
// DTRMM_TEST tests DTRMM.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 05 April 2014
//
// Author:
//
// John Burkardt
//
{
int i;
int j;
Console.WriteLine("");
Console.WriteLine("DTRMM_TEST");
Console.WriteLine(" DTRMM multiplies a triangular matrix A and a");
Console.WriteLine(" rectangular matrix B");
Console.WriteLine("");
Console.WriteLine(" 1: B = alpha * A * B;");
Console.WriteLine(" 2: B = alpha * A' * B;");
//
// B = alpha * A * B.
//
char side = 'L';
char uplo = 'U';
char transa = 'N';
char diag = 'N';
int m = 4;
int n = 5;
double alpha = 2.0;
int lda = m;
int ldb = m;
double[] a = new double[lda * m];
for (j = 0; j < m; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < m; i++)
{
a[i + j * lda] = 0.0;
}
}
char transb = 'N';
double[] b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrmm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " B = alpha * A * B:");
//
// B = alpha * A' * B.
//
side = 'L';
uplo = 'U';
transa = 'T';
diag = 'N';
m = 4;
n = 5;
alpha = 2.0;
lda = m;
ldb = m;
a = new double[lda * m];
for (j = 0; j < m; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < m; i++)
{
a[i + j * lda] = 0.0;
}
}
transb = 'N';
b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrmm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " B = alpha * A' * B:");
}
private static void dtrsm_test()
//****************************************************************************80
//
// Purpose:
//
// DTRSM_TEST tests DTRSM.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 07 April 2014
//
// Author:
//
// John Burkardt
//
{
int i;
int j;
Console.WriteLine("");
Console.WriteLine("DTRSM_TEST");
Console.WriteLine(" DTRSM solves a linear system involving a triangular");
Console.WriteLine(" matrix A and a rectangular matrix B.");
Console.WriteLine("");
Console.WriteLine(" 1: Solve A * X = alpha * B;");
Console.WriteLine(" 2: Solve A' * X = alpha * B;");
Console.WriteLine(" 3: Solve X * A = alpha * B;");
Console.WriteLine(" 4: Solve X * A' = alpha * B;");
//
// Solve A * X = alpha * B.
//
char side = 'L';
char uplo = 'U';
char transa = 'N';
char diag = 'N';
int m = 4;
int n = 5;
double alpha = 2.0;
int lda = m;
int ldb = m;
double[] a = new double[lda * m];
for (j = 0; j < m; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < m; i++)
{
a[i + j * lda] = 0.0;
}
}
char transb = 'N';
double[] b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrsm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " X = inv ( A ) * alpha * B:");
//
// Solve A' * X = alpha * B.
//
side = 'L';
uplo = 'U';
transa = 'T';
diag = 'N';
m = 4;
n = 5;
alpha = 2.0;
lda = m;
ldb = m;
a = new double[lda * m];
for (j = 0; j < m; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < m; i++)
{
a[i + j * lda] = 0.0;
}
}
transb = 'N';
b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrsm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " X = inv ( A' ) * alpha * B:");
//
// Solve X * A = alpha * B.
//
side = 'R';
uplo = 'U';
transa = 'N';
diag = 'N';
m = 4;
n = 5;
alpha = 2.0;
lda = n;
ldb = m;
a = new double[lda * n];
for (j = 0; j < n; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < n; i++)
{
a[i + j * lda] = 0.0;
}
}
transb = 'N';
b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrsm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " X = alpha * B * inv ( A ):");
//
// Solve X * A'' = alpha * B.
//
side = 'R';
uplo = 'U';
transa = 'T';
diag = 'N';
m = 4;
n = 5;
alpha = 2.0;
lda = n;
ldb = m;
a = new double[lda * n];
for (j = 0; j < n; j++)
{
for (i = 0; i <= j; i++)
{
a[i + j * lda] = i + j + 2;
}
for (i = j + 1; i < n; i++)
{
a[i + j * lda] = 0.0;
}
}
transb = 'N';
b = BLASData.r8mat_test(transb, ldb, m, n);
BLAS3D.dtrsm(side, uplo, transa, diag, m, n, alpha, a, lda, ref b, ldb);
typeMethods.r8mat_print(m, n, b, " X = alpha * B * inv ( A' ):");
}
public static void padua2(int deg, int degmax, int npd, double[] wpd, double[] fpd,
double[] raux1, double[] raux2, ref double[] c0, ref double esterr)
//****************************************************************************80
//
// Purpose:
//
// PADUA2 computes the Padua interpolation coefficient matrix.
//
// Discussion:
//
// This function computes the coefficient matrix C0, in the
// orthonormal Chebyshev basis T_j(x)T_{k-j}(y), 0 <= j <= k <= DEG,
// T_0(x)=1, T_j(x) = sqrt(2) * cos(j * acos(x)), of the
// interpolation polynomial of degree DEG of the function values FPD
// at the set of NPD Padua points (PD1,PD2) in the square [-1,1]^2.
//
// The interpolant may be evaluated at an arbitrary point by the
// function PD2VAL. PD1, PD2 and WPD are the Padua points and weights
// computed by PDPTS.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 February 2014
//
// Author:
//
// Original FORTRAN77 version by Marco Caliari, Stefano De Marchi,
// Marco Vianello.
// C++ version by John Burkardt.
//
// Reference:
//
// Marco Caliari, Stefano de Marchi, Marco Vianello,
// Algorithm 886:
// Padua2D: Lagrange Interpolation at Padua Points on Bivariate Domains,
// ACM Transactions on Mathematical Software,
// Volume 35, Number 3, October 2008, Article 21, 11 pages.
//
// Parameters:
//
// Input, int DEG, the degree of approximation.
//
// Input, int DEGMAX, the maximum degree allowed.
//
// Input, int NPD, the number of Padua points.
//
// Input, double WPD[NPD], the weights.
//
// Input, double FPD[NPD], the value at the Padua points
// of the function to be interpolated.
//
// Workspace, double RAUX1[(DEGMAX+1)*(DEG+2)].
//
// Workspace, double RAUX2[(DEGMAX+1)*(DEG+2)].
//
// Output, double C0[(DEGMAX+2)*(DEG+1)], the coefficient matrix.
//
// Output, double &ESTERR, the estimated error.
//
{
double angle;
int i;
int j;
double pt;
//
// Build the matrix P_2 and store it in RAUX2.
//
for (i = 0; i <= deg + 1; i++)
{
angle = i * Math.PI / (deg + 1);
pt = -Math.Cos(angle);
PolynomialNS.Chebyshev.cheb(deg, pt, ref raux2, +i * (degmax + 1));
}
//
// Build the matrix G(f) and store it in C0.
//
for (j = 0; j <= deg + 1; j++)
{
for (i = 0; i <= degmax + 1; i++)
{
c0[i + j * (degmax + 2)] = 0.0;
}
}
int k = 0;
for (j = 0; j <= deg + 1; j++)
{
for (i = 0; i <= deg; i++)
{
switch ((i + j) % 2)
{
case 0:
c0[i + j * (degmax + 2)] = fpd[k] * wpd[k];
k += 1;
break;
default:
c0[i + j * (degmax + 2)] = 0.0;
break;
}
}
}
//
// Compute the matrix-matrix product G(f)*P_2' and store it in RAUX1.
//
BLAS3D.dgemm('n', 't', deg + 1, deg + 1, deg + 2, 1.0,
c0, degmax + 2, raux2, degmax + 1, 0.0, ref raux1, degmax + 1);
//
// Build the matrix P_1 and store it in RAUX2.
//
for (i = 0; i <= deg; i++)
{
angle = i * Math.PI / deg;
pt = -Math.Cos(angle);
PolynomialNS.Chebyshev.cheb(deg, pt, ref raux2, +i * (degmax + 1));
}
//
// Compute the matrix-matrix product C(f) = P_1 * ( G(f) * P_2' )
// and store it in C0.
//
BLAS3D.dgemm('n', 'n', deg + 1, deg + 1, deg + 1, 1.0,
raux2, degmax + 1, raux1, degmax + 1, 0.0, ref c0, degmax + 2);
c0[deg] /= 2.0;
//
// Estimate the error.
//
esterr = 0.0;
for (j = 0; j <= 2; j++)
{
for (i = 0; i <= deg - j; i++)
{
esterr += Math.Abs(c0[i + (deg - i - j) * (degmax + 2)]);
}
}
esterr = 2.0 * esterr;
}
