double *r8mat_solve2 ( int n, double a[], double b[], int *ierror )
/******************************************************************************/
/*
Purpose:
R8MAT_SOLVE2 computes the solution of an N by N linear system.
Discussion:
An R8MAT is a doubly dimensioned array of R8 values, stored as a vector
in column-major order.
The linear system may be represented as
A*X = B
If the linear system is singular, but consistent, then the routine will
still produce a solution.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 August 2010
Author:
John Burkardt
Parameters:
Input, int N, the number of equations.
Input/output, double A[N*N].
On input, A is the coefficient matrix to be inverted.
On output, A has been overwritten.
Input/output, double B[N].
On input, B is the right hand side of the system.
On output, B has been overwritten.
Output, double R8MAT_SOLVE2[N], the solution of the linear system.
Output, int *IERROR.
0, no error detected.
1, consistent singularity.
2, inconsistent singularity.
*/
{
double amax;
int i;
int imax;
int j;
int k;
int *piv;
double *x;
*ierror = 0;
piv = i4vec_zero_new ( n );
x = r8vec_zero_new ( n );
/*
Process the matrix.
*/
for ( k = 1; k <= n; k++ )
{
/*
In column K:
Seek the row IMAX with the properties that:
IMAX has not already been used as a pivot;
A(IMAX,K) is larger in magnitude than any other candidate.
*/
amax = 0.0;
imax = 0;
for ( i = 1; i <= n; i++ )
{
if ( piv[i-1] == 0 )
{
if ( amax < r8_abs ( a[i-1+(k-1)*n] ) )
{
imax = i;
amax = r8_abs ( a[i-1+(k-1)*n] );
}
}
}
/*
If you found a pivot row IMAX, then,
eliminate the K-th entry in all rows that have not been used for pivoting.
*/
if ( imax != 0 )
{
piv[imax-1] = k;
for ( j = k+1; j <= n; j++ )
{
a[imax-1+(j-1)*n] = a[imax-1+(j-1)*n] / a[imax-1+(k-1)*n];
}
b[imax-1] = b[imax-1] / a[imax-1+(k-1)*n];
a[imax-1+(k-1)*n] = 1.0;
for ( i = 1; i <= n; i++ )
{
if ( piv[i-1] == 0 )
{
for ( j = k+1; j <= n; j++ )
{
a[i-1+(j-1)*n] = a[i-1+(j-1)*n] - a[i-1+(k-1)*n] * a[imax-1+(j-1)*n];
}
b[i-1] = b[i-1] - a[i-1+(k-1)*n] * b[imax-1];
a[i-1+(k-1)*n] = 0.0;
}
}
}
}
/*
Now, every row with nonzero PIV begins with a 1, and
all other rows are all zero. Begin solution.
*/
for ( j = n; 1 <= j; j-- )
{
imax = 0;
for ( k = 1; k <= n; k++ )
{
if ( piv[k-1] == j )
{
imax = k;
}
}
if ( imax == 0 )
{
x[j-1] = 0.0;
if ( b[j-1] == 0.0 )
{
*ierror = 1;
printf ( "\n" );
printf ( "R8MAT_SOLVE2 - Warning:\n" );
printf ( " Consistent singularity, equation = %d\n", j );
}
else
{
*ierror = 2;
printf ( "\n" );
printf ( "R8MAT_SOLVE2 - Warning:\n" );
printf ( " Inconsistent singularity, equation = %d\n", j );
}
}
else
{
x[j-1] = b[imax-1];
for ( i = 1; i <= n; i++ )
{
if ( i != imax )
{
b[i-1] = b[i-1] - a[i-1+(j-1)*n] * x[j-1];
}
}
}
}
free ( piv );
return x;
}
double *fem1d_bvp_quadratic ( int n, double a ( double x ),
double c ( double x ), double f ( double x ), double x[] )
/******************************************************************************/
/*
Purpose:
FEM1D_BVP_QUADRATIC solves a two point boundary value problem.
Discussion:
The finite element method is used, with a mesh of piecewise quadratic
elements.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
18 June 2014
Author:
John Burkardt
Parameters:
Input, int N, the number of nodes.
Input, double A ( double X ), evaluates a(x);
Input, double C ( double X ), evaluates c(x);
Input, double F ( double X ), evaluates f(x);
Input, double X[N], the mesh points.
Output, double FEM1D_BVP_QUADRATIC[N], the finite element coefficients,
which are also the value of the computed solution at the mesh points.
*/
{
# define QUAD_NUM 3
double abscissa[QUAD_NUM] = {
-0.774596669241483377035853079956,
0.000000000000000000000000000000,
0.774596669241483377035853079956 };
double al;
double am;
double ar;
double *amat;
double axq;
double *b;
double bm;
double cxq;
int e;
int e_num;
double fxq;
int i;
int ierror;
int j;
int l;
int m;
int q;
int quad_num = QUAD_NUM;
int r;
double *u;
double weight[QUAD_NUM] = {
0.555555555555555555555555555556,
0.888888888888888888888888888889,
0.555555555555555555555555555556 };
double wq;
double vl;
double vlp;
double vm;
double vmp;
double vr;
double vrp;
double xl;
double xm;
double xq;
double xr;
/*
Zero out the matrix and right hand side.
*/
amat = r8mat_zero_new ( n, n );
b = r8vec_zero_new ( n );
/*
Integrate over element E.
*/
e_num = ( n - 1 ) / 2;
for ( e = 0; e < e_num; e++ )
{
/*
Element E uses nodes
L = 2 * E
M = 2 * E + 1
R = 2 * E + 2
*/
l = 2 * e;
m = 2 * e + 1;
r = 2 * e + 2;
xl = x[l];
xm = x[m];
xr = x[r];
for ( q = 0; q < quad_num; q++ )
{
xq = ( ( 1.0 - abscissa[q] ) * xl
+ ( 1.0 + abscissa[q] ) * xr )
/ 2.0;
wq = weight[q] * ( xr - xl ) / 2.0;
axq = a ( xq );
cxq = c ( xq );
fxq = f ( xq );
vl = ( ( xq - xm ) / ( xl - xm ) )
* ( ( xq - xr ) / ( xl - xr ) );
vm = ( ( xq - xl ) / ( xm - xl ) )
* ( ( xq - xr ) / ( xm - xr ) );
vr = ( ( xq - xl ) / ( xr - xl ) )
* ( ( xq - xm ) / ( xr - xm ) );
vlp = ( 1.0 / ( xl - xm ) )
* ( ( xq - xr ) / ( xl - xr ) )
+ ( ( xq - xm ) / ( xl - xm ) )
* ( 1.0 / ( xl - xr ) );
vmp = ( 1.0 / ( xm - xl ) )
* ( ( xq - xr ) / ( xm - xr ) )
+ ( ( xq - xl ) / ( xm - xl ) )
* ( 1.0 / ( xm - xr ) );
vrp = ( 1.0 / ( xr - xl ) )
* ( ( xq - xm ) / ( xr - xm ) )
+ ( ( xq - xl ) / ( xr - xl ) )
* ( 1.0 / ( xr - xm ) );
amat[l+l*n] = amat[l+l*n] + wq * ( vlp * axq * vlp + vl * cxq * vl );
amat[l+m*n] = amat[l+m*n] + wq * ( vlp * axq * vmp + vl * cxq * vm );
amat[l+r*n] = amat[l+r*n] + wq * ( vlp * axq * vrp + vl * cxq * vr );
b[l] = b[l] + wq * ( vl * fxq );
amat[m+l*n] = amat[m+l*n] + wq * ( vmp * axq * vlp + vm * cxq * vl );
amat[m+m*n] = amat[m+m*n] + wq * ( vmp * axq * vmp + vm * cxq * vm );
amat[m+r*n] = amat[m+r*n] + wq * ( vmp * axq * vrp + vm * cxq * vr );
b[m] = b[m] + wq * ( vm * fxq );
amat[r+l*n] = amat[r+l*n] + wq * ( vrp * axq * vlp + vr * cxq * vl );
amat[r+m*n] = amat[r+m*n] + wq * ( vrp * axq * vmp + vr * cxq * vm );
amat[r+r*n] = amat[r+r*n] + wq * ( vrp * axq * vrp + vr * cxq * vr );
b[r] = b[r] + wq * ( vr * fxq );
}
}
/*
Equation 0 is the left boundary condition, U(0.0) = 0.0;
*/
i = 0;
for ( j = 0; j < n; j++ )
{
amat[i+j*n] = 0.0;
}
amat[i+i*n] = 1.0;
b[i] = 0.0;
/*
Equation N-1 is the right boundary condition, U(1.0) = 0.0;
*/
i = n - 1;
for ( j = 0; j < n; j++ )
{
amat[i+j*n] = 0.0;
}
amat[i+i*n] = 1.0;
b[i] = 0.0;
/*
Solve the linear system.
*/
u = r8mat_solve2 ( n, amat, b, &ierror );
free ( amat );
free ( b );
return u;
# undef QUAD_NUM
}
double *fem1d_bvp_linear ( int n, double a ( double x ), double c ( double x ),
double f ( double x ), double x[] )
/******************************************************************************/
/*
Purpose:
FEM1D_BVP_LINEAR solves a two point boundary value problem.
Discussion:
The program uses the finite element method, with piecewise linear basis
functions to solve a boundary value problem in one dimension.
The problem is defined on the region 0 <= x <= 1.
The following differential equation is imposed between 0 and 1:
- d/dx a(x) du/dx + c(x) * u(x) = f(x)
where a(x), c(x), and f(x) are given functions.
At the boundaries, the following conditions are applied:
u(0.0) = 0.0
u(1.0) = 0.0
A set of N equally spaced nodes is defined on this
interval, with 0 = X(1) < X(2) < ... < X(N) = 1.0.
At each node I, we associate a piecewise linear basis function V(I,X),
which is 0 at all nodes except node I. This implies that V(I,X) is
everywhere 0 except that
for X(I-1) <= X <= X(I):
V(I,X) = ( X - X(I-1) ) / ( X(I) - X(I-1) )
for X(I) <= X <= X(I+1):
V(I,X) = ( X(I+1) - X ) / ( X(I+1) - X(I) )
We now assume that the solution U(X) can be written as a linear
sum of these basis functions:
U(X) = sum ( 1 <= J <= N ) U(J) * V(J,X)
where U(X) on the left is the function of X, but on the right,
is meant to indicate the coefficients of the basis functions.
To determine the coefficient U(J), we multiply the original
differential equation by the basis function V(J,X), and use
integration by parts, to arrive at the I-th finite element equation:
Integral A(X) * U'(X) * V'(I,X) + C(X) * U(X) * V(I,X) dx
= Integral F(X) * V(I,X) dx
We note that the functions U(X) and U'(X) can be replaced by
the finite element form involving the linear sum of basis functions,
but we also note that the resulting integrand will only be nonzero
for terms where J = I - 1, I, or I + 1.
By writing this equation for basis functions I = 2 through N - 1,
and using the boundary conditions, we have N linear equations
for the N unknown coefficients U(1) through U(N), which can
be easily solved.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 August 2010
Author:
John Burkardt
Parameters:
Input, int N, the number of nodes.
Input, double A ( double X ), evaluates a(x);
Input, double C ( double X ), evaluates c(x);
Input, double F ( double X ), evaluates f(x);
Input, double X[N], the mesh points.
Output, double FEM1D_BVP_LINEAR[N], the finite element coefficients,
which are also the value of the computed solution at the mesh points.
*/
{
# define QUAD_NUM 2
double abscissa[QUAD_NUM] = {
-0.577350269189625764509148780502,
+0.577350269189625764509148780502 };
double al;
double am;
double ar;
double *amat;
double axq;
double *b;
double bm;
double cxq;
double fxq;
double h;
int i;
int ierror;
int q;
int quad_num = QUAD_NUM;
double *u;
double weight[QUAD_NUM] = { 1.0, 1.0 };
double wq;
double vl;
double vlp;
double vm;
double vmp;
double vr;
double vrp;
double xl;
double xm;
double xq;
double xr;
/*
Zero out the matrix and right hand side.
*/
amat = r8mat_zero_new ( n, n );
b = r8vec_zero_new ( n );
/*
Equation 1 is the left boundary condition, U(0.0) = 0.0;
*/
amat[0+0*n] = 1.0;
b[0] = 0.0;
/*
Equation I involves the basis function at node I.
This basis function is nonzero from X(I-1) to X(I+1).
Equation I looks like this:
Integral A(X) U'(X) V'(I,X)
+ C(X) * U(X) V(I,X) dx
= Integral F(X) V(I,X) dx
Then, we realize that U(X) = sum ( 1 <= J <= N ) U(J) * V(J,X),
(U(X) means the function; U(J) is the coefficient of V(J,X) ).
The only V functions that are nonzero when V(I,X) is nonzero are
V(I-1,X) and V(I+1,X).
Let's use the shorthand
VL(X) = V(I-1,X)
VM(X) = V(I,X)
VR(X) = V(I+1,X)
So our equation becomes
Integral A(X) [ VL'(X) U(I-1) + VM'(X) U(I) + VR'(X) U(I+1) ] * VM'(X)
+ C(X) [ VL(X) U(I-1) + VM(X) U(I) + VR(X) U(I+1) ] * VM(X) dx
= Integral F(X) VM(X) dx.
This is actually a set of N-2 linear equations for the N coefficients U.
Now gather the multipliers of U(I-1) to get the matrix entry A(I,I-1),
and so on.
*/
for ( i = 1; i < n - 1; i++ )
{
/*
Get the left, right and middle coordinates.
*/
xl = x[i-1];
xm = x[i];
xr = x[i+1];
/*
Make temporary variables for A(I,I-1), A(I,I), A(I,I+1) and B(I).
*/
al = 0.0;
am = 0.0;
ar = 0.0;
bm = 0.0;
/*
We approximate the integrals by using a weighted sum of
the integrand values at quadrature points.
*/
for ( q = 0; q < quad_num; q++ )
{
/*
Integrate over the LEFT interval, between XL and XM, where:
VL(X) = ( XM - X ) / ( XM - XL )
VM(X) = ( X - XL ) / ( XM - XL )
VR(X) = 0
VL'(X) = - 1 / ( XM - XL )
VM'(X) = + 1 / ( XM - XL )
VR'(X) = 0
*/
xq = ( ( 1.0 - abscissa[q] ) * xl
+ ( 1.0 + abscissa[q] ) * xm )
/ 2.0;
wq = weight[q] * ( xm - xl ) / 2.0;
vl = ( xm - xq ) / ( xm - xl );
vlp = - 1.0 / ( xm - xl );
vm = ( xq - xl ) / ( xm - xl );
vmp = + 1.0 / ( xm - xl );
vr = 0.0;
vrp = 0.0;
axq = a ( xq );
cxq = c ( xq );
fxq = f ( xq );
al = al + wq * ( axq * vlp * vmp + cxq * vl * vm );
am = am + wq * ( axq * vmp * vmp + cxq * vm * vm );
ar = ar + wq * ( axq * vrp * vmp + cxq * vr * vm );
bm = bm + wq * ( fxq * vm );
/*
Integrate over the RIGHT interval, between XM and XR, where:
VL(X) = 0
VM(X) = ( XR - X ) / ( XR - XM )
VR(X) = ( X - XM ) / ( XR - XM )
VL'(X) = 0
VM'(X) = - 1 / ( XR - XM )
VR'(X) = + 1 / ( XR - XM )
*/
xq = ( ( 1.0 - abscissa[q] ) * xm
+ ( 1.0 + abscissa[q] ) * xr )
/ 2.0;
wq = weight[q] * ( xr - xm ) / 2.0;
vl = 0.0;
vlp = 0.0;
vm = ( xr - xq ) / ( xr - xm );
vmp = - 1.0 / ( xr - xm );
vr = ( xq - xm ) / ( xr - xm );
vrp = 1.0 / ( xr - xm );
axq = a ( xq );
cxq = c ( xq );
fxq = f ( xq );
al = al + wq * ( axq * vlp * vmp + cxq * vl * vm );
am = am + wq * ( axq * vmp * vmp + cxq * vm * vm );
ar = ar + wq * ( axq * vrp * vmp + cxq * vr * vm );
bm = bm + wq * ( fxq * vm );
}
amat[i+(i-1)*n] = al;
amat[i+ i *n] = am;
amat[i+(i+1)*n] = ar;
b[i] = bm;
}
/*
Equation N is the right boundary condition, U(1.0) = 0.0;
*/
amat[n-1+(n-1)*n] = 1.0;
b[n-1] = 0.0;
/*
Solve the linear system.
*/
u = r8mat_solve2 ( n, amat, b, &ierror );
free ( amat );
free ( b );
return u;
# undef QUAD_NUM
}
double *r8vec_house_column ( int n, double a[], int k )
/******************************************************************************/
/*
Purpose:
R8VEC_HOUSE_COLUMN defines a Householder premultiplier that "packs" a column.
Discussion:
An R8VEC is a vector of R8's.
The routine returns a vector V that defines a Householder
premultiplier matrix H(V) that zeros out the subdiagonal entries of
column K of the matrix A.
H(V) = I - 2 * v * v'
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
21 August 2010
Author:
John Burkardt
Parameters:
Input, int N, the order of the matrix A.
Input, double A[N], column K of the matrix A.
Input, int K, the column of the matrix to be modified.
Output, double R8VEC_HOUSE_COLUMN[N], a vector of unit L2 norm which
defines an orthogonal Householder premultiplier matrix H with the property
that the K-th column of H*A is zero below the diagonal.
*/
{
int i;
double s;
double *v;
v = r8vec_zero_new ( n );
if ( k < 1 || n <= k )
{
return v;
}
s = r8vec_norm_l2 ( n+1-k, a+k-1 );
if ( s == 0.0 )
{
return v;
}
v[k-1] = a[k-1] + r8_abs ( s ) * r8_sign ( a[k-1] );
r8vec_copy ( n-k, a+k, v+k );
s = r8vec_norm_l2 ( n-k+1, v+k-1 );
for ( i = k-1; i < n; i++ )
{
v[i] = v[i] / s;
}
return v;
}
