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