3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE SBDT01( M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK,
14 * .. Scalar Arguments ..
15 * INTEGER KD, LDA, LDPT, LDQ, M, N
18 * .. Array Arguments ..
19 * REAL A( LDA, * ), D( * ), E( * ), PT( LDPT, * ),
20 * $ Q( LDQ, * ), WORK( * )
29 *> SBDT01 reconstructs a general matrix A from its bidiagonal form
31 *> where Q (m by min(m,n)) and P' (min(m,n) by n) are orthogonal
32 *> matrices and B is bidiagonal.
34 *> The test ratio to test the reduction is
35 *> RESID = norm( A - Q * B * PT ) / ( n * norm(A) * EPS )
36 *> where PT = P' and EPS is the machine precision.
45 *> The number of rows of the matrices A and Q.
51 *> The number of columns of the matrices A and P'.
57 *> If KD = 0, B is diagonal and the array E is not referenced.
58 *> If KD = 1, the reduction was performed by xGEBRD; B is upper
59 *> bidiagonal if M >= N, and lower bidiagonal if M < N.
60 *> If KD = -1, the reduction was performed by xGBBRD; B is
61 *> always upper bidiagonal.
66 *> A is REAL array, dimension (LDA,N)
67 *> The m by n matrix A.
73 *> The leading dimension of the array A. LDA >= max(1,M).
78 *> Q is REAL array, dimension (LDQ,N)
79 *> The m by min(m,n) orthogonal matrix Q in the reduction
86 *> The leading dimension of the array Q. LDQ >= max(1,M).
91 *> D is REAL array, dimension (min(M,N))
92 *> The diagonal elements of the bidiagonal matrix B.
97 *> E is REAL array, dimension (min(M,N)-1)
98 *> The superdiagonal elements of the bidiagonal matrix B if
99 *> m >= n, or the subdiagonal elements of B if m < n.
104 *> PT is REAL array, dimension (LDPT,N)
105 *> The min(m,n) by n orthogonal matrix P' in the reduction
112 *> The leading dimension of the array PT.
113 *> LDPT >= max(1,min(M,N)).
118 *> WORK is REAL array, dimension (M+N)
124 *> The test ratio: norm(A - Q * B * P') / ( n * norm(A) * EPS )
130 *> \author Univ. of Tennessee
131 *> \author Univ. of California Berkeley
132 *> \author Univ. of Colorado Denver
135 *> \date November 2011
137 *> \ingroup single_eig
139 * =====================================================================
140 SUBROUTINE SBDT01( M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK,
143 * -- LAPACK test routine (version 3.4.0) --
144 * -- LAPACK is a software package provided by Univ. of Tennessee, --
145 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 * .. Scalar Arguments ..
149 INTEGER KD, LDA, LDPT, LDQ, M, N
152 * .. Array Arguments ..
153 REAL A( LDA, * ), D( * ), E( * ), PT( LDPT, * ),
154 $ Q( LDQ, * ), WORK( * )
157 * =====================================================================
161 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
163 * .. Local Scalars ..
167 * .. External Functions ..
168 REAL SASUM, SLAMCH, SLANGE
169 EXTERNAL SASUM, SLAMCH, SLANGE
171 * .. External Subroutines ..
172 EXTERNAL SCOPY, SGEMV
174 * .. Intrinsic Functions ..
175 INTRINSIC MAX, MIN, REAL
177 * .. Executable Statements ..
179 * Quick return if possible
181 IF( M.LE.0 .OR. N.LE.0 ) THEN
186 * Compute A - Q * B * P' one column at a time.
193 IF( KD.NE.0 .AND. M.GE.N ) THEN
195 * B is upper bidiagonal and M >= N.
198 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
200 WORK( M+I ) = D( I )*PT( I, J ) + E( I )*PT( I+1, J )
202 WORK( M+N ) = D( N )*PT( N, J )
203 CALL SGEMV( 'No transpose', M, N, -ONE, Q, LDQ,
204 $ WORK( M+1 ), 1, ONE, WORK, 1 )
205 RESID = MAX( RESID, SASUM( M, WORK, 1 ) )
207 ELSE IF( KD.LT.0 ) THEN
209 * B is upper bidiagonal and M < N.
212 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
214 WORK( M+I ) = D( I )*PT( I, J ) + E( I )*PT( I+1, J )
216 WORK( M+M ) = D( M )*PT( M, J )
217 CALL SGEMV( 'No transpose', M, M, -ONE, Q, LDQ,
218 $ WORK( M+1 ), 1, ONE, WORK, 1 )
219 RESID = MAX( RESID, SASUM( M, WORK, 1 ) )
223 * B is lower bidiagonal.
226 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
227 WORK( M+1 ) = D( 1 )*PT( 1, J )
229 WORK( M+I ) = E( I-1 )*PT( I-1, J ) +
232 CALL SGEMV( 'No transpose', M, M, -ONE, Q, LDQ,
233 $ WORK( M+1 ), 1, ONE, WORK, 1 )
234 RESID = MAX( RESID, SASUM( M, WORK, 1 ) )
243 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
245 WORK( M+I ) = D( I )*PT( I, J )
247 CALL SGEMV( 'No transpose', M, N, -ONE, Q, LDQ,
248 $ WORK( M+1 ), 1, ONE, WORK, 1 )
249 RESID = MAX( RESID, SASUM( M, WORK, 1 ) )
253 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
255 WORK( M+I ) = D( I )*PT( I, J )
257 CALL SGEMV( 'No transpose', M, M, -ONE, Q, LDQ,
258 $ WORK( M+1 ), 1, ONE, WORK, 1 )
259 RESID = MAX( RESID, SASUM( M, WORK, 1 ) )
264 * Compute norm(A - Q * B * P') / ( n * norm(A) * EPS )
266 ANORM = SLANGE( '1', M, N, A, LDA, WORK )
267 EPS = SLAMCH( 'Precision' )
269 IF( ANORM.LE.ZERO ) THEN
273 IF( ANORM.GE.RESID ) THEN
274 RESID = ( RESID / ANORM ) / ( REAL( N )*EPS )
276 IF( ANORM.LT.ONE ) THEN
277 RESID = ( MIN( RESID, REAL( N )*ANORM ) / ANORM ) /
280 RESID = MIN( RESID / ANORM, REAL( N ) ) /