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