|
kusano |
7d535a |
/* -- translated by f2c (version 19940927).
|
|
kusano |
7d535a |
You must link the resulting object file with the libraries:
|
|
kusano |
7d535a |
-lf2c -lm (in that order)
|
|
kusano |
7d535a |
*/
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
#include "f2c.h"
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Table of constant values */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
static integer c__4 = 4;
|
|
kusano |
7d535a |
static integer c__8 = 8;
|
|
kusano |
7d535a |
static integer c__1 = 1;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Subroutine */ int slarot_(logical *lrows, logical *lleft, logical *lright,
|
|
kusano |
7d535a |
integer *nl, real *c, real *s, real *a, integer *lda, real *xleft,
|
|
kusano |
7d535a |
real *xright)
|
|
kusano |
7d535a |
{
|
|
kusano |
7d535a |
/* System generated locals */
|
|
kusano |
7d535a |
integer i__1;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Local variables */
|
|
kusano |
7d535a |
static integer iinc;
|
|
kusano |
7d535a |
extern /* Subroutine */ int srot_(integer *, real *, integer *, real *,
|
|
kusano |
7d535a |
integer *, real *, real *);
|
|
kusano |
7d535a |
static integer inext, ix, iy, nt;
|
|
kusano |
7d535a |
static real xt[2], yt[2];
|
|
kusano |
7d535a |
extern /* Subroutine */ int xerbla_(char *, integer *);
|
|
kusano |
7d535a |
static integer iyt;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* -- LAPACK auxiliary test routine (version 2.0) --
|
|
kusano |
7d535a |
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
|
|
kusano |
7d535a |
Courant Institute, Argonne National Lab, and Rice University
|
|
kusano |
7d535a |
February 29, 1992
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Purpose
|
|
kusano |
7d535a |
=======
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
SLAROT applies a (Givens) rotation to two adjacent rows or
|
|
kusano |
7d535a |
columns, where one element of the first and/or last column/row
|
|
kusano |
7d535a |
may be a separate variable. This is specifically indended
|
|
kusano |
7d535a |
for use on matrices stored in some format other than GE, so
|
|
kusano |
7d535a |
that elements of the matrix may be used or modified for which
|
|
kusano |
7d535a |
no array element is provided.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
One example is a symmetric matrix in SB format (bandwidth=4), for
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
which UPLO='L': Two adjacent rows will have the format:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
row j: * * * * * . . . .
|
|
kusano |
7d535a |
row j+1: * * * * * . . . .
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
'*' indicates elements for which storage is provided,
|
|
kusano |
7d535a |
'.' indicates elements for which no storage is provided, but
|
|
kusano |
7d535a |
are not necessarily zero; their values are determined by
|
|
kusano |
7d535a |
symmetry. ' ' indicates elements which are necessarily zero,
|
|
kusano |
7d535a |
and have no storage provided.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Those columns which have two '*'s can be handled by SROT.
|
|
kusano |
7d535a |
Those columns which have no '*'s can be ignored, since as long
|
|
kusano |
7d535a |
as the Givens rotations are carefully applied to preserve
|
|
kusano |
7d535a |
symmetry, their values are determined.
|
|
kusano |
7d535a |
Those columns which have one '*' have to be handled separately,
|
|
kusano |
7d535a |
by using separate variables "p" and "q":
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
row j: * * * * * p . . .
|
|
kusano |
7d535a |
row j+1: q * * * * * . . . .
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
The element p would have to be set correctly, then that column
|
|
kusano |
7d535a |
is rotated, setting p to its new value. The next call to
|
|
kusano |
7d535a |
SLAROT would rotate columns j and j+1, using p, and restore
|
|
kusano |
7d535a |
symmetry. The element q would start out being zero, and be
|
|
kusano |
7d535a |
made non-zero by the rotation. Later, rotations would presumably
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
be chosen to zero q out.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
|
|
kusano |
7d535a |
------- ------- ---------
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
General dense matrix:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
|
|
kusano |
7d535a |
A(i,1),LDA, DUMMY, DUMMY)
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
General banded matrix in GB format:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
j = MAX(1, i-KL )
|
|
kusano |
7d535a |
NL = MIN( N, i+KU+1 ) + 1-j
|
|
kusano |
7d535a |
CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
|
|
kusano |
7d535a |
A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
[ note that i+1-j is just MIN(i,KL+1) ]
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Symmetric banded matrix in SY format, bandwidth K,
|
|
kusano |
7d535a |
lower triangle only:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
j = MAX(1, i-K )
|
|
kusano |
7d535a |
NL = MIN( K+1, i ) + 1
|
|
kusano |
7d535a |
CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
|
|
kusano |
7d535a |
A(i,j), LDA, XLEFT, XRIGHT )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Same, but upper triangle only:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
NL = MIN( K+1, N-i ) + 1
|
|
kusano |
7d535a |
CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
|
|
kusano |
7d535a |
A(i,i), LDA, XLEFT, XRIGHT )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Symmetric banded matrix in SB format, bandwidth K,
|
|
kusano |
7d535a |
lower triangle only:
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
[ same as for SY, except:]
|
|
kusano |
7d535a |
. . . .
|
|
kusano |
7d535a |
A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
[ note that i+1-j is just MIN(i,K+1) ]
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Same, but upper triangle only:
|
|
kusano |
7d535a |
. . .
|
|
kusano |
7d535a |
A(K+1,i), LDA-1, XLEFT, XRIGHT )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Rotating columns is just the transpose of rotating rows, except
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
for GB and SB: (rotating columns i and i+1)
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
GB:
|
|
kusano |
7d535a |
j = MAX(1, i-KU )
|
|
kusano |
7d535a |
NL = MIN( N, i+KL+1 ) + 1-j
|
|
kusano |
7d535a |
CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
|
|
kusano |
7d535a |
A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
[note that KU+j+1-i is just MAX(1,KU+2-i)]
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
SB: (upper triangle)
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
. . . . . .
|
|
kusano |
7d535a |
A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
SB: (lower triangle)
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
. . . . . .
|
|
kusano |
7d535a |
A(1,i),LDA-1, XTOP, XBOTTM )
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Arguments
|
|
kusano |
7d535a |
=========
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
LROWS - LOGICAL
|
|
kusano |
7d535a |
If .TRUE., then SLAROT will rotate two rows. If .FALSE.,
|
|
kusano |
7d535a |
then it will rotate two columns.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
LLEFT - LOGICAL
|
|
kusano |
7d535a |
If .TRUE., then XLEFT will be used instead of the
|
|
kusano |
7d535a |
corresponding element of A for the first element in the
|
|
kusano |
7d535a |
second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
|
|
kusano |
7d535a |
If .FALSE., then the corresponding element of A will be
|
|
kusano |
7d535a |
used.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
LRIGHT - LOGICAL
|
|
kusano |
7d535a |
If .TRUE., then XRIGHT will be used instead of the
|
|
kusano |
7d535a |
corresponding element of A for the last element in the
|
|
kusano |
7d535a |
first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
.FALSE., then the corresponding element of A will be used.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
NL - INTEGER
|
|
kusano |
7d535a |
The length of the rows (if LROWS=.TRUE.) or columns (if
|
|
kusano |
7d535a |
LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are
|
|
kusano |
7d535a |
used, the columns/rows they are in should be included in
|
|
kusano |
7d535a |
NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
|
|
kusano |
7d535a |
least 2. The number of rows/columns to be rotated
|
|
kusano |
7d535a |
exclusive of those involving XLEFT and/or XRIGHT may
|
|
kusano |
7d535a |
not be negative, i.e., NL minus how many of LLEFT and
|
|
kusano |
7d535a |
LRIGHT are .TRUE. must be at least zero; if not, XERBLA
|
|
kusano |
7d535a |
will be called.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
C, S - REAL
|
|
kusano |
7d535a |
Specify the Givens rotation to be applied. If LROWS is
|
|
kusano |
7d535a |
true, then the matrix ( c s )
|
|
kusano |
7d535a |
(-s c ) is applied from the left;
|
|
kusano |
7d535a |
if false, then the transpose thereof is applied from the
|
|
kusano |
7d535a |
right. For a Givens rotation, C**2 + S**2 should be 1,
|
|
kusano |
7d535a |
but this is not checked.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
A - REAL array.
|
|
kusano |
7d535a |
The array containing the rows/columns to be rotated. The
|
|
kusano |
7d535a |
first element of A should be the upper left element to
|
|
kusano |
7d535a |
be rotated.
|
|
kusano |
7d535a |
Read and modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
LDA - INTEGER
|
|
kusano |
7d535a |
The "effective" leading dimension of A. If A contains
|
|
kusano |
7d535a |
a matrix stored in GE or SY format, then this is just
|
|
kusano |
7d535a |
the leading dimension of A as dimensioned in the calling
|
|
kusano |
7d535a |
routine. If A contains a matrix stored in band (GB or SB)
|
|
kusano |
7d535a |
format, then this should be *one less* than the leading
|
|
kusano |
7d535a |
dimension used in the calling routine. Thus, if
|
|
kusano |
7d535a |
A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would
|
|
kusano |
7d535a |
be the j-th element in the first of the two rows
|
|
kusano |
7d535a |
to be rotated, and A(2,j) would be the j-th in the second,
|
|
kusano |
7d535a |
regardless of how the array may be stored in the calling
|
|
kusano |
7d535a |
routine. [A cannot, however, actually be dimensioned thus,
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
since for band format, the row number may exceed LDA, which
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
is not legal FORTRAN.]
|
|
kusano |
7d535a |
If LROWS=.TRUE., then LDA must be at least 1, otherwise
|
|
kusano |
7d535a |
it must be at least NL minus the number of .TRUE. values
|
|
kusano |
7d535a |
in XLEFT and XRIGHT.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
XLEFT - REAL
|
|
kusano |
7d535a |
If LLEFT is .TRUE., then XLEFT will be used and modified
|
|
kusano |
7d535a |
instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
|
|
kusano |
7d535a |
(if LROWS=.FALSE.).
|
|
kusano |
7d535a |
Read and modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
XRIGHT - REAL
|
|
kusano |
7d535a |
If LRIGHT is .TRUE., then XRIGHT will be used and modified
|
|
kusano |
7d535a |
instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
|
|
kusano |
7d535a |
(if LROWS=.FALSE.).
|
|
kusano |
7d535a |
Read and modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
=====================================================================
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Set up indices, arrays for ends
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Parameter adjustments */
|
|
kusano |
7d535a |
--a;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Function Body */
|
|
kusano |
7d535a |
if (*lrows) {
|
|
kusano |
7d535a |
iinc = *lda;
|
|
kusano |
7d535a |
inext = 1;
|
|
kusano |
7d535a |
} else {
|
|
kusano |
7d535a |
iinc = 1;
|
|
kusano |
7d535a |
inext = *lda;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*lleft) {
|
|
kusano |
7d535a |
nt = 1;
|
|
kusano |
7d535a |
ix = iinc + 1;
|
|
kusano |
7d535a |
iy = *lda + 2;
|
|
kusano |
7d535a |
xt[0] = a[1];
|
|
kusano |
7d535a |
yt[0] = *xleft;
|
|
kusano |
7d535a |
} else {
|
|
kusano |
7d535a |
nt = 0;
|
|
kusano |
7d535a |
ix = 1;
|
|
kusano |
7d535a |
iy = inext + 1;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*lright) {
|
|
kusano |
7d535a |
iyt = inext + 1 + (*nl - 1) * iinc;
|
|
kusano |
7d535a |
++nt;
|
|
kusano |
7d535a |
xt[nt - 1] = *xright;
|
|
kusano |
7d535a |
yt[nt - 1] = a[iyt];
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Check for errors */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*nl < nt) {
|
|
kusano |
7d535a |
xerbla_("SLAROT", &c__4);
|
|
kusano |
7d535a |
return 0;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
if (*lda <= 0 || ! (*lrows) && *lda < *nl - nt) {
|
|
kusano |
7d535a |
xerbla_("SLAROT", &c__8);
|
|
kusano |
7d535a |
return 0;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Rotate */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
i__1 = *nl - nt;
|
|
kusano |
7d535a |
srot_(&i__1, &a[ix], &iinc, &a[iy], &iinc, c, s);
|
|
kusano |
7d535a |
srot_(&nt, xt, &c__1, yt, &c__1, c, s);
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Stuff values back into XLEFT, XRIGHT, etc. */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*lleft) {
|
|
kusano |
7d535a |
a[1] = xt[0];
|
|
kusano |
7d535a |
*xleft = yt[0];
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*lright) {
|
|
kusano |
7d535a |
*xright = xt[nt - 1];
|
|
kusano |
7d535a |
a[iyt] = yt[nt - 1];
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
return 0;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* End of SLAROT */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
} /* slarot_ */
|
|
kusano |
7d535a |
|