LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
clarot.f
Go to the documentation of this file.
1 *> \brief \b CLAROT
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 CLAROT( 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 * COMPLEX C, S, XLEFT, XRIGHT
18 * ..
19 * .. Array Arguments ..
20 * COMPLEX A( * )
21 * ..
22 *
23 *
24 *> \par Purpose:
25 * =============
26 *>
27 *> \verbatim
28 *>
29 *> CLAROT 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 *> CLAROT 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 CLAROT(.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 CLAROT( .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 CLAROT( .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 CLAROT( .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 CLAROT( .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 CLAROT 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 - COMPLEX
167 *> Specify the Givens rotation to be applied. If LROWS is
168 *> true, then the matrix ( c s )
169 *> ( _ _ )
170 *> (-s c ) is applied from the left;
171 *> if false, then the transpose (not conjugated) thereof is
172 *> applied from the right. Note that in contrast to the
173 *> output of CROTG or to most versions of CROT, both C and S
174 *> are complex. For a Givens rotation, |C|**2 + |S|**2 should
175 *> be 1, but this is not checked.
176 *> Not modified.
177 *>
178 *> A - COMPLEX array.
179 *> The array containing the rows/columns to be rotated. The
180 *> first element of A should be the upper left element to
181 *> be rotated.
182 *> Read and modified.
183 *>
184 *> LDA - INTEGER
185 *> The "effective" leading dimension of A. If A contains
186 *> a matrix stored in GE, HE, or SY format, then this is just
187 *> the leading dimension of A as dimensioned in the calling
188 *> routine. If A contains a matrix stored in band (GB, HB, or
189 *> SB) format, then this should be *one less* than the leading
190 *> dimension used in the calling routine. Thus, if A were
191 *> dimensioned A(LDA,*) in CLAROT, then A(1,j) would be the
192 *> j-th element in the first of the two rows to be rotated,
193 *> and A(2,j) would be the j-th in the second, regardless of
194 *> how the array may be stored in the calling routine. [A
195 *> cannot, however, actually be dimensioned thus, since for
196 *> band format, the row number may exceed LDA, which is not
197 *> legal FORTRAN.]
198 *> If LROWS=.TRUE., then LDA must be at least 1, otherwise
199 *> it must be at least NL minus the number of .TRUE. values
200 *> in XLEFT and XRIGHT.
201 *> Not modified.
202 *>
203 *> XLEFT - COMPLEX
204 *> If LLEFT is .TRUE., then XLEFT will be used and modified
205 *> instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
206 *> (if LROWS=.FALSE.).
207 *> Read and modified.
208 *>
209 *> XRIGHT - COMPLEX
210 *> If LRIGHT is .TRUE., then XRIGHT will be used and modified
211 *> instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
212 *> (if LROWS=.FALSE.).
213 *> Read and modified.
214 *> \endverbatim
215 *
216 * Authors:
217 * ========
218 *
219 *> \author Univ. of Tennessee
220 *> \author Univ. of California Berkeley
221 *> \author Univ. of Colorado Denver
222 *> \author NAG Ltd.
223 *
224 *> \date November 2011
225 *
226 *> \ingroup complex_matgen
227 *
228 * =====================================================================
229  SUBROUTINE clarot( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
230  $ xright )
231 *
232 * -- LAPACK auxiliary routine (version 3.4.0) --
233 * -- LAPACK is a software package provided by Univ. of Tennessee, --
234 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
235 * November 2011
236 *
237 * .. Scalar Arguments ..
238  LOGICAL lleft, lright, lrows
239  INTEGER lda, nl
240  COMPLEX c, s, xleft, xright
241 * ..
242 * .. Array Arguments ..
243  COMPLEX a( * )
244 * ..
245 *
246 * =====================================================================
247 *
248 * .. Local Scalars ..
249  INTEGER iinc, inext, ix, iy, iyt, j, nt
250  COMPLEX tempx
251 * ..
252 * .. Local Arrays ..
253  COMPLEX xt( 2 ), yt( 2 )
254 * ..
255 * .. External Subroutines ..
256  EXTERNAL xerbla
257 * ..
258 * .. Intrinsic Functions ..
259  INTRINSIC conjg
260 * ..
261 * .. Executable Statements ..
262 *
263 * Set up indices, arrays for ends
264 *
265  IF( lrows ) THEN
266  iinc = lda
267  inext = 1
268  ELSE
269  iinc = 1
270  inext = lda
271  END IF
272 *
273  IF( lleft ) THEN
274  nt = 1
275  ix = 1 + iinc
276  iy = 2 + lda
277  xt( 1 ) = a( 1 )
278  yt( 1 ) = xleft
279  ELSE
280  nt = 0
281  ix = 1
282  iy = 1 + inext
283  END IF
284 *
285  IF( lright ) THEN
286  iyt = 1 + inext + ( nl-1 )*iinc
287  nt = nt + 1
288  xt( nt ) = xright
289  yt( nt ) = a( iyt )
290  END IF
291 *
292 * Check for errors
293 *
294  IF( nl.LT.nt ) THEN
295  CALL xerbla( 'CLAROT', 4 )
296  RETURN
297  END IF
298  IF( lda.LE.0 .OR. ( .NOT.lrows .AND. lda.LT.nl-nt ) ) THEN
299  CALL xerbla( 'CLAROT', 8 )
300  RETURN
301  END IF
302 *
303 * Rotate
304 *
305 * CROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S
306 *
307  DO 10 j = 0, nl - nt - 1
308  tempx = c*a( ix+j*iinc ) + s*a( iy+j*iinc )
309  a( iy+j*iinc ) = -conjg( s )*a( ix+j*iinc ) +
310  $ conjg( c )*a( iy+j*iinc )
311  a( ix+j*iinc ) = tempx
312  10 CONTINUE
313 *
314 * CROT( NT, XT,1, YT,1, C, S ) with complex C, S
315 *
316  DO 20 j = 1, nt
317  tempx = c*xt( j ) + s*yt( j )
318  yt( j ) = -conjg( s )*xt( j ) + conjg( c )*yt( j )
319  xt( j ) = tempx
320  20 CONTINUE
321 *
322 * Stuff values back into XLEFT, XRIGHT, etc.
323 *
324  IF( lleft ) THEN
325  a( 1 ) = xt( 1 )
326  xleft = yt( 1 )
327  END IF
328 *
329  IF( lright ) THEN
330  xright = xt( nt )
331  a( iyt ) = yt( nt )
332  END IF
333 *
334  RETURN
335 *
336 * End of CLAROT
337 *
338  END