1*> \brief \b SLAROT
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
12*                          XRIGHT )
13*
14*       .. Scalar Arguments ..
15*       LOGICAL            LLEFT, LRIGHT, LROWS
16*       INTEGER            LDA, NL
17*       REAL               C, S, XLEFT, XRIGHT
18*       ..
19*       .. Array Arguments ..
20*       REAL               A( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*>    SLAROT applies a (Givens) rotation to two adjacent rows or
30*>    columns, where one element of the first and/or last column/row
31*>    for use on matrices stored in some format other than GE, so
32*>    that elements of the matrix may be used or modified for which
33*>    no array element is provided.
34*>
35*>    One example is a symmetric matrix in SB format (bandwidth=4), for
36*>    which UPLO='L':  Two adjacent rows will have the format:
37*>
38*>    row j:     C> C> C> C> C> .  .  .  .
39*>    row j+1:      C> C> C> C> C> .  .  .  .
40*>
41*>    '*' indicates elements for which storage is provided,
42*>    '.' indicates elements for which no storage is provided, but
43*>    are not necessarily zero; their values are determined by
44*>    symmetry.  ' ' indicates elements which are necessarily zero,
45*>     and have no storage provided.
46*>
47*>    Those columns which have two '*'s can be handled by SROT.
48*>    Those columns which have no '*'s can be ignored, since as long
49*>    as the Givens rotations are carefully applied to preserve
50*>    symmetry, their values are determined.
51*>    Those columns which have one '*' have to be handled separately,
52*>    by using separate variables "p" and "q":
53*>
54*>    row j:     C> C> C> C> C> p  .  .  .
55*>    row j+1:   q  C> C> C> C> C> .  .  .  .
56*>
57*>    The element p would have to be set correctly, then that column
58*>    is rotated, setting p to its new value.  The next call to
59*>    SLAROT would rotate columns j and j+1, using p, and restore
60*>    symmetry.  The element q would start out being zero, and be
61*>    made non-zero by the rotation.  Later, rotations would presumably
62*>    be chosen to zero q out.
63*>
64*>    Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
65*>    ------- ------- ---------
66*>
67*>      General dense matrix:
68*>
69*>              CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
70*>                      A(i,1),LDA, DUMMY, DUMMY)
71*>
72*>      General banded matrix in GB format:
73*>
74*>              j = MAX(1, i-KL )
75*>              NL = MIN( N, i+KU+1 ) + 1-j
76*>              CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
77*>                      A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
78*>
79*>              [ note that i+1-j is just MIN(i,KL+1) ]
80*>
81*>      Symmetric banded matrix in SY format, bandwidth K,
82*>      lower triangle only:
83*>
84*>              j = MAX(1, i-K )
85*>              NL = MIN( K+1, i ) + 1
86*>              CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
87*>                      A(i,j), LDA, XLEFT, XRIGHT )
88*>
89*>      Same, but upper triangle only:
90*>
91*>              NL = MIN( K+1, N-i ) + 1
92*>              CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
93*>                      A(i,i), LDA, XLEFT, XRIGHT )
94*>
95*>      Symmetric banded matrix in SB format, bandwidth K,
96*>      lower triangle only:
97*>
98*>              [ same as for SY, except:]
99*>                  . . . .
100*>                      A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
101*>
102*>              [ note that i+1-j is just MIN(i,K+1) ]
103*>
104*>      Same, but upper triangle only:
105*>                   . . .
106*>                      A(K+1,i), LDA-1, XLEFT, XRIGHT )
107*>
108*>      Rotating columns is just the transpose of rotating rows, except
109*>      for GB and SB: (rotating columns i and i+1)
110*>
111*>      GB:
112*>              j = MAX(1, i-KU )
113*>              NL = MIN( N, i+KL+1 ) + 1-j
114*>              CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
115*>                      A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
116*>
117*>              [note that KU+j+1-i is just MAX(1,KU+2-i)]
118*>
119*>      SB: (upper triangle)
120*>
121*>                   . . . . . .
122*>                      A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
123*>
124*>      SB: (lower triangle)
125*>
126*>                   . . . . . .
127*>                      A(1,i),LDA-1, XTOP, XBOTTM )
128*> \endverbatim
129*
130*  Arguments:
131*  ==========
132*
133*> \verbatim
134*>  LROWS  - LOGICAL
135*>           If .TRUE., then SLAROT will rotate two rows.  If .FALSE.,
136*>           then it will rotate two columns.
137*>           Not modified.
138*>
139*>  LLEFT  - LOGICAL
140*>           If .TRUE., then XLEFT will be used instead of the
141*>           corresponding element of A for the first element in the
142*>           second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
143*>           If .FALSE., then the corresponding element of A will be
144*>           used.
145*>           Not modified.
146*>
147*>  LRIGHT - LOGICAL
148*>           If .TRUE., then XRIGHT will be used instead of the
149*>           corresponding element of A for the last element in the
150*>           first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
151*>           .FALSE., then the corresponding element of A will be used.
152*>           Not modified.
153*>
154*>  NL     - INTEGER
155*>           The length of the rows (if LROWS=.TRUE.) or columns (if
156*>           LROWS=.FALSE.) to be rotated.  If XLEFT and/or XRIGHT are
157*>           used, the columns/rows they are in should be included in
158*>           NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
159*>           least 2.  The number of rows/columns to be rotated
160*>           exclusive of those involving XLEFT and/or XRIGHT may
161*>           not be negative, i.e., NL minus how many of LLEFT and
162*>           LRIGHT are .TRUE. must be at least zero; if not, XERBLA
163*>           will be called.
164*>           Not modified.
165*>
166*>  C, S   - REAL
167*>           Specify the Givens rotation to be applied.  If LROWS is
168*>           true, then the matrix ( c  s )
169*>                                 (-s  c )  is applied from the left;
170*>           if false, then the transpose thereof is applied from the
171*>           right.  For a Givens rotation, C**2 + S**2 should be 1,
172*>           but this is not checked.
173*>           Not modified.
174*>
175*>  A      - REAL array.
176*>           The array containing the rows/columns to be rotated.  The
177*>           first element of A should be the upper left element to
178*>           be rotated.
179*>           Read and modified.
180*>
181*>  LDA    - INTEGER
182*>           The "effective" leading dimension of A.  If A contains
183*>           a matrix stored in GE or SY format, then this is just
184*>           the leading dimension of A as dimensioned in the calling
185*>           routine.  If A contains a matrix stored in band (GB or SB)
186*>           format, then this should be *one less* than the leading
187*>           dimension used in the calling routine.  Thus, if
188*>           A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would
189*>           be the j-th element in the first of the two rows
190*>           to be rotated, and A(2,j) would be the j-th in the second,
191*>           regardless of how the array may be stored in the calling
192*>           routine.  [A cannot, however, actually be dimensioned thus,
193*>           since for band format, the row number may exceed LDA, which
194*>           is not legal FORTRAN.]
195*>           If LROWS=.TRUE., then LDA must be at least 1, otherwise
196*>           it must be at least NL minus the number of .TRUE. values
197*>           in XLEFT and XRIGHT.
198*>           Not modified.
199*>
200*>  XLEFT  - REAL
201*>           If LLEFT is .TRUE., then XLEFT will be used and modified
202*>           instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
203*>           (if LROWS=.FALSE.).
204*>           Read and modified.
205*>
206*>  XRIGHT - REAL
207*>           If LRIGHT is .TRUE., then XRIGHT will be used and modified
208*>           instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
209*>           (if LROWS=.FALSE.).
210*>           Read and modified.
211*> \endverbatim
212*
213*  Authors:
214*  ========
215*
216*> \author Univ. of Tennessee
217*> \author Univ. of California Berkeley
218*> \author Univ. of Colorado Denver
219*> \author NAG Ltd.
220*
221*> \date November 2011
222*
223*> \ingroup real_matgen
224*
225*  =====================================================================
226      SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
227     $                   XRIGHT )
228*
229*  -- LAPACK auxiliary routine (version 3.4.0) --
230*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
231*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
232*     November 2011
233*
234*     .. Scalar Arguments ..
235      LOGICAL            LLEFT, LRIGHT, LROWS
236      INTEGER            LDA, NL
237      REAL               C, S, XLEFT, XRIGHT
238*     ..
239*     .. Array Arguments ..
240      REAL               A( * )
241*     ..
242*
243*  =====================================================================
244*
245*     .. Local Scalars ..
246      INTEGER            IINC, INEXT, IX, IY, IYT, NT
247*     ..
248*     .. Local Arrays ..
249      REAL               XT( 2 ), YT( 2 )
250*     ..
251*     .. External Subroutines ..
252      EXTERNAL           SROT, XERBLA
253*     ..
254*     .. Executable Statements ..
255*
256*     Set up indices, arrays for ends
257*
258      IF( LROWS ) THEN
259         IINC = LDA
260         INEXT = 1
261      ELSE
262         IINC = 1
263         INEXT = LDA
264      END IF
265*
266      IF( LLEFT ) THEN
267         NT = 1
268         IX = 1 + IINC
269         IY = 2 + LDA
270         XT( 1 ) = A( 1 )
271         YT( 1 ) = XLEFT
272      ELSE
273         NT = 0
274         IX = 1
275         IY = 1 + INEXT
276      END IF
277*
278      IF( LRIGHT ) THEN
279         IYT = 1 + INEXT + ( NL-1 )*IINC
280         NT = NT + 1
281         XT( NT ) = XRIGHT
282         YT( NT ) = A( IYT )
283      END IF
284*
285*     Check for errors
286*
287      IF( NL.LT.NT ) THEN
288         CALL XERBLA( 'SLAROT', 4 )
289         RETURN
290      END IF
291      IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
292         CALL XERBLA( 'SLAROT', 8 )
293         RETURN
294      END IF
295*
296*     Rotate
297*
298      CALL SROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S )
299      CALL SROT( NT, XT, 1, YT, 1, C, S )
300*
301*     Stuff values back into XLEFT, XRIGHT, etc.
302*
303      IF( LLEFT ) THEN
304         A( 1 ) = XT( 1 )
305         XLEFT = YT( 1 )
306      END IF
307*
308      IF( LRIGHT ) THEN
309         XRIGHT = XT( NT )
310         A( IYT ) = YT( NT )
311      END IF
312*
313      RETURN
314*
315*     End of SLAROT
316*
317      END
318