int dqrsl ( double a[], int lda, int n, int k, double qraux[], double y[],
double qy[], double qty[], double b[], double rsd[], double ab[], int job )
/******************************************************************************/
/*
Purpose:
DQRSL computes transformations, projections, and least squares solutions.
Discussion:
DQRSL requires the output of DQRDC.
For K <= min(N,P), let AK be the matrix
AK = ( A(JPVT[0]), A(JPVT(2)), ..., A(JPVT(K)) )
formed from columns JPVT[0], ..., JPVT(K) of the original
N by P matrix A that was input to DQRDC. If no pivoting was
done, AK consists of the first K columns of A in their
original order. DQRDC produces a factored orthogonal matrix Q
and an upper triangular matrix R such that
AK = Q * (R)
(0)
This information is contained in coded form in the arrays
A and QRAUX.
The parameters QY, QTY, B, RSD, and AB are not referenced
if their computation is not requested and in this case
can be replaced by dummy variables in the calling program.
To save storage, the user may in some cases use the same
array for different parameters in the calling sequence. A
frequently occuring example is when one wishes to compute
any of B, RSD, or AB and does not need Y or QTY. In this
case one may identify Y, QTY, and one of B, RSD, or AB, while
providing separate arrays for anything else that is to be
computed.
Thus the calling sequence
dqrsl ( a, lda, n, k, qraux, y, dum, y, b, y, dum, 110, info )
will result in the computation of B and RSD, with RSD
overwriting Y. More generally, each item in the following
list contains groups of permissible identifications for
a single calling sequence.
1. (Y,QTY,B) (RSD) (AB) (QY)
2. (Y,QTY,RSD) (B) (AB) (QY)
3. (Y,QTY,AB) (B) (RSD) (QY)
4. (Y,QY) (QTY,B) (RSD) (AB)
5. (Y,QY) (QTY,RSD) (B) (AB)
6. (Y,QY) (QTY,AB) (B) (RSD)
In any group the value returned in the array allocated to
the group corresponds to the last member of the group.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 June 2005
Author:
C version by John Burkardt.
Reference:
Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
LINPACK User's Guide,
SIAM, (Society for Industrial and Applied Mathematics),
3600 University City Science Center,
Philadelphia, PA, 19104-2688.
ISBN 0-89871-172-X
Parameters:
Input, double A[LDA*P], contains the output of DQRDC.
Input, int LDA, the leading dimension of the array A.
Input, int N, the number of rows of the matrix AK. It must
have the same value as N in DQRDC.
Input, int K, the number of columns of the matrix AK. K
must not be greater than min(N,P), where P is the same as in the
calling sequence to DQRDC.
Input, double QRAUX[P], the auxiliary output from DQRDC.
Input, double Y[N], a vector to be manipulated by DQRSL.
Output, double QY[N], contains Q * Y, if requested.
Output, double QTY[N], contains Q' * Y, if requested.
Output, double B[K], the solution of the least squares problem
minimize norm2 ( Y - AK * B),
if its computation has been requested. Note that if pivoting was
requested in DQRDC, the J-th component of B will be associated with
column JPVT(J) of the original matrix A that was input into DQRDC.
Output, double RSD[N], the least squares residual Y - AK * B,
if its computation has been requested. RSD is also the orthogonal
projection of Y onto the orthogonal complement of the column space
of AK.
Output, double AB[N], the least squares approximation Ak * B,
if its computation has been requested. AB is also the orthogonal
projection of Y onto the column space of A.
Input, integer JOB, specifies what is to be computed. JOB has
the decimal expansion ABCDE, with the following meaning:
if A != 0, compute QY.
if B != 0, compute QTY.
if C != 0, compute QTY and B.
if D != 0, compute QTY and RSD.
if E != 0, compute QTY and AB.
Note that a request to compute B, RSD, or AB automatically triggers
the computation of QTY, for which an array must be provided in the
calling sequence.
Output, int DQRSL, is zero unless the computation of B has
been requested and R is exactly singular. In this case, INFO is the
index of the first zero diagonal element of R, and B is left unaltered.
*/
{
int cab;
int cb;
int cqty;
int cqy;
int cr;
int i;
int info;
int j;
int jj;
int ju;
double t;
double temp;
/*
Set INFO flag.
*/
info = 0;
/*
Determine what is to be computed.
*/
cqy = ( job / 10000 != 0 );
cqty = ( ( job % 10000 ) != 0 );
cb = ( ( job % 1000 ) / 100 != 0 );
cr = ( ( job % 100 ) / 10 != 0 );
cab = ( ( job % 10 ) != 0 );
ju = i4_min ( k, n-1 );
/*
Special action when N = 1.
*/
if ( ju == 0 )
{
if ( cqy )
{
qy[0] = y[0];
}
if ( cqty )
{
qty[0] = y[0];
}
if ( cab )
{
ab[0] = y[0];
}
if ( cb )
{
if ( a[0+0*lda] == 0.0 )
{
info = 1;
}
else
{
b[0] = y[0] / a[0+0*lda];
}
}
if ( cr )
{
rsd[0] = 0.0;
}
return info;
}
/*
Set up to compute QY or QTY.
*/
if ( cqy )
{
for ( i = 1; i <= n; i++ )
{
qy[i-1] = y[i-1];
}
}
if ( cqty )
{
for ( i = 1; i <= n; i++ )
{
qty[i-1] = y[i-1];
}
}
/*
Compute QY.
*/
if ( cqy )
{
for ( jj = 1; jj <= ju; jj++ )
{
j = ju - jj + 1;
if ( qraux[j-1] != 0.0 )
{
temp = a[j-1+(j-1)*lda];
a[j-1+(j-1)*lda] = qraux[j-1];
t = -ddot ( n-j+1, a+j-1+(j-1)*lda, 1, qy+j-1, 1 ) / a[j-1+(j-1)*lda];
daxpy ( n-j+1, t, a+j-1+(j-1)*lda, 1, qy+j-1, 1 );
a[j-1+(j-1)*lda] = temp;
}
}
}
/*
Compute Q'*Y.
*/
if ( cqty )
{
for ( j = 1; j <= ju; j++ )
{
if ( qraux[j-1] != 0.0 )
{
temp = a[j-1+(j-1)*lda];
a[j-1+(j-1)*lda] = qraux[j-1];
t = -ddot ( n-j+1, a+j-1+(j-1)*lda, 1, qty+j-1, 1 ) / a[j-1+(j-1)*lda];
daxpy ( n-j+1, t, a+j-1+(j-1)*lda, 1, qty+j-1, 1 );
a[j-1+(j-1)*lda] = temp;
}
}
}
/*
Set up to compute B, RSD, or AB.
*/
if ( cb )
{
for ( i = 1; i <= k; i++ )
{
b[i-1] = qty[i-1];
}
}
if ( cab )
{
for ( i = 1; i <= k; i++ )
{
ab[i-1] = qty[i-1];
}
}
if ( cr && k < n )
{
for ( i = k+1; i <= n; i++ )
{
rsd[i-1] = qty[i-1];
}
}
if ( cab && k+1 <= n )
{
for ( i = k+1; i <= n; i++ )
{
ab[i-1] = 0.0;
}
}
if ( cr )
{
for ( i = 1; i <= k; i++ )
{
rsd[i-1] = 0.0;
}
}
/*
Compute B.
*/
if ( cb )
{
for ( jj = 1; jj <= k; jj++ )
{
j = k - jj + 1;
if ( a[j-1+(j-1)*lda] == 0.0 )
{
info = j;
break;
}
b[j-1] = b[j-1] / a[j-1+(j-1)*lda];
if ( j != 1 )
{
t = -b[j-1];
daxpy ( j-1, t, a+0+(j-1)*lda, 1, b, 1 );
}
}
}
/*
Compute RSD or AB as required.
*/
if ( cr || cab )
{
for ( jj = 1; jj <= ju; jj++ )
{
j = ju - jj + 1;
if ( qraux[j-1] != 0.0 )
{
temp = a[j-1+(j-1)*lda];
a[j-1+(j-1)*lda] = qraux[j-1];
if ( cr )
{
t = -ddot ( n-j+1, a+j-1+(j-1)*lda, 1, rsd+j-1, 1 )
/ a[j-1+(j-1)*lda];
daxpy ( n-j+1, t, a+j-1+(j-1)*lda, 1, rsd+j-1, 1 );
}
if ( cab )
{
t = -ddot ( n-j+1, a+j-1+(j-1)*lda, 1, ab+j-1, 1 )
/ a[j-1+(j-1)*lda];
daxpy ( n-j+1, t, a+j-1+(j-1)*lda, 1, ab+j-1, 1 );
}
a[j-1+(j-1)*lda] = temp;
}
}
}
return info;
}
void dqrank ( double a[], int lda, int m, int n, double tol, int *kr,
int jpvt[], double qraux[] )
/******************************************************************************/
/*
Purpose:
DQRANK computes the QR factorization of a rectangular matrix.
Discussion:
This routine is used in conjunction with DQRLSS to solve
overdetermined, underdetermined and singular linear systems
in a least squares sense.
DQRANK uses the LINPACK subroutine DQRDC to compute the QR
factorization, with column pivoting, of an M by N matrix A.
The numerical rank is determined using the tolerance TOL.
Note that on output, ABS ( A(1,1) ) / ABS ( A(KR,KR) ) is an estimate
of the condition number of the matrix of independent columns,
and of R. This estimate will be <= 1/TOL.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
21 April 2012
Author:
C version by John Burkardt.
Reference:
Jack Dongarra, Cleve Moler, Jim Bunch, Pete Stewart,
LINPACK User's Guide,
SIAM, 1979,
ISBN13: 978-0-898711-72-1,
LC: QA214.L56.
Parameters:
Input/output, double A[LDA*N]. On input, the matrix whose
decomposition is to be computed. On output, the information from DQRDC.
The triangular matrix R of the QR factorization is contained in the
upper triangle and information needed to recover the orthogonal
matrix Q is stored below the diagonal in A and in the vector QRAUX.
Input, int LDA, the leading dimension of A, which must
be at least M.
Input, int M, the number of rows of A.
Input, int N, the number of columns of A.
Input, double TOL, a relative tolerance used to determine the
numerical rank. The problem should be scaled so that all the elements
of A have roughly the same absolute accuracy, EPS. Then a reasonable
value for TOL is roughly EPS divided by the magnitude of the largest
element.
Output, int *KR, the numerical rank.
Output, int JPVT[N], the pivot information from DQRDC.
Columns JPVT(1), ..., JPVT(KR) of the original matrix are linearly
independent to within the tolerance TOL and the remaining columns
are linearly dependent.
Output, double QRAUX[N], will contain extra information defining
the QR factorization.
*/
{
int i;
int j;
int job;
int k;
double *work;
for ( i = 0; i < n; i++ )
{
jpvt[i] = 0;
}
work = ( double * ) malloc ( n * sizeof ( double ) );
job = 1;
dqrdc ( a, lda, m, n, qraux, jpvt, work, job );
*kr = 0;
k = i4_min ( m, n );
for ( j = 0; j < k; j++ )
{
if ( r8_abs ( a[j+j*lda] ) <= tol * r8_abs ( a[0+0*lda] ) )
{
return;
}
*kr = j + 1;
}
free ( work );
return;
}
void dqrdc ( double a[], int lda, int n, int p, double qraux[], int jpvt[],
double work[], int job )
/******************************************************************************/
/*
Purpose:
DQRDC computes the QR factorization of a real rectangular matrix.
Discussion:
DQRDC uses Householder transformations.
Column pivoting based on the 2-norms of the reduced columns may be
performed at the user's option.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
07 June 2005
Author:
C version by John Burkardt.
Reference:
Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
LINPACK User's Guide,
SIAM, (Society for Industrial and Applied Mathematics),
3600 University City Science Center,
Philadelphia, PA, 19104-2688.
ISBN 0-89871-172-X
Parameters:
Input/output, double A(LDA,P). On input, the N by P matrix
whose decomposition is to be computed. On output, A contains in
its upper triangle the upper triangular matrix R of the QR
factorization. Below its diagonal A contains information from
which the orthogonal part of the decomposition can be recovered.
Note that if pivoting has been requested, the decomposition is not that
of the original matrix A but that of A with its columns permuted
as described by JPVT.
Input, int LDA, the leading dimension of the array A. LDA must
be at least N.
Input, int N, the number of rows of the matrix A.
Input, int P, the number of columns of the matrix A.
Output, double QRAUX[P], contains further information required
to recover the orthogonal part of the decomposition.
Input/output, integer JPVT[P]. On input, JPVT contains integers that
control the selection of the pivot columns. The K-th column A(*,K) of A
is placed in one of three classes according to the value of JPVT(K).
> 0, then A(K) is an initial column.
= 0, then A(K) is a free column.
< 0, then A(K) is a final column.
Before the decomposition is computed, initial columns are moved to
the beginning of the array A and final columns to the end. Both
initial and final columns are frozen in place during the computation
and only free columns are moved. At the K-th stage of the
reduction, if A(*,K) is occupied by a free column it is interchanged
with the free column of largest reduced norm. JPVT is not referenced
if JOB == 0. On output, JPVT(K) contains the index of the column of the
original matrix that has been interchanged into the K-th column, if
pivoting was requested.
Workspace, double WORK[P]. WORK is not referenced if JOB == 0.
Input, int JOB, initiates column pivoting.
0, no pivoting is done.
nonzero, pivoting is done.
*/
{
int j;
int jp;
int l;
int lup;
int maxj;
double maxnrm;
double nrmxl;
int pl;
int pu;
int swapj;
double t;
double tt;
pl = 1;
pu = 0;
/*
If pivoting is requested, rearrange the columns.
*/
if ( job != 0 )
{
for ( j = 1; j <= p; j++ )
{
swapj = ( 0 < jpvt[j-1] );
if ( jpvt[j-1] < 0 )
{
jpvt[j-1] = -j;
}
else
{
jpvt[j-1] = j;
}
if ( swapj )
{
if ( j != pl )
{
dswap ( n, a+0+(pl-1)*lda, 1, a+0+(j-1), 1 );
}
jpvt[j-1] = jpvt[pl-1];
jpvt[pl-1] = j;
pl = pl + 1;
}
}
pu = p;
for ( j = p; 1 <= j; j-- )
{
if ( jpvt[j-1] < 0 )
{
jpvt[j-1] = -jpvt[j-1];
if ( j != pu )
{
dswap ( n, a+0+(pu-1)*lda, 1, a+0+(j-1)*lda, 1 );
jp = jpvt[pu-1];
jpvt[pu-1] = jpvt[j-1];
jpvt[j-1] = jp;
}
pu = pu - 1;
}
}
}
/*
Compute the norms of the free columns.
*/
for ( j = pl; j <= pu; j++ )
{
qraux[j-1] = dnrm2 ( n, a+0+(j-1)*lda, 1 );
}
for ( j = pl; j <= pu; j++ )
{
work[j-1] = qraux[j-1];
}
/*
Perform the Householder reduction of A.
*/
lup = i4_min ( n, p );
for ( l = 1; l <= lup; l++ )
{
/*
Bring the column of largest norm into the pivot position.
*/
if ( pl <= l && l < pu )
{
maxnrm = 0.0;
maxj = l;
for ( j = l; j <= pu; j++ )
{
if ( maxnrm < qraux[j-1] )
{
maxnrm = qraux[j-1];
maxj = j;
}
}
if ( maxj != l )
{
dswap ( n, a+0+(l-1)*lda, 1, a+0+(maxj-1)*lda, 1 );
qraux[maxj-1] = qraux[l-1];
work[maxj-1] = work[l-1];
jp = jpvt[maxj-1];
jpvt[maxj-1] = jpvt[l-1];
jpvt[l-1] = jp;
}
}
/*
Compute the Householder transformation for column L.
*/
qraux[l-1] = 0.0;
if ( l != n )
{
nrmxl = dnrm2 ( n-l+1, a+l-1+(l-1)*lda, 1 );
if ( nrmxl != 0.0 )
{
if ( a[l-1+(l-1)*lda] != 0.0 )
{
nrmxl = nrmxl * r8_sign ( a[l-1+(l-1)*lda] );
}
dscal ( n-l+1, 1.0 / nrmxl, a+l-1+(l-1)*lda, 1 );
a[l-1+(l-1)*lda] = 1.0 + a[l-1+(l-1)*lda];
/*
Apply the transformation to the remaining columns, updating the norms.
*/
for ( j = l + 1; j <= p; j++ )
{
t = -ddot ( n-l+1, a+l-1+(l-1)*lda, 1, a+l-1+(j-1)*lda, 1 )
/ a[l-1+(l-1)*lda];
daxpy ( n-l+1, t, a+l-1+(l-1)*lda, 1, a+l-1+(j-1)*lda, 1 );
if ( pl <= j && j <= pu )
{
if ( qraux[j-1] != 0.0 )
{
tt = 1.0 - pow ( r8_abs ( a[l-1+(j-1)*lda] ) / qraux[j-1], 2 );
tt = r8_max ( tt, 0.0 );
t = tt;
tt = 1.0 + 0.05 * tt * pow ( qraux[j-1] / work[j-1], 2 );
if ( tt != 1.0 )
{
qraux[j-1] = qraux[j-1] * sqrt ( t );
}
else
{
qraux[j-1] = dnrm2 ( n-l, a+l+(j-1)*lda, 1 );
work[j-1] = qraux[j-1];
}
}
}
}
/*
Save the transformation.
*/
qraux[l-1] = a[l-1+(l-1)*lda];
a[l-1+(l-1)*lda] = -nrmxl;
}
}
}
return;
}
double chyper ( int point, int kk, int ll, int mm, int nn, int *ifault )
/******************************************************************************/
/*
Purpose:
CHYPER computes point or cumulative hypergeometric probabilities.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 November 2010
Author:
Original FORTRAN77 version by Richard Lund.
C version by John Burkardt.
Reference:
PR Freeman,
Algorithm AS 59:
Hypergeometric Probabilities,
Applied Statistics,
Volume 22, Number 1, 1973, pages 130-133.
Richard Lund,
Algorithm AS 152:
Cumulative hypergeometric probabilities,
Applied Statistics,
Volume 29, Number 2, 1980, pages 221-223.
BL Shea,
Remark AS R77:
A Remark on Algorithm AS 152: Cumulative hypergeometric probabilities,
Applied Statistics,
Volume 38, Number 1, 1989, pages 199-204.
Parameters:
Input, int POINT, is TRUE if the point probability is desired,
and FALSE if the cumulative probability is desired.
Input, int KK, the sample size.
0 <= KK <= MM.
Input, int LL, the number of successes in the sample.
0 <= LL <= KK.
Input, int MM, the population size that was sampled.
0 <= MM.
Input, int NN, the number of "successes" in the population.
0 <= NN <= MM.
Output, int *IFAULT, error flag.
0, no error occurred.
nonzero, an error occurred.
Output, double CHYPER, the PDF (point probability) of
exactly LL successes out of KK samples, or the CDF (cumulative
probability) of up to LL successes out of KK samples.
*/
{
double arg;
int dir;
double elimit = - 88.0;
int i;
int j;
int k;
int kl;
int l;
int m;
int mbig = 600;
double mean;
int mnkl;
int mvbig = 1000;
int n;
int nl;
double p;
double pt;
double rootpi = 2.506628274631001;
double scale = 1.0E+35;
double sig;
double value;
*ifault = 0;
k = kk + 1;
l = ll + 1;
m = mm + 1;
n = nn + 1;
dir = 1;
/*
Check arguments are within permitted limits.
*/
value = 0.0;
if ( n < 1 || m < n || k < 1 || m < k )
{
*ifault = 1;
return value;
}
if ( l < 1 || m - n < k - l )
{
*ifault = 2;
return value;
}
if ( !point )
{
value = 1.0;
}
if ( n < l || k < l )
{
*ifault = 2;
return value;
}
*ifault = 0;
value = 1.0;
if ( k == 1 || k == m || n == 1 || n == m )
{
return value;
}
if ( !point && ll == i4_min ( kk, nn ) )
{
return value;
}
p = ( double ) ( nn ) / ( double ) ( mm - nn );
if ( 16.0 * r8_max ( p, 1.0 / p )
< ( double ) ( i4_min ( kk, mm - kk ) ) &&
mvbig < mm && - 100.0 < elimit )
{
/*
Use a normal approximation.
*/
mean = ( double ) ( kk * nn ) / ( double ) ( mm );
sig = sqrt ( mean * ( ( double ) ( mm - nn ) / ( double ) ( mm ) )
* ( ( double ) ( mm - kk ) / ( ( double ) ( mm - 1 ) ) ) );
if ( point )
{
arg = - 0.5 * ( pow ( ( ( double ) ( ll ) - mean ) / sig, 2 ) );
if ( elimit <= arg )
{
value = exp ( arg ) / ( sig * rootpi );
}
else
{
value = 0.0;
}
}
else
{
value = alnorm ( ( ( double ) ( ll ) + 0.5 - mean ) / sig, 0 );
}
}
else
{
/*
Calculate exact hypergeometric probabilities.
Interchange K and N if this saves calculations.
*/
if ( i4_min ( n - 1, m - n ) < i4_min ( k - 1, m - k ) )
{
i = k;
k = n;
n = i;
}
if ( m - k < k - 1 )
{
dir = !dir;
l = n - l + 1;
k = m - k + 1;
}
if ( mbig < mm )
{
/*
Take logarithms of factorials.
*/
p = alnfac ( nn )
- alnfac ( mm )
+ alnfac ( mm - kk )
+ alnfac ( kk )
+ alnfac ( mm - nn )
- alnfac ( ll )
- alnfac ( nn - ll )
- alnfac ( kk - ll )
- alnfac ( mm - nn - kk + ll );
if ( elimit <= p )
{
value = exp ( p );
}
else
{
value = 0.0;
}
}
else
{
/*
Use Freeman/Lund algorithm.
*/
for ( i = 1; i <= l - 1; i++ )
{
value = value * ( double ) ( ( k - i ) * ( n - i ) )
/ ( double ) ( ( l - i ) * ( m - i ) );
}
if ( l != k )
{
j = m - n + l;
for ( i = l; i <= k - 1; i++ )
{
value = value * ( double ) ( j - i ) / ( double ) ( m - i );
}
}
}
if ( point )
{
return value;
}
if ( value == 0.0 )
{
/*
We must recompute the point probability since it has underflowed.
*/
if ( mm <= mbig )
{
p = alnfac ( nn )
- alnfac ( mm )
+ alnfac ( kk )
+ alnfac ( mm - nn )
- alnfac ( ll )
- alnfac ( nn - ll )
- alnfac ( kk - ll )
- alnfac ( mm - nn - kk + ll )
+ alnfac ( mm - kk );
}
p = p + log ( scale );
if ( p < elimit )
{
*ifault = 3;
if ( ( double ) ( nn * kk + nn + kk + 1 )
/ ( double ) ( mm + 2 ) < ( double ) ( ll ) )
{
value = 1.0;
}
return value;
}
else
{
p = exp ( p );
}
}
else
/*
Scale up at this point.
*/
{
p = value * scale;
}
pt = 0.0;
nl = n - l;
kl = k - l;
mnkl = m - n - kl + 1;
if ( l <= kl )
{
for ( i = 1; i <= l - 1; i++ )
{
p = p * ( double ) ( ( l - i ) * ( mnkl - i ) ) /
( double ) ( ( nl + i ) * ( kl + i ) );
pt = pt + p;
}
}
else
{
dir = !dir;
for ( j = 0; j <= kl - 1; j++ )
{
p = p * ( double ) ( ( nl - j ) * ( kl - j ) )
/ ( double ) ( ( l + j ) * ( mnkl + j ) );
pt = pt + p;
}
}
if ( p == 0.0 )
{
*ifault = 3;
}
if ( dir )
{
value = value + ( pt / scale );
}
else
{
value = 1.0 - ( pt / scale );
}
}
return value;
}
int main ( void )
/******************************************************************************/
/*
Purpose:
FD1D_BURGERS_LEAP solves the nonviscous Burgers equation using leapfrogging.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
19 August 2010
Author:
John Burkardt
Parameters:
None
*/
{
double a;
double b;
double dt;
double dx;
int i;
int ihi;
int ilo;
int n;
int step;
int step_num;
double t;
double t_init;
double t_last;
double *uc;
double *un;
double *uo;
double *x;
timestamp ( );
printf ( "\n" );
printf ( "FD1D_BURGERS_LEAP:\n" );
printf ( " C version\n" );
printf ( " Solve the non-viscous time-dependent Burgers equation,\n" );
printf ( " using the leap-frog method.\n" );
printf ( "\n" );
printf ( " Equation to be solved:\n" );
printf ( "\n" );
printf ( " du/dt + u * du/dx = 0\n" );
printf ( "\n" );
printf ( " for x in [ a, b ], for t in [t_init, t_last]\n" );
printf ( "\n" );
printf ( " with initial conditions:\n" );
printf ( "\n" );
printf ( " u(x,o) = u_init\n" );
printf ( "\n" );
printf ( " and boundary conditions:\n" );
printf ( "\n" );
printf ( " u(a,t) = u_a(t), u(b,t) = u_b(t)\n" );
/*
Set and report the problem parameters.
*/
n = 21;
a = -1.0;
b = +1.0;
dx = ( b - a ) / ( double ) ( n - 1 );
step_num = 30;
t_init = 0.0;
t_last = 3.0;
dt = ( t_last - t_init ) / ( double ) ( step_num );
printf ( "\n" );
printf ( " %f <= X <= %f\n", a, b );
printf ( " Number of nodes = %d\n", n );
printf ( " DX = %f\n", dx );
printf ( "\n" );
printf ( " %f <= T <= %f\n", t_init, t_last );
printf ( " Number of time steps = %d\n", step_num );
printf ( " DT = %f\n", dt );
uc = ( double * ) malloc ( n * sizeof ( double ) );
un = ( double * ) malloc ( n * sizeof ( double ) );
uo = ( double * ) malloc ( n * sizeof ( double ) );
x = r8vec_even ( n, a, b );
printf ( "\n" );
printf ( " X:\n" );
printf ( "\n" );
for ( ilo = 0; ilo < n; ilo = ilo + 5 )
{
ihi = i4_min ( ilo + 5, n - 1 );
for ( i = ilo; i <= ihi; i++ )
{
printf ( " %14f", x[i] );
}
printf ( "\n" );
}
/*
Set the initial condition,
and apply boundary conditions to first and last entries.
*/
step = 0;
t = t_init;
u_init ( n, x, t, un );
un[0] = u_a ( x[0], t );
un[n-1] = u_b ( x[n-1], t );
report ( step, step_num, n, x, t, un );
/*
Use Euler's method to get the first step.
*/
step = 1;
t = ( ( double ) ( step_num - step ) * t_init
+ ( double ) ( step ) * t_last )
/ ( double ) ( step_num );
for ( i = 0; i < n; i++ )
{
uc[i] = un[i];
}
for ( i = 1; i < n - 1; i++ )
{
un[i] = uc[i] - dt * uc[i] * ( uc[i+1] - uc[i-1] ) / 2.0 / dx;
}
un[0] = u_a ( x[0], t );
un[n-1] = u_b ( x[n-1], t );
report ( step, step_num, n, x, t, un );
/*
Subsequent steps use the leapfrog method.
*/
for ( step = 2; step <= step_num; step++ )
{
t = ( ( double ) ( step_num - step ) * t_init
+ ( double ) ( step ) * t_last )
/ ( double ) ( step_num );
for ( i = 0; i < n; i++ )
{
uo[i] = uc[i];
uc[i] = un[i];
}
for ( i = 1; i < n - 1; i++ )
{
un[i] = uo[i] - dt * uc[i] * ( uc[i+1] - uc[i-1] ) / dx;
}
un[0] = u_a ( x[0], t );
un[n-1] = u_b ( x[n-1], t );
report ( step, step_num, n, x, t, un );
}
free ( uc );
free ( un );
free ( uo );
free ( x );
/*
Terminate.
*/
printf ( "\n" );
printf ( "FD1D_BURGERS_LEAP:\n" );
printf ( " Normal end of execution.\n" );
printf ( "\n" );
timestamp ( );
return 0;
}
void spy_file ( char *header, char *data_filename )
/******************************************************************************/
/*
Purpose:
SPY_FILE plots a sparsity pattern stored in a file.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
16 September 2014
Author:
John Burkardt
Parameters:
Input, char *HEADER, the name to be used for the
title of the plot, and as part of the names of the command
and plot files.
Input, char *DATA_FILENAME, the name of the file
containing the indices of nonzero matrix entries.
*/
{
char command_filename[255];
FILE *command_unit;
FILE *data_unit;
int i;
const int i4_huge = 2147483647;
int j;
int m0;
int m1;
int n0;
int n1;
int nz_num;
char png_filename[255];
int status;
n0 = + i4_huge;
n1 = - i4_huge;
m0 = + i4_huge;
m1 = - i4_huge;
nz_num = 0;
data_unit = fopen ( data_filename, "rt" );
for ( ; ; )
{
status = fscanf ( data_unit, "%d%d", &i, &j );
if ( status != 2 )
{
break;
}
nz_num = nz_num + 1;
m0 = i4_min ( m0, i );
m1 = i4_max ( m1, i );
n0 = i4_min ( n0, j );
n1 = i4_max ( n1, j );
}
fclose ( data_unit );
/*
Create command file.
*/
strcpy ( command_filename, header );
strcat ( command_filename, "_commands.txt" );
command_unit = fopen ( command_filename, "wt" );
fprintf ( command_unit, "# %s\n", command_filename );
fprintf ( command_unit, "#\n" );
fprintf ( command_unit, "# Usage:\n" );
fprintf ( command_unit, "# gnuplot < %s\n", command_filename );
fprintf ( command_unit, "#\n" );
fprintf ( command_unit, "unset key\n" );
fprintf ( command_unit, "set term png\n" );
strcpy ( png_filename, header );
strcat ( png_filename, ".png" );
fprintf ( command_unit, "set output '%s'\n", png_filename );
fprintf ( command_unit, "set size ratio -1\n" );
fprintf ( command_unit, "set xlabel '<--- J --->'\n" );
fprintf ( command_unit, "set ylabel '<--- I --->'\n" );
fprintf ( command_unit, "set title '%d nonzeros for \"%s\"'\n", nz_num, header );
fprintf ( command_unit, "set timestamp\n" );
fprintf ( command_unit,
"plot [y=%d:%d] [x=%d:%d] '%s' with points pt 5\n",
m0, m1, n0, n1, data_filename );
fclose ( command_unit );
printf ( " Created graphics command file '%s'\n", command_filename );
return;
}
void mesh_base_zero ( int node_num, int element_order, int element_num,
int element_node[] )
/******************************************************************************/
/*
Purpose:
MESH_BASE_ZERO ensures that the element definition is zero-based.
Discussion:
The ELEMENT_NODE array contains nodes indices that form elements.
The convention for node indexing might start at 0 or at 1.
Since a C or C++ program will naturally assume a 0-based indexing, it is
necessary to check a given element definition and, if it is actually
1-based, to convert it.
This function attempts to detect 1-based node indexing and correct it.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
08 October 2010
Author:
John Burkardt
Parameters:
Input, int NODE_NUM, the number of nodes.
Input, int ELEMENT_ORDER, the order of the elements.
Input, int ELEMENT_NUM, the number of elements.
Input/output, int ELEMENT_NODE[ELEMENT_ORDER*ELEMENT_NUM], the element
definitions.
*/
{
int element;
int node;
int node_max;
int node_min;
int order;
node_min = node_num + 1;
node_max = -1;
for ( element = 0; element < element_num; element++ )
{
for ( order = 0; order < element_order; order++ )
{
node = element_node[order+element*element_order];
node_min = i4_min ( node_min, node );
node_max = i4_max ( node_max, node );
}
}
if ( node_min == 1 && node_max == node_num )
{
printf ( "\n" );
printf ( "MESH_BASE_ZERO:\n" );
printf ( " The element indexing appears to be 1-based!\n" );
printf ( " This will be converted to 0-based.\n" );
for ( element = 0; element < element_num; element++ )
{
for ( order = 0; order < element_order; order++ )
{
element_node[order+element*element_order] =
element_node[order+element*element_order] - 1;
}
}
}
else if ( node_min == 0 && node_max == node_num - 1 )
{
printf ( "\n" );
printf ( "MESH_BASE_ZERO:\n" );
printf ( " The element indexing appears to be 0-based!\n" );
printf ( " No conversion is necessary.\n" );
}
else
{
printf ( "\n" );
printf ( "MESH_BASE_ZERO - Warning!\n" );
printf ( " The element indexing is not of a recognized type.\n" );
printf ( " NODE_MIN = %d\n", node_min );
printf ( " NODE_MAX = %d\n", node_max );
printf ( " NODE_NUM = %d\n", node_num );
}
return;
}
void r8mat_transpose_print_some ( int m, int n, double a[], int ilo, int jlo,
int ihi, int jhi, char *title )
/******************************************************************************/
/*
Purpose:
R8MAT_TRANSPOSE_PRINT_SOME prints some of an R8MAT, transposed.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 August 2010
Author:
John Burkardt
Parameters:
Input, int M, N, the number of rows and columns.
Input, double A[M*N], an M by N matrix to be printed.
Input, int ILO, JLO, the first row and column to print.
Input, int IHI, JHI, the last row and column to print.
Input, char *TITLE, a title.
*/
{
# define INCX 5
int i;
int i2;
int i2hi;
int i2lo;
int inc;
int j;
int j2hi;
int j2lo;
fprintf ( stdout, "\n" );
fprintf ( stdout, "%s\n", title );
for ( i2lo = i4_max ( ilo, 1 ); i2lo <= i4_min ( ihi, m ); i2lo = i2lo + INCX )
{
i2hi = i2lo + INCX - 1;
i2hi = i4_min ( i2hi, m );
i2hi = i4_min ( i2hi, ihi );
inc = i2hi + 1 - i2lo;
fprintf ( stdout, "\n" );
fprintf ( stdout, " Row:" );
for ( i = i2lo; i <= i2hi; i++ )
{
fprintf ( stdout, " %7d ", i - 1 );
}
fprintf ( stdout, "\n" );
fprintf ( stdout, " Col\n" );
fprintf ( stdout, "\n" );
j2lo = i4_max ( jlo, 1 );
j2hi = i4_min ( jhi, n );
for ( j = j2lo; j <= j2hi; j++ )
{
fprintf ( stdout, "%5d:", j - 1 );
for ( i2 = 1; i2 <= inc; i2++ )
{
i = i2lo - 1 + i2;
fprintf ( stdout, " %14f", a[(i-1)+(j-1)*m] );
}
fprintf ( stdout, "\n" );
}
}
return;
# undef INCX
}
void r8utp_print_some ( int n, double a[], int ilo, int jlo, int ihi,
int jhi, char *title )
/******************************************************************************/
/*
Purpose:
R8UTP_PRINT_SOME prints some of a R8UTP matrix.
Discussion:
The R8UTP storage format is appropriate for an upper triangular
matrix. Only the upper triangle of the matrix is stored,
by successive partial columns, in an array of length (N*(N+1))/2,
which contains (A11,A12,A22,A13,A23,A33,A14,...,ANN)
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
16 April 2014
Author:
John Burkardt
Parameters:
Input, int N, the order of the matrix.
N must be positive.
Input, double A[(N*(N+1))/2], the matrix.
Input, int ILO, JLO, IHI, JHI, designate the first row and
column, and the last row and column to be printed.
Input, char *TITLE, a title.
*/
{
# define INCX 5
double aij;
int i;
int i2hi;
int i2lo;
int j;
int j2hi;
int j2lo;
printf ( "\n" );
printf ( "%s\n", title );
/*
Print the columns of the matrix, in strips of 5.
*/
for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX )
{
j2hi = j2lo + INCX - 1;
j2hi = i4_min ( j2hi, n );
j2hi = i4_min ( j2hi, jhi );
printf ( "\n" );
printf ( " Col: " );
for ( j = j2lo; j <= j2hi; j++ )
{
printf ( "%7d ", j );
}
printf ( "\n" );
printf ( " Row\n" );
printf ( " ---\n" );
/*
Determine the range of the rows in this strip.
*/
i2lo = i4_max ( ilo, 1 );
i2hi = i4_min ( ihi, n );
for ( i = i2lo; i <= i2hi; i++ )
{
printf ( "%6d ", i );
/*
Print out (up to) 5 entries in row I, that lie in the current strip.
*/
for ( j = j2lo; j <= j2hi; j++ )
{
if ( i <= j )
{
aij = a[i-1+(j*(j-1))/2];
}
else
{
aij = 0.0;
}
printf ( "%12g ", aij );
}
printf ( "\n" );
}
}
return;
# undef INCX
}
void i4mat_transpose_print_some ( int m, int n, int a[], int ilo, int jlo,
int ihi, int jhi, char *title )
/******************************************************************************/
/*
Purpose:
I4MAT_TRANSPOSE_PRINT_SOME prints some of an I4MAT, transposed.
Discussion:
An I4MAT is an MxN array of I4's, stored by (I,J) -> [I+J*M].
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
14 June 2005
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, int 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, char *TITLE, a title.
*/
{
# define INCX 10
int i;
int i2hi;
int i2lo;
int j;
int j2hi;
int j2lo;
fprintf ( stdout, "\n" );
fprintf ( stdout, "%s\n", title );
/*
Print the columns of the matrix, in strips of INCX.
*/
for ( i2lo = ilo; i2lo <= ihi; i2lo = i2lo + INCX )
{
i2hi = i2lo + INCX - 1;
i2hi = i4_min ( i2hi, m );
i2hi = i4_min ( i2hi, ihi );
fprintf ( stdout, "\n" );
/*
For each row I in the current range...
Write the header.
*/
fprintf ( stdout, " Row: " );
for ( i = i2lo; i <= i2hi; i++ )
{
fprintf ( stdout, "%6d ", i );
}
fprintf ( stdout, "\n" );
fprintf ( stdout, " Col\n" );
fprintf ( stdout, "\n" );
/*
Determine the range of the rows in this strip.
*/
j2lo = i4_max ( jlo, 1 );
j2hi = i4_min ( jhi, n );
for ( j = j2lo; j <= j2hi; j++ )
{
/*
Print out (up to INCX) entries in column J, that lie in the current strip.
*/
fprintf ( stdout, "%5d: ", j );
for ( i = i2lo; i <= i2hi; i++ )
{
fprintf ( stdout, "%6d ", a[i-1+(j-1)*m] );
}
fprintf ( stdout, "\n" );
}
}
return;
# undef INCX
}
void test03 ( void )
/******************************************************************************/
/*
Purpose:
TEST03 tests PGMA_WRITE.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
04 June 2010
Author:
John Burkardt
*/
{
# define NGRAY 11
char file_out_name[80] = "pgma_io_prb_03.ascii.pgm";
int *g;
double gray[NGRAY] = {
0.000, 0.291, 0.434, 0.540, 0.629,
0.706, 0.774, 0.837, 0.895, 0.949,
1.000 };
int i;
int j;
int k;
int xsize = 300;
int ysize = 300;
fprintf ( stdout, "\n" );
fprintf ( stdout, "TEST03:\n" );
fprintf ( stdout, " PGMA_WRITE writes an ASCII PGM file.\n" );
fprintf ( stdout, "\n" );
fprintf ( stdout, " In this example, we make a sort of grayscale\n" );
fprintf ( stdout, " checkerboard.\n" );
g = ( int * ) malloc ( xsize * ysize * sizeof ( int ) );
for ( i = 0; i < xsize; i++ )
{
for ( j = 0; j < ysize; j++ )
{
k = ( i + j ) * NGRAY / i4_min ( xsize, ysize );
k = k % NGRAY;
g[i*ysize+j] = ( int ) ( 255.0E+00 * gray[k] );
}
}
fprintf ( stdout, " Writing the file \"%s\".\n", file_out_name );
pgma_write ( file_out_name, xsize, ysize, g );
fprintf ( stdout, "\n" );
fprintf ( stdout, " PGMA_WRITE was successful.\n" );
free ( g );
return;
# undef NGRAY
}
void st_header_read ( char *input_filename, int *i_min, int *i_max, int *j_min,
int *j_max, int *m, int *n, int *nst )
/******************************************************************************/
/*
Purpose:
ST_HEADER_READ reads the header of an ST file.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
25 January 2014
Author:
John Burkardt
Parameters:
Input, char *INPUT_FILENAME, the name of the ST file.
Input, int *I_MIN, *I_MAX, the minimum and maximum rows.
Input, int *J_MIN, *J_MAX, the minimum and maximum columns.
Output, int *M, the number of rows.
Output, int *N, the number of columns.
Output, int *NST, the number of nonzeros.
*/
{
double aij;
int i;
const int i4_huge = 2147483647;
FILE *input;
int j;
int num;
input = fopen ( input_filename, "rt" );
*nst = 0;
*i_min = + i4_huge;
*i_max = - i4_huge;
*j_min = + i4_huge;
*j_max = - i4_huge;
for ( ; ; )
{
num = fscanf ( input, "%i%i%lf", &i, &j, &aij );
if ( num != 3 )
{
break;
}
*nst = *nst + 1;
*i_min = i4_min ( *i_min, i );
*i_max = i4_max ( *i_max, i );
*j_min = i4_min ( *j_min, j );
*j_max = i4_max ( *j_max, j );
}
fclose ( input );
*m = *i_max - *i_min + 1;
*n = *j_max - *j_min + 1;
return;
}
int main ( int argc, char *argv[] )
/******************************************************************************/
/*
Purpose
MAIN is the main program for MANDELBROT_OPENMP.
Discussion:
MANDELBROT_OPENMP computes an image of the Mandelbrot set.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
03 September 2012
Author:
John Burkardt
Local Parameters:
Local, int COUNT_MAX, the maximum number of iterations taken
for a particular pixel.
*/
{
int m = 500;
int n = 500;
m = (int) atoi(argv[1]);
n = (int) atoi(argv[2]);
int q_n;
int c;
int c_max;
// int b[m][n];
// int count[m][n];
// int r[m][n];
// int g[m][n];
// int (*count)[m] = malloc(sizeof(*count)*m );
// int (*g)[m] = malloc(sizeof(*g)*m );
int **count, **g, **r, **b;
//perfect sovle bigarray problem. THis is two dimentional array
count= malloc(sizeof(int*)*m);
g= malloc(sizeof(int*)*m);
r= malloc(sizeof(int*)*m);
b= malloc(sizeof(int*)*m);
for (q_n= 0; q_n < m; q_n++)
{
//allocate an array that can hold 3 arrays of doubles
count[q_n]= malloc(sizeof(int)*m);
g[q_n]= malloc(sizeof(int)*m);
r[q_n]= malloc(sizeof(int)*m);
b[q_n]= malloc(sizeof(int)*m);
}
int count_max = 2000;
int i;
int ierror;
int j;
int jhi;
int jlo;
int k;
char *output_filename = "mandelbrot.ppm";
FILE *output_unit;
double wtime;
double wtime_total;
double x_max = 1.25;
double x_min = - 2.25;
double x;
double x1;
double x2;
double y_max = 1.75;
double y_min = - 1.75;
double y;
double y1;
double y2;
timestamp ( );
printf ( "\n" );
printf ( "MANDELBROT_OPENMP\n" );
printf ( " C/OpenMP version\n" );
printf ( "\n" );
printf ( " Create an ASCII PPM image of the Mandelbrot set.\n" );
printf ( "\n" );
printf ( " For each point C = X + i*Y\n" );
printf ( " with X range [%g,%g]\n", x_min, x_max );
printf ( " and Y range [%g,%g]\n", y_min, y_max );
printf ( " carry out %d iterations of the map\n", count_max );
printf ( " Z(n+1) = Z(n)^2 + C.\n" );
printf ( " If the iterates stay bounded (norm less than 2)\n" );
printf ( " then C is taken to be a member of the set.\n" );
printf ( "\n" );
printf ( " An ASCII PPM image of the set is created using\n" );
printf ( " M = %d pixels in the X direction and\n", m );
printf ( " N = %d pixels in the Y direction.\n", n );
wtime = omp_get_wtime ( );
/*
Carry out the iteration for each pixel, determining COUNT.
*/
# pragma omp parallel \
shared ( b, count, count_max, g, r, x_max, x_min, y_max, y_min ) \
private ( i, j, k, x, x1, x2, y, y1, y2 )
{
# pragma omp for
for ( i = 0; i < m; i++ )
{
for ( j = 0; j < n; j++ )
{
x = ( ( double ) ( j - 1 ) * x_max
+ ( double ) ( m - j ) * x_min )
/ ( double ) ( m - 1 );
y = ( ( double ) ( i - 1 ) * y_max
+ ( double ) ( n - i ) * y_min )
/ ( double ) ( n - 1 );
count[i][j] = 0;
x1 = x;
y1 = y;
for ( k = 1; k <= count_max; k++ )
{
x2 = x1 * x1 - y1 * y1 + x;
y2 = 2 * x1 * y1 + y;
if ( x2 < -2.0 || 2.0 < x2 || y2 < -2.0 || 2.0 < y2 )
{
count[i][j] = k;
break;
}
x1 = x2;
y1 = y2;
}
if ( ( count[i][j] % 2 ) == 1 )
{
r[i][j] = 255;
g[i][j] = 255;
b[i][j] = 255;
}
else
{
c = ( int ) ( 255.0 * sqrt ( sqrt ( sqrt (
( ( double ) ( count[i][j] ) / ( double ) ( count_max ) ) ) ) ) );
r[i][j] = 3 * c / 5;
g[i][j] = 3 * c / 5;
b[i][j] = c;
}
}
}
}
wtime = omp_get_wtime ( ) - wtime;
printf ( "\n" );
printf ( " Time = %g seconds.\n", wtime );
/*
Write data to an ASCII PPM file.
*/
output_unit = fopen ( output_filename, "wt" );
fprintf ( output_unit, "P3\n" );
fprintf ( output_unit, "%d %d\n", n, m );
fprintf ( output_unit, "%d\n", 255 );
for ( i = 0; i < m; i++ )
{
for ( jlo = 0; jlo < n; jlo = jlo + 4 )
{
jhi = i4_min ( jlo + 4, n );
for ( j = jlo; j < jhi; j++ )
{
fprintf ( output_unit, " %d %d %d", r[i][j], g[i][j], b[i][j] );
}
fprintf ( output_unit, "\n" );
}
}
fclose ( output_unit );
printf ( "\n" );
printf ( " Graphics data written to \"%s\".\n", output_filename );
/*
Terminate.
*/
printf ( "\n" );
printf ( "MANDELBROT_OPENMP\n" );
printf ( " Normal end of execution.\n" );
printf ( "\n" );
timestamp ( );
for (i= 0; i < m; i++)
{
free(count[i]);
free(g[i]);
free(r[i]);
free(b[i]);
}
free(count);
free(g);
free(r);
free(b);
return 0;
}
void r8mat_print_some ( int m, int n, double a[], int ilo, int jlo, int ihi,
int jhi, char *title )
/******************************************************************************/
/*
Purpose:
R8MAT_PRINT_SOME prints some of an R8MAT.
Discussion:
An R8MAT is a doubly dimensioned array of R8's, which
may be stored as a vector in column-major order.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
20 August 2010
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, char *TITLE, a title.
*/
{
# define INCX 5
int i;
int i2hi;
int i2lo;
int j;
int j2hi;
int j2lo;
fprintf ( stdout, "\n" );
fprintf ( stdout, "%s\n", title );
if ( m <= 0 || n <= 0 )
{
fprintf ( stdout, "\n" );
fprintf ( stdout, " (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;
j2hi = i4_min ( j2hi, n );
j2hi = i4_min ( j2hi, jhi );
fprintf ( stdout, "\n" );
/*
For each column J in the current range...
Write the header.
*/
fprintf ( stdout, " Col: ");
for ( j = j2lo; j <= j2hi; j++ )
{
fprintf ( stdout, " %7d ", j - 1 );
}
fprintf ( stdout, "\n" );
fprintf ( stdout, " Row\n" );
fprintf ( stdout, "\n" );
/*
Determine the range of the rows in this strip.
*/
i2lo = i4_max ( ilo, 1 );
i2hi = i4_min ( ihi, m );
for ( i = i2lo; i <= i2hi; i++ )
{
/*
Print out (up to) 5 entries in row I, that lie in the current strip.
*/
fprintf ( stdout, "%5d:", i - 1 );
for ( j = j2lo; j <= j2hi; j++ )
{
fprintf ( stdout, " %14f", a[i-1+(j-1)*m] );
}
fprintf ( stdout, "\n" );
}
}
return;
# undef INCX
}
int i4_uniform ( int a, int b, int *seed )
/******************************************************************************/
/*
Purpose:
I4_UNIFORM returns a scaled pseudorandom I4.
Discussion:
The pseudorandom number should be uniformly distributed
between A and B.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
12 November 2006
Author:
John Burkardt
Reference:
Paul Bratley, Bennett Fox, Linus Schrage,
A Guide to Simulation,
Springer Verlag, pages 201-202, 1983.
Pierre L'Ecuyer,
Random Number Generation,
in Handbook of Simulation,
edited by Jerry Banks,
Wiley Interscience, page 95, 1998.
Bennett Fox,
Algorithm 647:
Implementation and Relative Efficiency of Quasirandom
Sequence Generators,
ACM Transactions on Mathematical Software,
Volume 12, Number 4, pages 362-376, 1986.
Peter Lewis, Allen Goodman, James Miller
A Pseudo-Random Number Generator for the System/360,
IBM Systems Journal,
Volume 8, pages 136-143, 1969.
Parameters:
Input, int A, B, the limits of the interval.
Input/output, int *SEED, the "seed" value, which should NOT be 0.
On output, SEED has been updated.
Output, int I4_UNIFORM, a number between A and B.
*/
{
int k;
float r;
int value;
if ( *seed == 0 )
{
fprintf ( stderr, "\n" );
fprintf ( stderr, "I4_UNIFORM - Fatal error!\n" );
fprintf ( stderr, " Input value of SEED = 0.\n" );
exit ( 1 );
}
k = *seed / 127773;
*seed = 16807 * ( *seed - k * 127773 ) - k * 2836;
if ( *seed < 0 )
{
*seed = *seed + 2147483647;
}
r = ( float ) ( *seed ) * 4.656612875E-10;
/*
Scale R to lie between A-0.5 and B+0.5.
*/
r = ( 1.0 - r ) * ( ( float ) ( i4_min ( a, b ) ) - 0.5 )
+ r * ( ( float ) ( i4_max ( a, b ) ) + 0.5 );
/*
Use rounding to convert R to an integer between A and B.
*/
value = r4_nint ( r );
value = i4_max ( value, i4_min ( a, b ) );
value = i4_min ( value, i4_max ( a, b ) );
return value;
}
