LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ssytrd_2stage.f
Go to the documentation of this file.
1*> \brief \b SSYTRD_2STAGE
2*
3* @generated from zhetrd_2stage.f, fortran z -> s, Sun Nov 6 19:34:06 2016
4*
5* =========== DOCUMENTATION ===========
6*
7* Online html documentation available at
8* http://www.netlib.org/lapack/explore-html/
9*
10*> Download SSYTRD_2STAGE + dependencies
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd_2stage.f">
12*> [TGZ]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd_2stage.f">
14*> [ZIP]</a>
15*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd_2stage.f">
16*> [TXT]</a>
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU,
22* HOUS2, LHOUS2, WORK, LWORK, INFO )
23*
24* IMPLICIT NONE
25*
26* .. Scalar Arguments ..
27* CHARACTER VECT, UPLO
28* INTEGER N, LDA, LWORK, LHOUS2, INFO
29* ..
30* .. Array Arguments ..
31* REAL D( * ), E( * )
32* REAL A( LDA, * ), TAU( * ),
33* HOUS2( * ), WORK( * )
34* ..
35*
36*
37*> \par Purpose:
38* =============
39*>
40*> \verbatim
41*>
42*> SSYTRD_2STAGE reduces a real symmetric matrix A to real symmetric
43*> tridiagonal form T by a orthogonal similarity transformation:
44*> Q1**T Q2**T* A * Q2 * Q1 = T.
45*> \endverbatim
46*
47* Arguments:
48* ==========
49*
50*> \param[in] VECT
51*> \verbatim
52*> VECT is CHARACTER*1
53*> = 'N': No need for the Housholder representation,
54*> in particular for the second stage (Band to
55*> tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
56*> = 'V': the Householder representation is needed to
57*> either generate Q1 Q2 or to apply Q1 Q2,
58*> then LHOUS2 is to be queried and computed.
59*> (NOT AVAILABLE IN THIS RELEASE).
60*> \endverbatim
61*>
62*> \param[in] UPLO
63*> \verbatim
64*> UPLO is CHARACTER*1
65*> = 'U': Upper triangle of A is stored;
66*> = 'L': Lower triangle of A is stored.
67*> \endverbatim
68*>
69*> \param[in] N
70*> \verbatim
71*> N is INTEGER
72*> The order of the matrix A. N >= 0.
73*> \endverbatim
74*>
75*> \param[in,out] A
76*> \verbatim
77*> A is REAL array, dimension (LDA,N)
78*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
79*> N-by-N upper triangular part of A contains the upper
80*> triangular part of the matrix A, and the strictly lower
81*> triangular part of A is not referenced. If UPLO = 'L', the
82*> leading N-by-N lower triangular part of A contains the lower
83*> triangular part of the matrix A, and the strictly upper
84*> triangular part of A is not referenced.
85*> On exit, if UPLO = 'U', the band superdiagonal
86*> of A are overwritten by the corresponding elements of the
87*> internal band-diagonal matrix AB, and the elements above
88*> the KD superdiagonal, with the array TAU, represent the orthogonal
89*> matrix Q1 as a product of elementary reflectors; if UPLO
90*> = 'L', the diagonal and band subdiagonal of A are over-
91*> written by the corresponding elements of the internal band-diagonal
92*> matrix AB, and the elements below the KD subdiagonal, with
93*> the array TAU, represent the orthogonal matrix Q1 as a product
94*> of elementary reflectors. See Further Details.
95*> \endverbatim
96*>
97*> \param[in] LDA
98*> \verbatim
99*> LDA is INTEGER
100*> The leading dimension of the array A. LDA >= max(1,N).
101*> \endverbatim
102*>
103*> \param[out] D
104*> \verbatim
105*> D is REAL array, dimension (N)
106*> The diagonal elements of the tridiagonal matrix T.
107*> \endverbatim
108*>
109*> \param[out] E
110*> \verbatim
111*> E is REAL array, dimension (N-1)
112*> The off-diagonal elements of the tridiagonal matrix T.
113*> \endverbatim
114*>
115*> \param[out] TAU
116*> \verbatim
117*> TAU is REAL array, dimension (N-KD)
118*> The scalar factors of the elementary reflectors of
119*> the first stage (see Further Details).
120*> \endverbatim
121*>
122*> \param[out] HOUS2
123*> \verbatim
124*> HOUS2 is REAL array, dimension (MAX(1,LHOUS2))
125*> Stores the Householder representation of the stage2
126*> band to tridiagonal.
127*> \endverbatim
128*>
129*> \param[in] LHOUS2
130*> \verbatim
131*> LHOUS2 is INTEGER
132*> The dimension of the array HOUS2.
133*> LHOUS2 >= 1.
134*>
135*> If LWORK = -1, or LHOUS2 = -1,
136*> then a query is assumed; the routine
137*> only calculates the optimal size of the HOUS2 array, returns
138*> this value as the first entry of the HOUS2 array, and no error
139*> message related to LHOUS2 is issued by XERBLA.
140*> If VECT='N', LHOUS2 = max(1, 4*n);
141*> if VECT='V', option not yet available.
142*> \endverbatim
143*>
144*> \param[out] WORK
145*> \verbatim
146*> WORK is REAL array, dimension (LWORK)
147*> \endverbatim
148*>
149*> \param[in] LWORK
150*> \verbatim
151*> LWORK is INTEGER
152*> The dimension of the array WORK.
153*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
154*>
155*> If LWORK = -1, or LHOUS2 = -1,
156*> then a workspace query is assumed; the routine
157*> only calculates the optimal size of the WORK array, returns
158*> this value as the first entry of the WORK array, and no error
159*> message related to LWORK is issued by XERBLA.
160*> LWORK = MAX(1, dimension) where
161*> dimension = max(stage1,stage2) + (KD+1)*N
162*> = N*KD + N*max(KD+1,FACTOPTNB)
163*> + max(2*KD*KD, KD*NTHREADS)
164*> + (KD+1)*N
165*> where KD is the blocking size of the reduction,
166*> FACTOPTNB is the blocking used by the QR or LQ
167*> algorithm, usually FACTOPTNB=128 is a good choice
168*> NTHREADS is the number of threads used when
169*> openMP compilation is enabled, otherwise =1.
170*> \endverbatim
171*>
172*> \param[out] INFO
173*> \verbatim
174*> INFO is INTEGER
175*> = 0: successful exit
176*> < 0: if INFO = -i, the i-th argument had an illegal value
177*> \endverbatim
178*
179* Authors:
180* ========
181*
182*> \author Univ. of Tennessee
183*> \author Univ. of California Berkeley
184*> \author Univ. of Colorado Denver
185*> \author NAG Ltd.
186*
187*> \ingroup hetrd_2stage
188*
189*> \par Further Details:
190* =====================
191*>
192*> \verbatim
193*>
194*> Implemented by Azzam Haidar.
195*>
196*> All details are available on technical report, SC11, SC13 papers.
197*>
198*> Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
199*> Parallel reduction to condensed forms for symmetric eigenvalue problems
200*> using aggregated fine-grained and memory-aware kernels. In Proceedings
201*> of 2011 International Conference for High Performance Computing,
202*> Networking, Storage and Analysis (SC '11), New York, NY, USA,
203*> Article 8 , 11 pages.
204*> http://doi.acm.org/10.1145/2063384.2063394
205*>
206*> A. Haidar, J. Kurzak, P. Luszczek, 2013.
207*> An improved parallel singular value algorithm and its implementation
208*> for multicore hardware, In Proceedings of 2013 International Conference
209*> for High Performance Computing, Networking, Storage and Analysis (SC '13).
210*> Denver, Colorado, USA, 2013.
211*> Article 90, 12 pages.
212*> http://doi.acm.org/10.1145/2503210.2503292
213*>
214*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
215*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
216*> calculations based on fine-grained memory aware tasks.
217*> International Journal of High Performance Computing Applications.
218*> Volume 28 Issue 2, Pages 196-209, May 2014.
219*> http://hpc.sagepub.com/content/28/2/196
220*>
221*> \endverbatim
222*>
223* =====================================================================
224 SUBROUTINE ssytrd_2stage( VECT, UPLO, N, A, LDA, D, E, TAU,
225 $ HOUS2, LHOUS2, WORK, LWORK, INFO )
226*
227 IMPLICIT NONE
228*
229* -- LAPACK computational routine --
230* -- LAPACK is a software package provided by Univ. of Tennessee, --
231* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
232*
233* .. Scalar Arguments ..
234 CHARACTER VECT, UPLO
235 INTEGER N, LDA, LWORK, LHOUS2, INFO
236* ..
237* .. Array Arguments ..
238 REAL D( * ), E( * )
239 REAL A( LDA, * ), TAU( * ),
240 $ hous2( * ), work( * )
241* ..
242*
243* =====================================================================
244* ..
245* .. Local Scalars ..
246 LOGICAL LQUERY, UPPER, WANTQ
247 INTEGER KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
248* ..
249* .. External Subroutines ..
251* ..
252* .. External Functions ..
253 LOGICAL LSAME
254 INTEGER ILAENV2STAGE
255 EXTERNAL lsame, ilaenv2stage
256* ..
257* .. Executable Statements ..
258*
259* Test the input parameters
260*
261 info = 0
262 wantq = lsame( vect, 'V' )
263 upper = lsame( uplo, 'U' )
264 lquery = ( lwork.EQ.-1 ) .OR. ( lhous2.EQ.-1 )
265*
266* Determine the block size, the workspace size and the hous size.
267*
268 kd = ilaenv2stage( 1, 'SSYTRD_2STAGE', vect, n, -1, -1,
269 $ -1 )
270 ib = ilaenv2stage( 2, 'SSYTRD_2STAGE', vect, n, kd, -1,
271 $ -1 )
272 IF( n.EQ.0 ) THEN
273 lhmin = 1
274 lwmin = 1
275 ELSE
276 lhmin = ilaenv2stage( 3, 'SSYTRD_2STAGE', vect, n, kd, ib,
277 $ -1 )
278 lwmin = ilaenv2stage( 4, 'SSYTRD_2STAGE', vect, n, kd, ib,
279 $ -1 )
280 END IF
281*
282 IF( .NOT.lsame( vect, 'N' ) ) THEN
283 info = -1
284 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
285 info = -2
286 ELSE IF( n.LT.0 ) THEN
287 info = -3
288 ELSE IF( lda.LT.max( 1, n ) ) THEN
289 info = -5
290 ELSE IF( lhous2.LT.lhmin .AND. .NOT.lquery ) THEN
291 info = -10
292 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery ) THEN
293 info = -12
294 END IF
295*
296 IF( info.EQ.0 ) THEN
297 hous2( 1 ) = real( lhmin )
298 work( 1 ) = real( lwmin )
299 END IF
300*
301 IF( info.NE.0 ) THEN
302 CALL xerbla( 'SSYTRD_2STAGE', -info )
303 RETURN
304 ELSE IF( lquery ) THEN
305 RETURN
306 END IF
307*
308* Quick return if possible
309*
310 IF( n.EQ.0 ) THEN
311 work( 1 ) = 1
312 RETURN
313 END IF
314*
315* Determine pointer position
316*
317 ldab = kd+1
318 lwrk = lwork-ldab*n
319 abpos = 1
320 wpos = abpos + ldab*n
321 CALL ssytrd_sy2sb( uplo, n, kd, a, lda, work( abpos ), ldab,
322 $ tau, work( wpos ), lwrk, info )
323 IF( info.NE.0 ) THEN
324 CALL xerbla( 'SSYTRD_SY2SB', -info )
325 RETURN
326 END IF
327 CALL ssytrd_sb2st( 'Y', vect, uplo, n, kd,
328 $ work( abpos ), ldab, d, e,
329 $ hous2, lhous2, work( wpos ), lwrk, info )
330 IF( info.NE.0 ) THEN
331 CALL xerbla( 'SSYTRD_SB2ST', -info )
332 RETURN
333 END IF
334*
335*
336 work( 1 ) = real( lwmin )
337 RETURN
338*
339* End of SSYTRD_2STAGE
340*
341 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine ssytrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
SSYTRD_2STAGE
subroutine ssytrd_sb2st(stage1, vect, uplo, n, kd, ab, ldab, d, e, hous, lhous, work, lwork, info)
SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
subroutine ssytrd_sy2sb(uplo, n, kd, a, lda, ab, ldab, tau, work, lwork, info)
SSYTRD_SY2SB