LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ ssptrd()

 subroutine ssptrd ( character uplo, integer n, real, dimension( * ) ap, real, dimension( * ) d, real, dimension( * ) e, real, dimension( * ) tau, integer info )

SSPTRD

Purpose:
``` SSPTRD reduces a real symmetric matrix A stored in packed form to
symmetric tridiagonal form T by an orthogonal similarity
transformation: Q**T * A * Q = T.```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 = 'U': Upper triangle of A is stored; = 'L': Lower triangle of A is stored.``` [in] N ``` N is INTEGER The order of the matrix A. N >= 0.``` [in,out] AP ``` AP is REAL array, dimension (N*(N+1)/2) On entry, the upper or lower triangle of the symmetric matrix A, packed columnwise in a linear array. The j-th column of A is stored in the array AP as follows: if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n. On exit, if UPLO = 'U', the diagonal and first superdiagonal of A are overwritten by the corresponding elements of the tridiagonal matrix T, and the elements above the first superdiagonal, with the array TAU, represent the orthogonal matrix Q as a product of elementary reflectors; if UPLO = 'L', the diagonal and first subdiagonal of A are over- written by the corresponding elements of the tridiagonal matrix T, and the elements below the first subdiagonal, with the array TAU, represent the orthogonal matrix Q as a product of elementary reflectors. See Further Details.``` [out] D ``` D is REAL array, dimension (N) The diagonal elements of the tridiagonal matrix T: D(i) = A(i,i).``` [out] E ``` E is REAL array, dimension (N-1) The off-diagonal elements of the tridiagonal matrix T: E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.``` [out] TAU ``` TAU is REAL array, dimension (N-1) The scalar factors of the elementary reflectors (see Further Details).``` [out] INFO ``` INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value```
Further Details:
```  If UPLO = 'U', the matrix Q is represented as a product of elementary
reflectors

Q = H(n-1) . . . H(2) H(1).

Each H(i) has the form

H(i) = I - tau * v * v**T

where tau is a real scalar, and v is a real vector with
v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
overwriting A(1:i-1,i+1), and tau is stored in TAU(i).

If UPLO = 'L', the matrix Q is represented as a product of elementary
reflectors

Q = H(1) H(2) . . . H(n-1).

Each H(i) has the form

H(i) = I - tau * v * v**T

where tau is a real scalar, and v is a real vector with
v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
overwriting A(i+2:n,i), and tau is stored in TAU(i).```

Definition at line 149 of file ssptrd.f.

150*
151* -- LAPACK computational routine --
152* -- LAPACK is a software package provided by Univ. of Tennessee, --
153* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154*
155* .. Scalar Arguments ..
156 CHARACTER UPLO
157 INTEGER INFO, N
158* ..
159* .. Array Arguments ..
160 REAL AP( * ), D( * ), E( * ), TAU( * )
161* ..
162*
163* =====================================================================
164*
165* .. Parameters ..
166 REAL ONE, ZERO, HALF
167 parameter( one = 1.0, zero = 0.0, half = 1.0 / 2.0 )
168* ..
169* .. Local Scalars ..
170 LOGICAL UPPER
171 INTEGER I, I1, I1I1, II
172 REAL ALPHA, TAUI
173* ..
174* .. External Subroutines ..
175 EXTERNAL saxpy, slarfg, sspmv, sspr2, xerbla
176* ..
177* .. External Functions ..
178 LOGICAL LSAME
179 REAL SDOT
180 EXTERNAL lsame, sdot
181* ..
182* .. Executable Statements ..
183*
184* Test the input parameters
185*
186 info = 0
187 upper = lsame( uplo, 'U' )
188 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
189 info = -1
190 ELSE IF( n.LT.0 ) THEN
191 info = -2
192 END IF
193 IF( info.NE.0 ) THEN
194 CALL xerbla( 'SSPTRD', -info )
195 RETURN
196 END IF
197*
198* Quick return if possible
199*
200 IF( n.LE.0 )
201 \$ RETURN
202*
203 IF( upper ) THEN
204*
205* Reduce the upper triangle of A.
206* I1 is the index in AP of A(1,I+1).
207*
208 i1 = n*( n-1 ) / 2 + 1
209 DO 10 i = n - 1, 1, -1
210*
211* Generate elementary reflector H(i) = I - tau * v * v**T
212* to annihilate A(1:i-1,i+1)
213*
214 CALL slarfg( i, ap( i1+i-1 ), ap( i1 ), 1, taui )
215 e( i ) = ap( i1+i-1 )
216*
217 IF( taui.NE.zero ) THEN
218*
219* Apply H(i) from both sides to A(1:i,1:i)
220*
221 ap( i1+i-1 ) = one
222*
223* Compute y := tau * A * v storing y in TAU(1:i)
224*
225 CALL sspmv( uplo, i, taui, ap, ap( i1 ), 1, zero, tau,
226 \$ 1 )
227*
228* Compute w := y - 1/2 * tau * (y**T *v) * v
229*
230 alpha = -half*taui*sdot( i, tau, 1, ap( i1 ), 1 )
231 CALL saxpy( i, alpha, ap( i1 ), 1, tau, 1 )
232*
233* Apply the transformation as a rank-2 update:
234* A := A - v * w**T - w * v**T
235*
236 CALL sspr2( uplo, i, -one, ap( i1 ), 1, tau, 1, ap )
237*
238 ap( i1+i-1 ) = e( i )
239 END IF
240 d( i+1 ) = ap( i1+i )
241 tau( i ) = taui
242 i1 = i1 - i
243 10 CONTINUE
244 d( 1 ) = ap( 1 )
245 ELSE
246*
247* Reduce the lower triangle of A. II is the index in AP of
248* A(i,i) and I1I1 is the index of A(i+1,i+1).
249*
250 ii = 1
251 DO 20 i = 1, n - 1
252 i1i1 = ii + n - i + 1
253*
254* Generate elementary reflector H(i) = I - tau * v * v**T
255* to annihilate A(i+2:n,i)
256*
257 CALL slarfg( n-i, ap( ii+1 ), ap( ii+2 ), 1, taui )
258 e( i ) = ap( ii+1 )
259*
260 IF( taui.NE.zero ) THEN
261*
262* Apply H(i) from both sides to A(i+1:n,i+1:n)
263*
264 ap( ii+1 ) = one
265*
266* Compute y := tau * A * v storing y in TAU(i:n-1)
267*
268 CALL sspmv( uplo, n-i, taui, ap( i1i1 ), ap( ii+1 ), 1,
269 \$ zero, tau( i ), 1 )
270*
271* Compute w := y - 1/2 * tau * (y**T *v) * v
272*
273 alpha = -half*taui*sdot( n-i, tau( i ), 1, ap( ii+1 ),
274 \$ 1 )
275 CALL saxpy( n-i, alpha, ap( ii+1 ), 1, tau( i ), 1 )
276*
277* Apply the transformation as a rank-2 update:
278* A := A - v * w**T - w * v**T
279*
280 CALL sspr2( uplo, n-i, -one, ap( ii+1 ), 1, tau( i ), 1,
281 \$ ap( i1i1 ) )
282*
283 ap( ii+1 ) = e( i )
284 END IF
285 d( i ) = ap( ii )
286 tau( i ) = taui
287 ii = i1i1
288 20 CONTINUE
289 d( n ) = ap( ii )
290 END IF
291*
292 RETURN
293*
294* End of SSPTRD
295*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine saxpy(n, sa, sx, incx, sy, incy)
SAXPY
Definition saxpy.f:89
real function sdot(n, sx, incx, sy, incy)
SDOT
Definition sdot.f:82
subroutine sspmv(uplo, n, alpha, ap, x, incx, beta, y, incy)
SSPMV
Definition sspmv.f:147
subroutine sspr2(uplo, n, alpha, x, incx, y, incy, ap)
SSPR2
Definition sspr2.f:142
subroutine slarfg(n, alpha, x, incx, tau)
SLARFG generates an elementary reflector (Householder matrix).
Definition slarfg.f:106
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: