LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ chst01()

subroutine chst01 ( integer  N,
integer  ILO,
integer  IHI,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldh, * )  H,
integer  LDH,
complex, dimension( ldq, * )  Q,
integer  LDQ,
complex, dimension( lwork )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
real, dimension( 2 )  RESULT 
)

CHST01

Purpose:
 CHST01 tests the reduction of a general matrix A to upper Hessenberg
 form:  A = Q*H*Q'.  Two test ratios are computed;

 RESULT(1) = norm( A - Q*H*Q' ) / ( norm(A) * N * EPS )
 RESULT(2) = norm( I - Q'*Q ) / ( N * EPS )

 The matrix Q is assumed to be given explicitly as it would be
 following CGEHRD + CUNGHR.

 In this version, ILO and IHI are not used, but they could be used
 to save some work if this is desired.
Parameters
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]ILO
          ILO is INTEGER
[in]IHI
          IHI is INTEGER

          A is assumed to be upper triangular in rows and columns
          1:ILO-1 and IHI+1:N, so Q differs from the identity only in
          rows and columns ILO+1:IHI.
[in]A
          A is COMPLEX array, dimension (LDA,N)
          The original n by n matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in]H
          H is COMPLEX array, dimension (LDH,N)
          The upper Hessenberg matrix H from the reduction A = Q*H*Q'
          as computed by CGEHRD.  H is assumed to be zero below the
          first subdiagonal.
[in]LDH
          LDH is INTEGER
          The leading dimension of the array H.  LDH >= max(1,N).
[in]Q
          Q is COMPLEX array, dimension (LDQ,N)
          The orthogonal matrix Q from the reduction A = Q*H*Q' as
          computed by CGEHRD + CUNGHR.
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.  LDQ >= max(1,N).
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The length of the array WORK.  LWORK >= 2*N*N.
[out]RWORK
          RWORK is REAL array, dimension (N)
[out]RESULT
          RESULT is REAL array, dimension (2)
          RESULT(1) = norm( A - Q*H*Q' ) / ( norm(A) * N * EPS )
          RESULT(2) = norm( I - Q'*Q ) / ( N * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 138 of file chst01.f.

140 *
141 * -- LAPACK test routine --
142 * -- LAPACK is a software package provided by Univ. of Tennessee, --
143 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
144 *
145 * .. Scalar Arguments ..
146  INTEGER IHI, ILO, LDA, LDH, LDQ, LWORK, N
147 * ..
148 * .. Array Arguments ..
149  REAL RESULT( 2 ), RWORK( * )
150  COMPLEX A( LDA, * ), H( LDH, * ), Q( LDQ, * ),
151  $ WORK( LWORK )
152 * ..
153 *
154 * =====================================================================
155 *
156 * .. Parameters ..
157  REAL ONE, ZERO
158  parameter( one = 1.0e+0, zero = 0.0e+0 )
159 * ..
160 * .. Local Scalars ..
161  INTEGER LDWORK
162  REAL ANORM, EPS, OVFL, SMLNUM, UNFL, WNORM
163 * ..
164 * .. External Functions ..
165  REAL CLANGE, SLAMCH
166  EXTERNAL clange, slamch
167 * ..
168 * .. External Subroutines ..
169  EXTERNAL cgemm, clacpy, cunt01, slabad
170 * ..
171 * .. Intrinsic Functions ..
172  INTRINSIC cmplx, max, min
173 * ..
174 * .. Executable Statements ..
175 *
176 * Quick return if possible
177 *
178  IF( n.LE.0 ) THEN
179  result( 1 ) = zero
180  result( 2 ) = zero
181  RETURN
182  END IF
183 *
184  unfl = slamch( 'Safe minimum' )
185  eps = slamch( 'Precision' )
186  ovfl = one / unfl
187  CALL slabad( unfl, ovfl )
188  smlnum = unfl*n / eps
189 *
190 * Test 1: Compute norm( A - Q*H*Q' ) / ( norm(A) * N * EPS )
191 *
192 * Copy A to WORK
193 *
194  ldwork = max( 1, n )
195  CALL clacpy( ' ', n, n, a, lda, work, ldwork )
196 *
197 * Compute Q*H
198 *
199  CALL cgemm( 'No transpose', 'No transpose', n, n, n, cmplx( one ),
200  $ q, ldq, h, ldh, cmplx( zero ), work( ldwork*n+1 ),
201  $ ldwork )
202 *
203 * Compute A - Q*H*Q'
204 *
205  CALL cgemm( 'No transpose', 'Conjugate transpose', n, n, n,
206  $ cmplx( -one ), work( ldwork*n+1 ), ldwork, q, ldq,
207  $ cmplx( one ), work, ldwork )
208 *
209  anorm = max( clange( '1', n, n, a, lda, rwork ), unfl )
210  wnorm = clange( '1', n, n, work, ldwork, rwork )
211 *
212 * Note that RESULT(1) cannot overflow and is bounded by 1/(N*EPS)
213 *
214  result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
215 *
216 * Test 2: Compute norm( I - Q'*Q ) / ( N * EPS )
217 *
218  CALL cunt01( 'Columns', n, n, q, ldq, work, lwork, rwork,
219  $ result( 2 ) )
220 *
221  RETURN
222 *
223 * End of CHST01
224 *
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:187
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
Definition: cunt01.f:126
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:115
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: