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
kusano 7d535a
/* Subroutine */ int zlarot_(logical *lrows, logical *lleft, logical *lright, 
kusano 7d535a
	integer *nl, doublecomplex *c, doublecomplex *s, doublecomplex *a, 
kusano 7d535a
	integer *lda, doublecomplex *xleft, doublecomplex *xright)
kusano 7d535a
{
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer i__1, i__2, i__3, i__4;
kusano 7d535a
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    void d_cnjg(doublecomplex *, doublecomplex *);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static integer iinc, j, inext;
kusano 7d535a
    static doublecomplex tempx;
kusano 7d535a
    static integer ix, iy, nt;
kusano 7d535a
    static doublecomplex 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
       ZLAROT 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 DROT.   
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
       ZLAROT 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 ZLAROT(.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 ZLAROT( .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 ZLAROT( .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 ZLAROT( .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 ZLAROT( .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 ZLAROT 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   - COMPLEX*16   
kusano 7d535a
             Specify the Givens rotation to be applied.  If LROWS is   
kusano 7d535a
             true, then the matrix ( c  s )   
kusano 7d535a
                                   ( _  _ )   
kusano 7d535a
                                   (-s  c )  is applied from the left;   
kusano 7d535a
             if false, then the transpose (not conjugated) thereof is   
kusano 7d535a
             applied from the right.  Note that in contrast to the   
kusano 7d535a
             output of ZROTG or to most versions of ZROT, both C and S   
kusano 7d535a
             are complex.  For a Givens rotation, |C|**2 + |S|**2 should 
kusano 7d535a
  
kusano 7d535a
             be 1, but this is not checked.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    A      - COMPLEX*16 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, HE, 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, HB, or 
kusano 7d535a
  
kusano 7d535a
             SB) format, then this should be *one less* than the leading 
kusano 7d535a
  
kusano 7d535a
             dimension used in the calling routine.  Thus, if A were   
kusano 7d535a
             dimensioned A(LDA,*) in ZLAROT, then A(1,j) would be the   
kusano 7d535a
             j-th element in the first of the two rows to be rotated,   
kusano 7d535a
             and A(2,j) would be the j-th in the second, regardless of   
kusano 7d535a
             how the array may be stored in the calling routine.  [A   
kusano 7d535a
             cannot, however, actually be dimensioned thus, since for   
kusano 7d535a
             band format, the row number may exceed LDA, which is not   
kusano 7d535a
             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  - COMPLEX*16   
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 - COMPLEX*16   
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].r = a[1].r, xt[0].i = a[1].i;
kusano 7d535a
	yt[0].r = xleft->r, yt[0].i = xleft->i;
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
	i__1 = nt - 1;
kusano 7d535a
	xt[i__1].r = xright->r, xt[i__1].i = xright->i;
kusano 7d535a
	i__1 = nt - 1;
kusano 7d535a
	i__2 = iyt;
kusano 7d535a
	yt[i__1].r = a[i__2].r, yt[i__1].i = a[i__2].i;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Check for errors */
kusano 7d535a
kusano 7d535a
    if (*nl < nt) {
kusano 7d535a
	xerbla_("ZLAROT", &c__4);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
    if (*lda <= 0 || ! (*lrows) && *lda < *nl - nt) {
kusano 7d535a
	xerbla_("ZLAROT", &c__8);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Rotate   
kusano 7d535a
kusano 7d535a
       ZROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S */
kusano 7d535a
kusano 7d535a
    i__1 = *nl - nt - 1;
kusano 7d535a
    for (j = 0; j <= i__1; ++j) {
kusano 7d535a
	i__2 = ix + j * iinc;
kusano 7d535a
	z__2.r = c->r * a[i__2].r - c->i * a[i__2].i, z__2.i = c->r * a[i__2]
kusano 7d535a
		.i + c->i * a[i__2].r;
kusano 7d535a
	i__3 = iy + j * iinc;
kusano 7d535a
	z__3.r = s->r * a[i__3].r - s->i * a[i__3].i, z__3.i = s->r * a[i__3]
kusano 7d535a
		.i + s->i * a[i__3].r;
kusano 7d535a
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
kusano 7d535a
	tempx.r = z__1.r, tempx.i = z__1.i;
kusano 7d535a
	i__2 = iy + j * iinc;
kusano 7d535a
	d_cnjg(&z__4, s);
kusano 7d535a
	z__3.r = -z__4.r, z__3.i = -z__4.i;
kusano 7d535a
	i__3 = ix + j * iinc;
kusano 7d535a
	z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i = z__3.r * a[
kusano 7d535a
		i__3].i + z__3.i * a[i__3].r;
kusano 7d535a
	d_cnjg(&z__6, c);
kusano 7d535a
	i__4 = iy + j * iinc;
kusano 7d535a
	z__5.r = z__6.r * a[i__4].r - z__6.i * a[i__4].i, z__5.i = z__6.r * a[
kusano 7d535a
		i__4].i + z__6.i * a[i__4].r;
kusano 7d535a
	z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
kusano 7d535a
	a[i__2].r = z__1.r, a[i__2].i = z__1.i;
kusano 7d535a
	i__2 = ix + j * iinc;
kusano 7d535a
	a[i__2].r = tempx.r, a[i__2].i = tempx.i;
kusano 7d535a
/* L10: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     ZROT( NT, XT,1, YT,1, C, S ) with complex C, S */
kusano 7d535a
kusano 7d535a
    i__1 = nt;
kusano 7d535a
    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
	i__2 = j - 1;
kusano 7d535a
	z__2.r = c->r * xt[i__2].r - c->i * xt[i__2].i, z__2.i = c->r * xt[
kusano 7d535a
		i__2].i + c->i * xt[i__2].r;
kusano 7d535a
	i__3 = j - 1;
kusano 7d535a
	z__3.r = s->r * yt[i__3].r - s->i * yt[i__3].i, z__3.i = s->r * yt[
kusano 7d535a
		i__3].i + s->i * yt[i__3].r;
kusano 7d535a
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
kusano 7d535a
	tempx.r = z__1.r, tempx.i = z__1.i;
kusano 7d535a
	i__2 = j - 1;
kusano 7d535a
	d_cnjg(&z__4, s);
kusano 7d535a
	z__3.r = -z__4.r, z__3.i = -z__4.i;
kusano 7d535a
	i__3 = j - 1;
kusano 7d535a
	z__2.r = z__3.r * xt[i__3].r - z__3.i * xt[i__3].i, z__2.i = z__3.r * 
kusano 7d535a
		xt[i__3].i + z__3.i * xt[i__3].r;
kusano 7d535a
	d_cnjg(&z__6, c);
kusano 7d535a
	i__4 = j - 1;
kusano 7d535a
	z__5.r = z__6.r * yt[i__4].r - z__6.i * yt[i__4].i, z__5.i = z__6.r * 
kusano 7d535a
		yt[i__4].i + z__6.i * yt[i__4].r;
kusano 7d535a
	z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
kusano 7d535a
	yt[i__2].r = z__1.r, yt[i__2].i = z__1.i;
kusano 7d535a
	i__2 = j - 1;
kusano 7d535a
	xt[i__2].r = tempx.r, xt[i__2].i = tempx.i;
kusano 7d535a
/* L20: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Stuff values back into XLEFT, XRIGHT, etc. */
kusano 7d535a
kusano 7d535a
    if (*lleft) {
kusano 7d535a
	a[1].r = xt[0].r, a[1].i = xt[0].i;
kusano 7d535a
	xleft->r = yt[0].r, xleft->i = yt[0].i;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (*lright) {
kusano 7d535a
	i__1 = nt - 1;
kusano 7d535a
	xright->r = xt[i__1].r, xright->i = xt[i__1].i;
kusano 7d535a
	i__1 = iyt;
kusano 7d535a
	i__2 = nt - 1;
kusano 7d535a
	a[i__1].r = yt[i__2].r, a[i__1].i = yt[i__2].i;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of ZLAROT */
kusano 7d535a
kusano 7d535a
} /* zlarot_ */
kusano 7d535a