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