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