1 SUBROUTINE DLAROT( 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 DOUBLE PRECISION C, S, XLEFT, XRIGHT
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION A( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DLAROT 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 * DLAROT 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 DLAROT(.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 DLAROT( .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 DLAROT( .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 DLAROT( .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 DLAROT( .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 DLAROT 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 - DOUBLE PRECISION
156 * Specify the Givens rotation to be applied. If LROWS is
157 * true, then the matrix ( c s )
158 * (-s c ) is applied from the left;
159 * if false, then the transpose thereof is applied from the
160 * right. For a Givens rotation, C**2 + S**2 should be 1,
161 * but this is not checked.
162 * Not modified.
163 *
164 * A - DOUBLE PRECISION array.
165 * The array containing the rows/columns to be rotated. The
166 * first element of A should be the upper left element to
167 * be rotated.
168 * Read and modified.
169 *
170 * LDA - INTEGER
171 * The "effective" leading dimension of A. If A contains
172 * a matrix stored in GE or SY format, then this is just
173 * the leading dimension of A as dimensioned in the calling
174 * routine. If A contains a matrix stored in band (GB or SB)
175 * format, then this should be *one less* than the leading
176 * dimension used in the calling routine. Thus, if
177 * A were dimensioned A(LDA,*) in DLAROT, then A(1,j) would
178 * be the j-th element in the first of the two rows
179 * to be rotated, and A(2,j) would be the j-th in the second,
180 * regardless of how the array may be stored in the calling
181 * routine. [A cannot, however, actually be dimensioned thus,
182 * since for band format, the row number may exceed LDA, which
183 * is not legal FORTRAN.]
184 * If LROWS=.TRUE., then LDA must be at least 1, otherwise
185 * it must be at least NL minus the number of .TRUE. values
186 * in XLEFT and XRIGHT.
187 * Not modified.
188 *
189 * XLEFT - DOUBLE PRECISION
190 * If LLEFT is .TRUE., then XLEFT will be used and modified
191 * instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
192 * (if LROWS=.FALSE.).
193 * Read and modified.
194 *
195 * XRIGHT - DOUBLE PRECISION
196 * If LRIGHT is .TRUE., then XRIGHT will be used and modified
197 * instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
198 * (if LROWS=.FALSE.).
199 * Read and modified.
200 *
201 * =====================================================================
202 *
203 * .. Local Scalars ..
204 INTEGER IINC, INEXT, IX, IY, IYT, NT
205 * ..
206 * .. Local Arrays ..
207 DOUBLE PRECISION XT( 2 ), YT( 2 )
208 * ..
209 * .. External Subroutines ..
210 EXTERNAL DROT, XERBLA
211 * ..
212 * .. Executable Statements ..
213 *
214 * Set up indices, arrays for ends
215 *
216 IF( LROWS ) THEN
217 IINC = LDA
218 INEXT = 1
219 ELSE
220 IINC = 1
221 INEXT = LDA
222 END IF
223 *
224 IF( LLEFT ) THEN
225 NT = 1
226 IX = 1 + IINC
227 IY = 2 + LDA
228 XT( 1 ) = A( 1 )
229 YT( 1 ) = XLEFT
230 ELSE
231 NT = 0
232 IX = 1
233 IY = 1 + INEXT
234 END IF
235 *
236 IF( LRIGHT ) THEN
237 IYT = 1 + INEXT + ( NL-1 )*IINC
238 NT = NT + 1
239 XT( NT ) = XRIGHT
240 YT( NT ) = A( IYT )
241 END IF
242 *
243 * Check for errors
244 *
245 IF( NL.LT.NT ) THEN
246 CALL XERBLA( 'DLAROT', 4 )
247 RETURN
248 END IF
249 IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
250 CALL XERBLA( 'DLAROT', 8 )
251 RETURN
252 END IF
253 *
254 * Rotate
255 *
256 CALL DROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S )
257 CALL DROT( NT, XT, 1, YT, 1, C, S )
258 *
259 * Stuff values back into XLEFT, XRIGHT, etc.
260 *
261 IF( LLEFT ) THEN
262 A( 1 ) = XT( 1 )
263 XLEFT = YT( 1 )
264 END IF
265 *
266 IF( LRIGHT ) THEN
267 XRIGHT = XT( NT )
268 A( IYT ) = YT( NT )
269 END IF
270 *
271 RETURN
272 *
273 * End of DLAROT
274 *
275 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 DOUBLE PRECISION C, S, XLEFT, XRIGHT
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION A( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DLAROT 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 * DLAROT 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 DLAROT(.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 DLAROT( .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 DLAROT( .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 DLAROT( .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 DLAROT( .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 DLAROT 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 - DOUBLE PRECISION
156 * Specify the Givens rotation to be applied. If LROWS is
157 * true, then the matrix ( c s )
158 * (-s c ) is applied from the left;
159 * if false, then the transpose thereof is applied from the
160 * right. For a Givens rotation, C**2 + S**2 should be 1,
161 * but this is not checked.
162 * Not modified.
163 *
164 * A - DOUBLE PRECISION array.
165 * The array containing the rows/columns to be rotated. The
166 * first element of A should be the upper left element to
167 * be rotated.
168 * Read and modified.
169 *
170 * LDA - INTEGER
171 * The "effective" leading dimension of A. If A contains
172 * a matrix stored in GE or SY format, then this is just
173 * the leading dimension of A as dimensioned in the calling
174 * routine. If A contains a matrix stored in band (GB or SB)
175 * format, then this should be *one less* than the leading
176 * dimension used in the calling routine. Thus, if
177 * A were dimensioned A(LDA,*) in DLAROT, then A(1,j) would
178 * be the j-th element in the first of the two rows
179 * to be rotated, and A(2,j) would be the j-th in the second,
180 * regardless of how the array may be stored in the calling
181 * routine. [A cannot, however, actually be dimensioned thus,
182 * since for band format, the row number may exceed LDA, which
183 * is not legal FORTRAN.]
184 * If LROWS=.TRUE., then LDA must be at least 1, otherwise
185 * it must be at least NL minus the number of .TRUE. values
186 * in XLEFT and XRIGHT.
187 * Not modified.
188 *
189 * XLEFT - DOUBLE PRECISION
190 * If LLEFT is .TRUE., then XLEFT will be used and modified
191 * instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
192 * (if LROWS=.FALSE.).
193 * Read and modified.
194 *
195 * XRIGHT - DOUBLE PRECISION
196 * If LRIGHT is .TRUE., then XRIGHT will be used and modified
197 * instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
198 * (if LROWS=.FALSE.).
199 * Read and modified.
200 *
201 * =====================================================================
202 *
203 * .. Local Scalars ..
204 INTEGER IINC, INEXT, IX, IY, IYT, NT
205 * ..
206 * .. Local Arrays ..
207 DOUBLE PRECISION XT( 2 ), YT( 2 )
208 * ..
209 * .. External Subroutines ..
210 EXTERNAL DROT, XERBLA
211 * ..
212 * .. Executable Statements ..
213 *
214 * Set up indices, arrays for ends
215 *
216 IF( LROWS ) THEN
217 IINC = LDA
218 INEXT = 1
219 ELSE
220 IINC = 1
221 INEXT = LDA
222 END IF
223 *
224 IF( LLEFT ) THEN
225 NT = 1
226 IX = 1 + IINC
227 IY = 2 + LDA
228 XT( 1 ) = A( 1 )
229 YT( 1 ) = XLEFT
230 ELSE
231 NT = 0
232 IX = 1
233 IY = 1 + INEXT
234 END IF
235 *
236 IF( LRIGHT ) THEN
237 IYT = 1 + INEXT + ( NL-1 )*IINC
238 NT = NT + 1
239 XT( NT ) = XRIGHT
240 YT( NT ) = A( IYT )
241 END IF
242 *
243 * Check for errors
244 *
245 IF( NL.LT.NT ) THEN
246 CALL XERBLA( 'DLAROT', 4 )
247 RETURN
248 END IF
249 IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
250 CALL XERBLA( 'DLAROT', 8 )
251 RETURN
252 END IF
253 *
254 * Rotate
255 *
256 CALL DROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S )
257 CALL DROT( NT, XT, 1, YT, 1, C, S )
258 *
259 * Stuff values back into XLEFT, XRIGHT, etc.
260 *
261 IF( LLEFT ) THEN
262 A( 1 ) = XT( 1 )
263 XLEFT = YT( 1 )
264 END IF
265 *
266 IF( LRIGHT ) THEN
267 XRIGHT = XT( NT )
268 A( IYT ) = YT( NT )
269 END IF
270 *
271 RETURN
272 *
273 * End of DLAROT
274 *
275 END