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;
}
inline static void vecswap(double* x, double* y, const int n) {
/* swap x and y */
dswap(n, x, 1, y, 1);
}
/*
** Uses G-drive non-anti-aliased method to draw triangle. Set only for now.
*/
static void render_triangle_2(WILLUSBITMAP *bmp,TRIANGLE2D *srctri,
RENDER_COLOR *color)
{
double x1,y1,x2,y2,x3,y3,ylast;
int *pattern;
int def[2] = {1,0xffff};
double px1,py1,px2,py2,px3,py3;
double ldy,rdy;
double x1clip,x2clip,y1clip,y2clip;
double ldx,rdx;
int lx,rx,y,yi,yf,yinc;
/*
printf("@rt2 (%6.4f,%6.4f)-(%6.4f,%6.4f)-(%6.4f,%6.4f)\n",
srctri->p[0].x,srctri->p[0].y,
srctri->p[1].x,srctri->p[1].y,
srctri->p[2].x,srctri->p[2].y);
*/
pattern = NULL;
x1 = srctri->p[0].x;
y1 = srctri->p[0].y;
x2 = srctri->p[1].x;
y2 = srctri->p[1].y;
x3 = srctri->p[2].x;
y3 = srctri->p[2].y;
x1clip=0;
x2clip=bmp->width;
y1clip=0;
y2clip=bmp->height;
/*
px1=render_col(bmp,x1);
py1=render_row(bmp,y1);
px2=render_col(bmp,x2);
py2=render_row(bmp,y2);
px3=render_col(bmp,x3);
py3=render_row(bmp,y3);
*/
px1=x1*bmp->width;
py1=y1*bmp->height;
px2=x2*bmp->width;
py2=y2*bmp->height;
px3=x3*bmp->width;
py3=y3*bmp->height;
if (py1>py2)
dswap(px1,py1,px2,py2);
if (py2>py3)
dswap(px2,py2,px3,py3);
if (py1>py2)
dswap(px1,py1,px2,py2);
if (py1>y2clip || py3<y1clip)
return;
if (pattern==NULL)
pattern=def;
if (py1==py2 && py2==py3)
{
lx = min3(px1,px2,px3);
rx = max3(px1,px2,px3);
if (lx>x2clip || rx<x1clip)
return;
if (lx<x1clip)
lx=x1clip;
if (rx>x2clip)
rx=x2clip;
}
if (py1==py3)
x1=(double)(px1+px3)/2.;
else
x1=px1+(double)(px3-px1)*(double)(py2-py1)/(double)(py3-py1);
yinc=1;
// printf("py1=%7.2f, py2=%7.2f\n",py1,py2);
if (py2>=y1clip && py2!=py1)
{
yi = floor((py1>y1clip ? py1 : y1clip)+.5);
yf = floor((py2<y2clip ? py2 : y2clip)-.5);
// printf("yi=%d, yf=%d\n",yi,yf);
if (x1>(double)px2)
{
ldx=px2-px1;
rdx=px3-px1;
ldy=py2-py1;
rdy=py3-py1;
}
else
{
ldx=px3-px1;
rdx=px2-px1;
ldy=py3-py1;
rdy=py2-py1;
}
for (y=yi;y<=yf;y+=yinc)
{
lx=floor((px1+ldx*(y+.5-py1)/ldy)+.5);
rx=floor((px1+rdx*(y+.5-py1)/rdy)-.5);
// printf("lx,rx[%d] = %d, %d\n",y,lx,rx);
if (lx>rx)
continue;
if (lx>x2clip || rx<x1clip)
continue;
if (lx<x1clip)
lx=x1clip;
if (rx>x2clip)
rx=x2clip;
if (lx>rx)
continue;
render_horizontal_line(bmp,lx,y,rx,color);
/*
if ((status=hlinepat(lx,y,rx,pen_color,pattern[y%pattern[0]+1]))!=NO_ERROR)
return(status);
*/
}
}
ylast=py2;
// printf("ylast=%7.2f, py3=%7.2f\n",ylast,py3);
if (ylast<=y2clip && py2!=py3)
{
yi = floor((ylast>y1clip ? ylast : y1clip)+.5);
yf = floor((py3<y2clip ? py3 : y2clip)-.5);
// printf("yi=%d, yf=%d\n",yi,yf);
if (x1>px2)
{
ldx=px2-px3;
rdx=px1-px3;
ldy=py3-py2;
rdy=py3-py1;
}
else
{
ldx=px1-px3;
rdx=px2-px3;
ldy=py3-py1;
rdy=py3-py2;
}
// printf("px3=%g, ldx=%g, rdx=%g, ldy=%g, rdy=%g\n",px3,ldx,rdx,ldy,rdy);
for (y=yi;y<=yf;y+=yinc)
{
lx=floor((px3+ldx*(py3-(y+.5))/ldy)+.5);
rx=floor((px3+rdx*(py3-(y+.5))/rdy)-.5);
// printf("lx,rxdp[%d] = %15.10f, %15.10f\n",y,px3+ldx*(py3-(y+.5))/ldy,px3+rdx*(py3-(y+.5))/rdy);
// printf("lx,rx[%d] = %d, %d\n",y,lx,rx);
if (lx>x2clip || rx<x1clip)
continue;
if (lx<x1clip)
lx=x1clip;
if (rx>x2clip)
rx=x2clip;
if (lx>rx)
continue;
render_horizontal_line(bmp,lx,y,rx,color);
/*
if ((status=hlinepat(lx,y,rx,pen_color,pattern[y%pattern[0]+1]))!=NO_ERROR)
return(status);
*/
}
}
}
void LUdswap( ptrdiff_t n, double *dx, ptrdiff_t incx, double *dy, ptrdiff_t incy )
{
dx++;
dy++;
dswap( &n, dx, &incx, dy, &incy );
}
