LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slarot.f
Go to the documentation of this file.
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