LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
Collaboration diagram for complex:

Functions

subroutine cbdt01 (M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
 CBDT01 More...
 
subroutine cbdt02 (M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
 CBDT02 More...
 
subroutine cbdt03 (UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
 CBDT03 More...
 
subroutine cchkbb (NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE, NRHS, ISEED, THRESH, NOUNIT, A, LDA, AB, LDAB, BD, BE, Q, LDQ, P, LDP, C, LDC, CC, WORK, LWORK, RWORK, RESULT, INFO)
 CCHKBB More...
 
subroutine cchkbd (NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, ISEED, THRESH, A, LDA, BD, BE, S1, S2, X, LDX, Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, RWORK, NOUT, INFO)
 CCHKBD More...
 
subroutine cchkbk (NIN, NOUT)
 CCHKBK More...
 
subroutine cchkbl (NIN, NOUT)
 CCHKBL More...
 
subroutine cchkec (THRESH, TSTERR, NIN, NOUT)
 CCHKEC More...
 
program cchkee
 CCHKEE More...
 
subroutine cchkgg (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, TSTDIF, THRSHN, NOUNIT, A, LDA, B, H, T, S1, S2, P1, P2, U, LDU, V, Q, Z, ALPHA1, BETA1, ALPHA3, BETA3, EVECTL, EVECTR, WORK, LWORK, RWORK, LLWORK, RESULT, INFO)
 CCHKGG More...
 
subroutine cchkgk (NIN, NOUT)
 CCHKGK More...
 
subroutine cchkgl (NIN, NOUT)
 CCHKGL More...
 
subroutine cchkhb (NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK, LWORK, RWORK, RESULT, INFO)
 CCHKHB More...
 
subroutine cchkhs (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, W1, W3, EVECTL, EVECTR, EVECTY, EVECTX, UU, TAU, WORK, NWORK, RWORK, IWORK, SELECT, RESULT, INFO)
 CCHKHS More...
 
subroutine cchkst (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5, WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT, INFO)
 CCHKST More...
 
subroutine cckcsd (NM, MVAL, PVAL, QVAL, NMATS, ISEED, THRESH, MMAX, X, XF, U1, U2, V1T, V2T, THETA, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 CCKCSD More...
 
subroutine cckglm (NN, NVAL, MVAL, PVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 CCKGLM More...
 
subroutine cckgqr (NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO)
 CCKGQR More...
 
subroutine cckgsv (NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 CCKGSV More...
 
subroutine ccklse (NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 CCKLSE More...
 
subroutine ccsdts (M, P, Q, X, XF, LDX, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, THETA, IWORK, WORK, LWORK, RWORK, RESULT)
 CCSDTS More...
 
subroutine cdrges (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO)
 CDRGES More...
 
subroutine cdrges3 (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO)
 CDRGES3 More...
 
subroutine cdrgev (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, QE, LDQE, ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, RWORK, RESULT, INFO)
 CDRGEV More...
 
subroutine cdrgev3 (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, QE, LDQE, ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, RWORK, RESULT, INFO)
 CDRGEV3 More...
 
subroutine cdrgsx (NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, BI, Z, Q, ALPHA, BETA, C, LDC, S, WORK, LWORK, RWORK, IWORK, LIWORK, BWORK, INFO)
 CDRGSX More...
 
subroutine cdrgvx (NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI, ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE, S, STRU, DIF, DIFTRU, WORK, LWORK, RWORK, IWORK, LIWORK, RESULT, BWORK, INFO)
 CDRGVX More...
 
subroutine cdrvbd (NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, SSAV, E, WORK, LWORK, RWORK, IWORK, NOUNIT, INFO)
 CDRVBD More...
 
subroutine cdrves (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT, WORK, NWORK, RWORK, IWORK, BWORK, INFO)
 CDRVES More...
 
subroutine cdrvev (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK, INFO)
 CDRVEV More...
 
subroutine cdrvsg (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP, BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT, INFO)
 CDRVSG More...
 
subroutine cdrvst (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT, INFO)
 CDRVST More...
 
subroutine cdrvsx (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NIUNIT, NOUNIT, A, LDA, H, HT, W, WT, WTMP, VS, LDVS, VS1, RESULT, WORK, LWORK, RWORK, BWORK, INFO)
 CDRVSX More...
 
subroutine cdrvvx (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NIUNIT, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, WORK, NWORK, RWORK, INFO)
 CDRVVX More...
 
subroutine cerrbd (PATH, NUNIT)
 CERRBD More...
 
subroutine cerrec (PATH, NUNIT)
 CERREC More...
 
subroutine cerred (PATH, NUNIT)
 CERRED More...
 
subroutine cerrgg (PATH, NUNIT)
 CERRGG More...
 
subroutine cerrhs (PATH, NUNIT)
 CERRHS More...
 
subroutine cerrst (PATH, NUNIT)
 CERRST More...
 
subroutine cget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CGET02 More...
 
subroutine cget10 (M, N, A, LDA, B, LDB, WORK, RWORK, RESULT)
 CGET10 More...
 
subroutine cget22 (TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
 CGET22 More...
 
subroutine cget23 (COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, WORK, LWORK, RWORK, INFO)
 CGET23 More...
 
subroutine cget24 (COMP, JTYPE, THRESH, ISEED, NOUNIT, N, A, LDA, H, HT, W, WT, WTMP, VS, LDVS, VS1, RCDEIN, RCDVIN, NSLCT, ISLCT, ISRT, RESULT, WORK, LWORK, RWORK, BWORK, INFO)
 CGET24 More...
 
subroutine cget35 (RMAX, LMAX, NINFO, KNT, NIN)
 CGET35 More...
 
subroutine cget36 (RMAX, LMAX, NINFO, KNT, NIN)
 CGET36 More...
 
subroutine cget37 (RMAX, LMAX, NINFO, KNT, NIN)
 CGET37 More...
 
subroutine cget38 (RMAX, LMAX, NINFO, KNT, NIN)
 CGET38 More...
 
subroutine cget51 (ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
 CGET51 More...
 
subroutine cget52 (LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
 CGET52 More...
 
subroutine cget54 (N, A, LDA, B, LDB, S, LDS, T, LDT, U, LDU, V, LDV, WORK, RESULT)
 CGET54 More...
 
subroutine cglmts (N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
 CGLMTS More...
 
subroutine cgqrts (N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 CGQRTS More...
 
subroutine cgrqts (M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 CGRQTS More...
 
subroutine cgsvts3 (M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V, LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK, LWORK, RWORK, RESULT)
 CGSVTS3 More...
 
subroutine chbt21 (UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RWORK, RESULT)
 CHBT21 More...
 
subroutine chet21 (ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
 CHET21 More...
 
subroutine chet22 (ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
 CHET22 More...
 
subroutine chkxer (SRNAMT, INFOT, NOUT, LERR, OK)
 CHKXER More...
 
subroutine chpt21 (ITYPE, UPLO, N, KBAND, AP, D, E, U, LDU, VP, TAU, WORK, RWORK, RESULT)
 CHPT21 More...
 
subroutine chst01 (N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
 CHST01 More...
 
subroutine clarfy (UPLO, N, V, INCV, TAU, C, LDC, WORK)
 CLARFY More...
 
subroutine clarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 CLARHS More...
 
subroutine clatm4 (ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
 CLATM4 More...
 
logical function clctes (Z, D)
 CLCTES More...
 
logical function clctsx (ALPHA, BETA)
 CLCTSX More...
 
subroutine clsets (M, P, N, A, AF, LDA, B, BF, LDB, C, CF, D, DF, X, WORK, LWORK, RWORK, RESULT)
 CLSETS More...
 
subroutine csbmv (UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
 CSBMV More...
 
subroutine csgt01 (ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
 CSGT01 More...
 
logical function cslect (Z)
 CSLECT More...
 
subroutine cstt21 (N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RWORK, RESULT)
 CSTT21 More...
 
subroutine cstt22 (N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RWORK, RESULT)
 CSTT22 More...
 
subroutine cunt01 (ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
 CUNT01 More...
 
subroutine cunt03 (RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RWORK, RESULT, INFO)
 CUNT03 More...
 

Detailed Description

This is the group of complex LAPACK TESTING EIG routines.

Function Documentation

subroutine cbdt01 ( integer  M,
integer  N,
integer  KD,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldq, * )  Q,
integer  LDQ,
real, dimension( * )  D,
real, dimension( * )  E,
complex, dimension( ldpt, * )  PT,
integer  LDPT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
real  RESID 
)

CBDT01

Purpose:
 CBDT01 reconstructs a general matrix A from its bidiagonal form
    A = Q * B * P'
 where Q (m by min(m,n)) and P' (min(m,n) by n) are unitary
 matrices and B is bidiagonal.

 The test ratio to test the reduction is
    RESID = norm( A - Q * B * PT ) / ( n * norm(A) * EPS )
 where PT = P' and EPS is the machine precision.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrices A and Q.
[in]N
          N is INTEGER
          The number of columns of the matrices A and P'.
[in]KD
          KD is INTEGER
          If KD = 0, B is diagonal and the array E is not referenced.
          If KD = 1, the reduction was performed by xGEBRD; B is upper
          bidiagonal if M >= N, and lower bidiagonal if M < N.
          If KD = -1, the reduction was performed by xGBBRD; B is
          always upper bidiagonal.
[in]A
          A is COMPLEX array, dimension (LDA,N)
          The m by n matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,M).
[in]Q
          Q is COMPLEX array, dimension (LDQ,N)
          The m by min(m,n) unitary matrix Q in the reduction
          A = Q * B * P'.
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.  LDQ >= max(1,M).
[in]D
          D is REAL array, dimension (min(M,N))
          The diagonal elements of the bidiagonal matrix B.
[in]E
          E is REAL array, dimension (min(M,N)-1)
          The superdiagonal elements of the bidiagonal matrix B if
          m >= n, or the subdiagonal elements of B if m < n.
[in]PT
          PT is COMPLEX array, dimension (LDPT,N)
          The min(m,n) by n unitary matrix P' in the reduction
          A = Q * B * P'.
[in]LDPT
          LDPT is INTEGER
          The leading dimension of the array PT.
          LDPT >= max(1,min(M,N)).
[out]WORK
          WORK is COMPLEX array, dimension (M+N)
[out]RWORK
          RWORK is REAL array, dimension (M)
[out]RESID
          RESID is REAL
          The test ratio:  norm(A - Q * B * P') / ( n * norm(A) * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 148 of file cbdt01.f.

148 *
149 * -- LAPACK test routine (version 3.4.0) --
150 * -- LAPACK is a software package provided by Univ. of Tennessee, --
151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
152 * November 2011
153 *
154 * .. Scalar Arguments ..
155  INTEGER kd, lda, ldpt, ldq, m, n
156  REAL resid
157 * ..
158 * .. Array Arguments ..
159  REAL d( * ), e( * ), rwork( * )
160  COMPLEX a( lda, * ), pt( ldpt, * ), q( ldq, * ),
161  $ work( * )
162 * ..
163 *
164 * =====================================================================
165 *
166 * .. Parameters ..
167  REAL zero, one
168  parameter( zero = 0.0e+0, one = 1.0e+0 )
169 * ..
170 * .. Local Scalars ..
171  INTEGER i, j
172  REAL anorm, eps
173 * ..
174 * .. External Functions ..
175  REAL clange, scasum, slamch
176  EXTERNAL clange, scasum, slamch
177 * ..
178 * .. External Subroutines ..
179  EXTERNAL ccopy, cgemv
180 * ..
181 * .. Intrinsic Functions ..
182  INTRINSIC cmplx, max, min, real
183 * ..
184 * .. Executable Statements ..
185 *
186 * Quick return if possible
187 *
188  IF( m.LE.0 .OR. n.LE.0 ) THEN
189  resid = zero
190  RETURN
191  END IF
192 *
193 * Compute A - Q * B * P' one column at a time.
194 *
195  resid = zero
196  IF( kd.NE.0 ) THEN
197 *
198 * B is bidiagonal.
199 *
200  IF( kd.NE.0 .AND. m.GE.n ) THEN
201 *
202 * B is upper bidiagonal and M >= N.
203 *
204  DO 20 j = 1, n
205  CALL ccopy( m, a( 1, j ), 1, work, 1 )
206  DO 10 i = 1, n - 1
207  work( m+i ) = d( i )*pt( i, j ) + e( i )*pt( i+1, j )
208  10 CONTINUE
209  work( m+n ) = d( n )*pt( n, j )
210  CALL cgemv( 'No transpose', m, n, -cmplx( one ), q, ldq,
211  $ work( m+1 ), 1, cmplx( one ), work, 1 )
212  resid = max( resid, scasum( m, work, 1 ) )
213  20 CONTINUE
214  ELSE IF( kd.LT.0 ) THEN
215 *
216 * B is upper bidiagonal and M < N.
217 *
218  DO 40 j = 1, n
219  CALL ccopy( m, a( 1, j ), 1, work, 1 )
220  DO 30 i = 1, m - 1
221  work( m+i ) = d( i )*pt( i, j ) + e( i )*pt( i+1, j )
222  30 CONTINUE
223  work( m+m ) = d( m )*pt( m, j )
224  CALL cgemv( 'No transpose', m, m, -cmplx( one ), q, ldq,
225  $ work( m+1 ), 1, cmplx( one ), work, 1 )
226  resid = max( resid, scasum( m, work, 1 ) )
227  40 CONTINUE
228  ELSE
229 *
230 * B is lower bidiagonal.
231 *
232  DO 60 j = 1, n
233  CALL ccopy( m, a( 1, j ), 1, work, 1 )
234  work( m+1 ) = d( 1 )*pt( 1, j )
235  DO 50 i = 2, m
236  work( m+i ) = e( i-1 )*pt( i-1, j ) +
237  $ d( i )*pt( i, j )
238  50 CONTINUE
239  CALL cgemv( 'No transpose', m, m, -cmplx( one ), q, ldq,
240  $ work( m+1 ), 1, cmplx( one ), work, 1 )
241  resid = max( resid, scasum( m, work, 1 ) )
242  60 CONTINUE
243  END IF
244  ELSE
245 *
246 * B is diagonal.
247 *
248  IF( m.GE.n ) THEN
249  DO 80 j = 1, n
250  CALL ccopy( m, a( 1, j ), 1, work, 1 )
251  DO 70 i = 1, n
252  work( m+i ) = d( i )*pt( i, j )
253  70 CONTINUE
254  CALL cgemv( 'No transpose', m, n, -cmplx( one ), q, ldq,
255  $ work( m+1 ), 1, cmplx( one ), work, 1 )
256  resid = max( resid, scasum( m, work, 1 ) )
257  80 CONTINUE
258  ELSE
259  DO 100 j = 1, n
260  CALL ccopy( m, a( 1, j ), 1, work, 1 )
261  DO 90 i = 1, m
262  work( m+i ) = d( i )*pt( i, j )
263  90 CONTINUE
264  CALL cgemv( 'No transpose', m, m, -cmplx( one ), q, ldq,
265  $ work( m+1 ), 1, cmplx( one ), work, 1 )
266  resid = max( resid, scasum( m, work, 1 ) )
267  100 CONTINUE
268  END IF
269  END IF
270 *
271 * Compute norm(A - Q * B * P') / ( n * norm(A) * EPS )
272 *
273  anorm = clange( '1', m, n, a, lda, rwork )
274  eps = slamch( 'Precision' )
275 *
276  IF( anorm.LE.zero ) THEN
277  IF( resid.NE.zero )
278  $ resid = one / eps
279  ELSE
280  IF( anorm.GE.resid ) THEN
281  resid = ( resid / anorm ) / ( REAL( n )*eps )
282  ELSE
283  IF( anorm.LT.one ) THEN
284  resid = ( min( resid, REAL( n )*anorm ) / anorm ) /
285  $ ( REAL( n )*eps )
286  ELSE
287  resid = min( resid / anorm, REAL( N ) ) /
288  $ ( REAL( n )*eps )
289  END IF
290  END IF
291  END IF
292 *
293  RETURN
294 *
295 * End of CBDT01
296 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:54
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
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:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cbdt02 ( integer  M,
integer  N,
complex, dimension( ldb, * )  B,
integer  LDB,
complex, dimension( ldc, * )  C,
integer  LDC,
complex, dimension( ldu, * )  U,
integer  LDU,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
real  RESID 
)

CBDT02

Purpose:
 CBDT02 tests the change of basis C = U' * B by computing the residual

    RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),

 where B and C are M by N matrices, U is an M by M orthogonal matrix,
 and EPS is the machine precision.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrices B and C and the order of
          the matrix Q.
[in]N
          N is INTEGER
          The number of columns of the matrices B and C.
[in]B
          B is COMPLEX array, dimension (LDB,N)
          The m by n matrix B.
[in]LDB
          LDB is INTEGER
          The leading dimension of the array B.  LDB >= max(1,M).
[in]C
          C is COMPLEX array, dimension (LDC,N)
          The m by n matrix C, assumed to contain U' * B.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C.  LDC >= max(1,M).
[in]U
          U is COMPLEX array, dimension (LDU,M)
          The m by m orthogonal matrix U.
[in]LDU
          LDU is INTEGER
          The leading dimension of the array U.  LDU >= max(1,M).
[out]WORK
          WORK is COMPLEX array, dimension (M)
[out]RWORK
          RWORK is REAL array, dimension (M)
[out]RESID
          RESID is REAL
          RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 121 of file cbdt02.f.

121 *
122 * -- LAPACK test routine (version 3.4.0) --
123 * -- LAPACK is a software package provided by Univ. of Tennessee, --
124 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125 * November 2011
126 *
127 * .. Scalar Arguments ..
128  INTEGER ldb, ldc, ldu, m, n
129  REAL resid
130 * ..
131 * .. Array Arguments ..
132  REAL rwork( * )
133  COMPLEX b( ldb, * ), c( ldc, * ), u( ldu, * ),
134  $ work( * )
135 * ..
136 *
137 * ======================================================================
138 *
139 * .. Parameters ..
140  REAL zero, one
141  parameter( zero = 0.0e+0, one = 1.0e+0 )
142 * ..
143 * .. Local Scalars ..
144  INTEGER j
145  REAL bnorm, eps, realmn
146 * ..
147 * .. External Functions ..
148  REAL clange, scasum, slamch
149  EXTERNAL clange, scasum, slamch
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL ccopy, cgemv
153 * ..
154 * .. Intrinsic Functions ..
155  INTRINSIC cmplx, max, min, real
156 * ..
157 * .. Executable Statements ..
158 *
159 * Quick return if possible
160 *
161  resid = zero
162  IF( m.LE.0 .OR. n.LE.0 )
163  $ RETURN
164  realmn = REAL( MAX( M, N ) )
165  eps = slamch( 'Precision' )
166 *
167 * Compute norm( B - U * C )
168 *
169  DO 10 j = 1, n
170  CALL ccopy( m, b( 1, j ), 1, work, 1 )
171  CALL cgemv( 'No transpose', m, m, -cmplx( one ), u, ldu,
172  $ c( 1, j ), 1, cmplx( one ), work, 1 )
173  resid = max( resid, scasum( m, work, 1 ) )
174  10 CONTINUE
175 *
176 * Compute norm of B.
177 *
178  bnorm = clange( '1', m, n, b, ldb, rwork )
179 *
180  IF( bnorm.LE.zero ) THEN
181  IF( resid.NE.zero )
182  $ resid = one / eps
183  ELSE
184  IF( bnorm.GE.resid ) THEN
185  resid = ( resid / bnorm ) / ( realmn*eps )
186  ELSE
187  IF( bnorm.LT.one ) THEN
188  resid = ( min( resid, realmn*bnorm ) / bnorm ) /
189  $ ( realmn*eps )
190  ELSE
191  resid = min( resid / bnorm, realmn ) / ( realmn*eps )
192  END IF
193  END IF
194  END IF
195  RETURN
196 *
197 * End of CBDT02
198 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:54
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
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:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cbdt03 ( character  UPLO,
integer  N,
integer  KD,
real, dimension( * )  D,
real, dimension( * )  E,
complex, dimension( ldu, * )  U,
integer  LDU,
real, dimension( * )  S,
complex, dimension( ldvt, * )  VT,
integer  LDVT,
complex, dimension( * )  WORK,
real  RESID 
)

CBDT03

Purpose:
 CBDT03 reconstructs a bidiagonal matrix B from its SVD:
    S = U' * B * V
 where U and V are orthogonal matrices and S is diagonal.

 The test ratio to test the singular value decomposition is
    RESID = norm( B - U * S * VT ) / ( n * norm(B) * EPS )
 where VT = V' and EPS is the machine precision.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the matrix B is upper or lower bidiagonal.
          = 'U':  Upper bidiagonal
          = 'L':  Lower bidiagonal
[in]N
          N is INTEGER
          The order of the matrix B.
[in]KD
          KD is INTEGER
          The bandwidth of the bidiagonal matrix B.  If KD = 1, the
          matrix B is bidiagonal, and if KD = 0, B is diagonal and E is
          not referenced.  If KD is greater than 1, it is assumed to be
          1, and if KD is less than 0, it is assumed to be 0.
[in]D
          D is REAL array, dimension (N)
          The n diagonal elements of the bidiagonal matrix B.
[in]E
          E is REAL array, dimension (N-1)
          The (n-1) superdiagonal elements of the bidiagonal matrix B
          if UPLO = 'U', or the (n-1) subdiagonal elements of B if
          UPLO = 'L'.
[in]U
          U is COMPLEX array, dimension (LDU,N)
          The n by n orthogonal matrix U in the reduction B = U'*A*P.
[in]LDU
          LDU is INTEGER
          The leading dimension of the array U.  LDU >= max(1,N)
[in]S
          S is REAL array, dimension (N)
          The singular values from the SVD of B, sorted in decreasing
          order.
[in]VT
          VT is COMPLEX array, dimension (LDVT,N)
          The n by n orthogonal matrix V' in the reduction
          B = U * S * V'.
[in]LDVT
          LDVT is INTEGER
          The leading dimension of the array VT.
[out]WORK
          WORK is COMPLEX array, dimension (2*N)
[out]RESID
          RESID is REAL
          The test ratio:  norm(B - U * S * V') / ( n * norm(A) * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 137 of file cbdt03.f.

137 *
138 * -- LAPACK test routine (version 3.4.0) --
139 * -- LAPACK is a software package provided by Univ. of Tennessee, --
140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141 * November 2011
142 *
143 * .. Scalar Arguments ..
144  CHARACTER uplo
145  INTEGER kd, ldu, ldvt, n
146  REAL resid
147 * ..
148 * .. Array Arguments ..
149  REAL d( * ), e( * ), s( * )
150  COMPLEX u( ldu, * ), vt( ldvt, * ), work( * )
151 * ..
152 *
153 * ======================================================================
154 *
155 * .. Parameters ..
156  REAL zero, one
157  parameter( zero = 0.0e+0, one = 1.0e+0 )
158 * ..
159 * .. Local Scalars ..
160  INTEGER i, j
161  REAL bnorm, eps
162 * ..
163 * .. External Functions ..
164  LOGICAL lsame
165  INTEGER isamax
166  REAL scasum, slamch
167  EXTERNAL lsame, isamax, scasum, slamch
168 * ..
169 * .. External Subroutines ..
170  EXTERNAL cgemv
171 * ..
172 * .. Intrinsic Functions ..
173  INTRINSIC abs, cmplx, max, min, real
174 * ..
175 * .. Executable Statements ..
176 *
177 * Quick return if possible
178 *
179  resid = zero
180  IF( n.LE.0 )
181  $ RETURN
182 *
183 * Compute B - U * S * V' one column at a time.
184 *
185  bnorm = zero
186  IF( kd.GE.1 ) THEN
187 *
188 * B is bidiagonal.
189 *
190  IF( lsame( uplo, 'U' ) ) THEN
191 *
192 * B is upper bidiagonal.
193 *
194  DO 20 j = 1, n
195  DO 10 i = 1, n
196  work( n+i ) = s( i )*vt( i, j )
197  10 CONTINUE
198  CALL cgemv( 'No transpose', n, n, -cmplx( one ), u, ldu,
199  $ work( n+1 ), 1, cmplx( zero ), work, 1 )
200  work( j ) = work( j ) + d( j )
201  IF( j.GT.1 ) THEN
202  work( j-1 ) = work( j-1 ) + e( j-1 )
203  bnorm = max( bnorm, abs( d( j ) )+abs( e( j-1 ) ) )
204  ELSE
205  bnorm = max( bnorm, abs( d( j ) ) )
206  END IF
207  resid = max( resid, scasum( n, work, 1 ) )
208  20 CONTINUE
209  ELSE
210 *
211 * B is lower bidiagonal.
212 *
213  DO 40 j = 1, n
214  DO 30 i = 1, n
215  work( n+i ) = s( i )*vt( i, j )
216  30 CONTINUE
217  CALL cgemv( 'No transpose', n, n, -cmplx( one ), u, ldu,
218  $ work( n+1 ), 1, cmplx( zero ), work, 1 )
219  work( j ) = work( j ) + d( j )
220  IF( j.LT.n ) THEN
221  work( j+1 ) = work( j+1 ) + e( j )
222  bnorm = max( bnorm, abs( d( j ) )+abs( e( j ) ) )
223  ELSE
224  bnorm = max( bnorm, abs( d( j ) ) )
225  END IF
226  resid = max( resid, scasum( n, work, 1 ) )
227  40 CONTINUE
228  END IF
229  ELSE
230 *
231 * B is diagonal.
232 *
233  DO 60 j = 1, n
234  DO 50 i = 1, n
235  work( n+i ) = s( i )*vt( i, j )
236  50 CONTINUE
237  CALL cgemv( 'No transpose', n, n, -cmplx( one ), u, ldu,
238  $ work( n+1 ), 1, cmplx( zero ), work, 1 )
239  work( j ) = work( j ) + d( j )
240  resid = max( resid, scasum( n, work, 1 ) )
241  60 CONTINUE
242  j = isamax( n, d, 1 )
243  bnorm = abs( d( j ) )
244  END IF
245 *
246 * Compute norm(B - U * S * V') / ( n * norm(B) * EPS )
247 *
248  eps = slamch( 'Precision' )
249 *
250  IF( bnorm.LE.zero ) THEN
251  IF( resid.NE.zero )
252  $ resid = one / eps
253  ELSE
254  IF( bnorm.GE.resid ) THEN
255  resid = ( resid / bnorm ) / ( REAL( n )*eps )
256  ELSE
257  IF( bnorm.LT.one ) THEN
258  resid = ( min( resid, REAL( n )*bnorm ) / bnorm ) /
259  $ ( REAL( n )*eps )
260  ELSE
261  resid = min( resid / bnorm, REAL( N ) ) /
262  $ ( REAL( n )*eps )
263  END IF
264  END IF
265  END IF
266 *
267  RETURN
268 *
269 * End of CBDT03
270 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:54
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkbb ( integer  NSIZES,
integer, dimension( * )  MVAL,
integer, dimension( * )  NVAL,
integer  NWDTHS,
integer, dimension( * )  KK,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer  NRHS,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldab, * )  AB,
integer  LDAB,
real, dimension( * )  BD,
real, dimension( * )  BE,
complex, dimension( ldq, * )  Q,
integer  LDQ,
complex, dimension( ldp, * )  P,
integer  LDP,
complex, dimension( ldc, * )  C,
integer  LDC,
complex, dimension( ldc, * )  CC,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
real, dimension( * )  RESULT,
integer  INFO 
)

CCHKBB

Purpose:
 CCHKBB tests the reduction of a general complex rectangular band
 matrix to real bidiagonal form.

 CGBBRD factors a general band matrix A as  Q B P* , where * means
 conjugate transpose, B is upper bidiagonal, and Q and P are unitary;
 CGBBRD can also overwrite a given matrix C with Q* C .

 For each pair of matrix dimensions (M,N) and each selected matrix
 type, an M by N matrix A and an M by NRHS matrix C are generated.
 The problem dimensions are as follows
    A:          M x N
    Q:          M x M
    P:          N x N
    B:          min(M,N) x min(M,N)
    C:          M x NRHS

 For each generated matrix, 4 tests are performed:

 (1)   | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P'

 (2)   | I - Q' Q | / ( M ulp )

 (3)   | I - PT PT' | / ( N ulp )

 (4)   | Y - Q' C | / ( |Y| max(M,NRHS) ulp ), where Y = Q' C.

 The "types" are specified by a logical array DOTYPE( 1:NTYPES );
 if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
 Currently, the list of possible types is:

 The possible matrix types are

 (1)  The zero matrix.
 (2)  The identity matrix.

 (3)  A diagonal matrix with evenly spaced entries
      1, ..., ULP  and random signs.
      (ULP = (first number larger than 1) - 1 )
 (4)  A diagonal matrix with geometrically spaced entries
      1, ..., ULP  and random signs.
 (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
      and random signs.

 (6)  Same as (3), but multiplied by SQRT( overflow threshold )
 (7)  Same as (3), but multiplied by SQRT( underflow threshold )

 (8)  A matrix of the form  U D V, where U and V are orthogonal and
      D has evenly spaced entries 1, ..., ULP with random signs
      on the diagonal.

 (9)  A matrix of the form  U D V, where U and V are orthogonal and
      D has geometrically spaced entries 1, ..., ULP with random
      signs on the diagonal.

 (10) A matrix of the form  U D V, where U and V are orthogonal and
      D has "clustered" entries 1, ULP,..., ULP with random
      signs on the diagonal.

 (11) Same as (8), but multiplied by SQRT( overflow threshold )
 (12) Same as (8), but multiplied by SQRT( underflow threshold )

 (13) Rectangular matrix with random entries chosen from (-1,1).
 (14) Same as (13), but multiplied by SQRT( overflow threshold )
 (15) Same as (13), but multiplied by SQRT( underflow threshold )
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of values of M and N contained in the vectors
          MVAL and NVAL.  The matrix sizes are used in pairs (M,N).
          If NSIZES is zero, CCHKBB does nothing.  NSIZES must be at
          least zero.
[in]MVAL
          MVAL is INTEGER array, dimension (NSIZES)
          The values of the matrix row dimension M.
[in]NVAL
          NVAL is INTEGER array, dimension (NSIZES)
          The values of the matrix column dimension N.
[in]NWDTHS
          NWDTHS is INTEGER
          The number of bandwidths to use.  If it is zero,
          CCHKBB does nothing.  It must be at least zero.
[in]KK
          KK is INTEGER array, dimension (NWDTHS)
          An array containing the bandwidths to be used for the band
          matrices.  The values must be at least zero.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, CCHKBB
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrix is in A.  This
          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size in NN a
          matrix of that size and of type j will be generated.
          If NTYPES is smaller than the maximum number of types
          defined (PARAMETER MAXTYP), then types NTYPES+1 through
          MAXTYP will not be generated.  If NTYPES is larger
          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
          will be ignored.
[in]NRHS
          NRHS is INTEGER
          The number of columns in the "right-hand side" matrix C.
          If NRHS = 0, then the operations on the right-hand side will
          not be tested. NRHS must be at least 0.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator. The array elements should be between 0 and 4095;
          if not they will be reduced mod 4096.  Also, ISEED(4) must
          be odd.  The random number generator uses a linear
          congruential sequence limited to small integers, and so
          should produce machine independent random numbers. The
          values of ISEED are changed on exit, and can be used in the
          next call to CCHKBB to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL array, dimension
                            (LDA, max(NN))
          Used to hold the matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at least 1
          and at least max( NN ).
[out]AB
          AB is REAL array, dimension (LDAB, max(NN))
          Used to hold A in band storage format.
[in]LDAB
          LDAB is INTEGER
          The leading dimension of AB.  It must be at least 2 (not 1!)
          and at least max( KK )+1.
[out]BD
          BD is REAL array, dimension (max(NN))
          Used to hold the diagonal of the bidiagonal matrix computed
          by CGBBRD.
[out]BE
          BE is REAL array, dimension (max(NN))
          Used to hold the off-diagonal of the bidiagonal matrix
          computed by CGBBRD.
[out]Q
          Q is COMPLEX array, dimension (LDQ, max(NN))
          Used to hold the unitary matrix Q computed by CGBBRD.
[in]LDQ
          LDQ is INTEGER
          The leading dimension of Q.  It must be at least 1
          and at least max( NN ).
[out]P
          P is COMPLEX array, dimension (LDP, max(NN))
          Used to hold the unitary matrix P computed by CGBBRD.
[in]LDP
          LDP is INTEGER
          The leading dimension of P.  It must be at least 1
          and at least max( NN ).
[out]C
          C is COMPLEX array, dimension (LDC, max(NN))
          Used to hold the matrix C updated by CGBBRD.
[in]LDC
          LDC is INTEGER
          The leading dimension of U.  It must be at least 1
          and at least max( NN ).
[out]CC
          CC is COMPLEX array, dimension (LDC, max(NN))
          Used to hold a copy of the matrix C.
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max( LDA+1, max(NN)+1 )*max(NN).
[out]RWORK
          RWORK is REAL array, dimension (max(NN))
[out]RESULT
          RESULT is REAL array, dimension (4)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.

-----------------------------------------------------------------------

       Some Local Variables and Parameters:
       ---- ----- --------- --- ----------
       ZERO, ONE       Real 0 and 1.
       MAXTYP          The number of types defined.
       NTEST           The number of tests performed, or which can
                       be performed so far, for the current matrix.
       NTESTT          The total number of tests performed so far.
       NMAX            Largest value in NN.
       NMATS           The number of matrices generated so far.
       NERRS           The number of tests which have exceeded THRESH
                       so far.
       COND, IMODE     Values to be passed to the matrix generators.
       ANORM           Norm of A; passed to matrix generators.

       OVFL, UNFL      Overflow and underflow thresholds.
       ULP, ULPINV     Finest relative precision and its inverse.
       RTOVFL, RTUNFL  Square roots of the previous 2 values.
               The following four arrays decode JTYPE:
       KTYPE(j)        The general type (1-10) for type "j".
       KMODE(j)        The MODE value to be passed to the matrix
                       generator for type "j".
       KMAGN(j)        The order of magnitude ( O(1),
                       O(overflow^(1/2) ), O(underflow^(1/2) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 363 of file cchkbb.f.

363 *
364 * -- LAPACK test routine (input) --
365 * -- LAPACK is a software package provided by Univ. of Tennessee, --
366 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
367 * November 2011
368 *
369 * .. Scalar Arguments ..
370  INTEGER info, lda, ldab, ldc, ldp, ldq, lwork, nounit,
371  $ nrhs, nsizes, ntypes, nwdths
372  REAL thresh
373 * ..
374 * .. Array Arguments ..
375  LOGICAL dotype( * )
376  INTEGER iseed( 4 ), kk( * ), mval( * ), nval( * )
377  REAL bd( * ), be( * ), result( * ), rwork( * )
378  COMPLEX a( lda, * ), ab( ldab, * ), c( ldc, * ),
379  $ cc( ldc, * ), p( ldp, * ), q( ldq, * ),
380  $ work( * )
381 * ..
382 *
383 * =====================================================================
384 *
385 * .. Parameters ..
386  COMPLEX czero, cone
387  parameter( czero = ( 0.0e+0, 0.0e+0 ),
388  $ cone = ( 1.0e+0, 0.0e+0 ) )
389  REAL zero, one
390  parameter( zero = 0.0e+0, one = 1.0e+0 )
391  INTEGER maxtyp
392  parameter( maxtyp = 15 )
393 * ..
394 * .. Local Scalars ..
395  LOGICAL badmm, badnn, badnnb
396  INTEGER i, iinfo, imode, itype, j, jcol, jr, jsize,
397  $ jtype, jwidth, k, kl, kmax, ku, m, mmax, mnmax,
398  $ mnmin, mtypes, n, nerrs, nmats, nmax, ntest,
399  $ ntestt
400  REAL amninv, anorm, cond, ovfl, rtovfl, rtunfl, ulp,
401  $ ulpinv, unfl
402 * ..
403 * .. Local Arrays ..
404  INTEGER idumma( 1 ), ioldsd( 4 ), kmagn( maxtyp ),
405  $ kmode( maxtyp ), ktype( maxtyp )
406 * ..
407 * .. External Functions ..
408  REAL slamch
409  EXTERNAL slamch
410 * ..
411 * .. External Subroutines ..
412  EXTERNAL cbdt01, cbdt02, cgbbrd, clacpy, claset, clatmr,
414 * ..
415 * .. Intrinsic Functions ..
416  INTRINSIC abs, max, min, REAL, sqrt
417 * ..
418 * .. Data statements ..
419  DATA ktype / 1, 2, 5*4, 5*6, 3*9 /
420  DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3 /
421  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
422  $ 0, 0 /
423 * ..
424 * .. Executable Statements ..
425 *
426 * Check for errors
427 *
428  ntestt = 0
429  info = 0
430 *
431 * Important constants
432 *
433  badmm = .false.
434  badnn = .false.
435  mmax = 1
436  nmax = 1
437  mnmax = 1
438  DO 10 j = 1, nsizes
439  mmax = max( mmax, mval( j ) )
440  IF( mval( j ).LT.0 )
441  $ badmm = .true.
442  nmax = max( nmax, nval( j ) )
443  IF( nval( j ).LT.0 )
444  $ badnn = .true.
445  mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
446  10 CONTINUE
447 *
448  badnnb = .false.
449  kmax = 0
450  DO 20 j = 1, nwdths
451  kmax = max( kmax, kk( j ) )
452  IF( kk( j ).LT.0 )
453  $ badnnb = .true.
454  20 CONTINUE
455 *
456 * Check for errors
457 *
458  IF( nsizes.LT.0 ) THEN
459  info = -1
460  ELSE IF( badmm ) THEN
461  info = -2
462  ELSE IF( badnn ) THEN
463  info = -3
464  ELSE IF( nwdths.LT.0 ) THEN
465  info = -4
466  ELSE IF( badnnb ) THEN
467  info = -5
468  ELSE IF( ntypes.LT.0 ) THEN
469  info = -6
470  ELSE IF( nrhs.LT.0 ) THEN
471  info = -8
472  ELSE IF( lda.LT.nmax ) THEN
473  info = -13
474  ELSE IF( ldab.LT.2*kmax+1 ) THEN
475  info = -15
476  ELSE IF( ldq.LT.nmax ) THEN
477  info = -19
478  ELSE IF( ldp.LT.nmax ) THEN
479  info = -21
480  ELSE IF( ldc.LT.nmax ) THEN
481  info = -23
482  ELSE IF( ( max( lda, nmax )+1 )*nmax.GT.lwork ) THEN
483  info = -26
484  END IF
485 *
486  IF( info.NE.0 ) THEN
487  CALL xerbla( 'CCHKBB', -info )
488  RETURN
489  END IF
490 *
491 * Quick return if possible
492 *
493  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
494  $ RETURN
495 *
496 * More Important constants
497 *
498  unfl = slamch( 'Safe minimum' )
499  ovfl = one / unfl
500  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
501  ulpinv = one / ulp
502  rtunfl = sqrt( unfl )
503  rtovfl = sqrt( ovfl )
504 *
505 * Loop over sizes, widths, types
506 *
507  nerrs = 0
508  nmats = 0
509 *
510  DO 160 jsize = 1, nsizes
511  m = mval( jsize )
512  n = nval( jsize )
513  mnmin = min( m, n )
514  amninv = one / REAL( MAX( 1, M, N ) )
515 *
516  DO 150 jwidth = 1, nwdths
517  k = kk( jwidth )
518  IF( k.GE.m .AND. k.GE.n )
519  $ GO TO 150
520  kl = max( 0, min( m-1, k ) )
521  ku = max( 0, min( n-1, k ) )
522 *
523  IF( nsizes.NE.1 ) THEN
524  mtypes = min( maxtyp, ntypes )
525  ELSE
526  mtypes = min( maxtyp+1, ntypes )
527  END IF
528 *
529  DO 140 jtype = 1, mtypes
530  IF( .NOT.dotype( jtype ) )
531  $ GO TO 140
532  nmats = nmats + 1
533  ntest = 0
534 *
535  DO 30 j = 1, 4
536  ioldsd( j ) = iseed( j )
537  30 CONTINUE
538 *
539 * Compute "A".
540 *
541 * Control parameters:
542 *
543 * KMAGN KMODE KTYPE
544 * =1 O(1) clustered 1 zero
545 * =2 large clustered 2 identity
546 * =3 small exponential (none)
547 * =4 arithmetic diagonal, (w/ singular values)
548 * =5 random log (none)
549 * =6 random nonhermitian, w/ singular values
550 * =7 (none)
551 * =8 (none)
552 * =9 random nonhermitian
553 *
554  IF( mtypes.GT.maxtyp )
555  $ GO TO 90
556 *
557  itype = ktype( jtype )
558  imode = kmode( jtype )
559 *
560 * Compute norm
561 *
562  GO TO ( 40, 50, 60 )kmagn( jtype )
563 *
564  40 CONTINUE
565  anorm = one
566  GO TO 70
567 *
568  50 CONTINUE
569  anorm = ( rtovfl*ulp )*amninv
570  GO TO 70
571 *
572  60 CONTINUE
573  anorm = rtunfl*max( m, n )*ulpinv
574  GO TO 70
575 *
576  70 CONTINUE
577 *
578  CALL claset( 'Full', lda, n, czero, czero, a, lda )
579  CALL claset( 'Full', ldab, n, czero, czero, ab, ldab )
580  iinfo = 0
581  cond = ulpinv
582 *
583 * Special Matrices -- Identity & Jordan block
584 *
585 * Zero
586 *
587  IF( itype.EQ.1 ) THEN
588  iinfo = 0
589 *
590  ELSE IF( itype.EQ.2 ) THEN
591 *
592 * Identity
593 *
594  DO 80 jcol = 1, n
595  a( jcol, jcol ) = anorm
596  80 CONTINUE
597 *
598  ELSE IF( itype.EQ.4 ) THEN
599 *
600 * Diagonal Matrix, singular values specified
601 *
602  CALL clatms( m, n, 'S', iseed, 'N', rwork, imode,
603  $ cond, anorm, 0, 0, 'N', a, lda, work,
604  $ iinfo )
605 *
606  ELSE IF( itype.EQ.6 ) THEN
607 *
608 * Nonhermitian, singular values specified
609 *
610  CALL clatms( m, n, 'S', iseed, 'N', rwork, imode,
611  $ cond, anorm, kl, ku, 'N', a, lda, work,
612  $ iinfo )
613 *
614  ELSE IF( itype.EQ.9 ) THEN
615 *
616 * Nonhermitian, random entries
617 *
618  CALL clatmr( m, n, 'S', iseed, 'N', work, 6, one,
619  $ cone, 'T', 'N', work( n+1 ), 1, one,
620  $ work( 2*n+1 ), 1, one, 'N', idumma, kl,
621  $ ku, zero, anorm, 'N', a, lda, idumma,
622  $ iinfo )
623 *
624  ELSE
625 *
626  iinfo = 1
627  END IF
628 *
629 * Generate Right-Hand Side
630 *
631  CALL clatmr( m, nrhs, 'S', iseed, 'N', work, 6, one,
632  $ cone, 'T', 'N', work( m+1 ), 1, one,
633  $ work( 2*m+1 ), 1, one, 'N', idumma, m, nrhs,
634  $ zero, one, 'NO', c, ldc, idumma, iinfo )
635 *
636  IF( iinfo.NE.0 ) THEN
637  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n,
638  $ jtype, ioldsd
639  info = abs( iinfo )
640  RETURN
641  END IF
642 *
643  90 CONTINUE
644 *
645 * Copy A to band storage.
646 *
647  DO 110 j = 1, n
648  DO 100 i = max( 1, j-ku ), min( m, j+kl )
649  ab( ku+1+i-j, j ) = a( i, j )
650  100 CONTINUE
651  110 CONTINUE
652 *
653 * Copy C
654 *
655  CALL clacpy( 'Full', m, nrhs, c, ldc, cc, ldc )
656 *
657 * Call CGBBRD to compute B, Q and P, and to update C.
658 *
659  CALL cgbbrd( 'B', m, n, nrhs, kl, ku, ab, ldab, bd, be,
660  $ q, ldq, p, ldp, cc, ldc, work, rwork,
661  $ iinfo )
662 *
663  IF( iinfo.NE.0 ) THEN
664  WRITE( nounit, fmt = 9999 )'CGBBRD', iinfo, n, jtype,
665  $ ioldsd
666  info = abs( iinfo )
667  IF( iinfo.LT.0 ) THEN
668  RETURN
669  ELSE
670  result( 1 ) = ulpinv
671  GO TO 120
672  END IF
673  END IF
674 *
675 * Test 1: Check the decomposition A := Q * B * P'
676 * 2: Check the orthogonality of Q
677 * 3: Check the orthogonality of P
678 * 4: Check the computation of Q' * C
679 *
680  CALL cbdt01( m, n, -1, a, lda, q, ldq, bd, be, p, ldp,
681  $ work, rwork, result( 1 ) )
682  CALL cunt01( 'Columns', m, m, q, ldq, work, lwork, rwork,
683  $ result( 2 ) )
684  CALL cunt01( 'Rows', n, n, p, ldp, work, lwork, rwork,
685  $ result( 3 ) )
686  CALL cbdt02( m, nrhs, c, ldc, cc, ldc, q, ldq, work,
687  $ rwork, result( 4 ) )
688 *
689 * End of Loop -- Check for RESULT(j) > THRESH
690 *
691  ntest = 4
692  120 CONTINUE
693  ntestt = ntestt + ntest
694 *
695 * Print out tests which fail.
696 *
697  DO 130 jr = 1, ntest
698  IF( result( jr ).GE.thresh ) THEN
699  IF( nerrs.EQ.0 )
700  $ CALL slahd2( nounit, 'CBB' )
701  nerrs = nerrs + 1
702  WRITE( nounit, fmt = 9998 )m, n, k, ioldsd, jtype,
703  $ jr, result( jr )
704  END IF
705  130 CONTINUE
706 *
707  140 CONTINUE
708  150 CONTINUE
709  160 CONTINUE
710 *
711 * Summary
712 *
713  CALL slasum( 'CBB', nounit, nerrs, ntestt )
714  RETURN
715 *
716  9999 FORMAT( ' CCHKBB: ', a, ' returned INFO=', i5, '.', / 9x, 'M=',
717  $ i5, ' N=', i5, ' K=', i5, ', JTYPE=', i5, ', ISEED=(',
718  $ 3( i5, ',' ), i5, ')' )
719  9998 FORMAT( ' M =', i4, ' N=', i4, ', K=', i3, ', seed=',
720  $ 4( i4, ',' ), ' type ', i2, ', test(', i2, ')=', g10.3 )
721 *
722 * End of CCHKBB
723 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
CBDT02
Definition: cbdt02.f:121
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cgbbrd(VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, LDQ, PT, LDPT, C, LDC, WORK, RWORK, INFO)
CGBBRD
Definition: cgbbrd.f:195
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine slahd2(IOUNIT, PATH)
SLAHD2
Definition: slahd2.f:67
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
Definition: cunt01.f:128
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
CBDT01
Definition: cbdt01.f:148

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkbd ( integer  NSIZES,
integer, dimension( * )  MVAL,
integer, dimension( * )  NVAL,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer  NRHS,
integer, dimension( 4 )  ISEED,
real  THRESH,
complex, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  BD,
real, dimension( * )  BE,
real, dimension( * )  S1,
real, dimension( * )  S2,
complex, dimension( ldx, * )  X,
integer  LDX,
complex, dimension( ldx, * )  Y,
complex, dimension( ldx, * )  Z,
complex, dimension( ldq, * )  Q,
integer  LDQ,
complex, dimension( ldpt, * )  PT,
integer  LDPT,
complex, dimension( ldpt, * )  U,
complex, dimension( ldpt, * )  VT,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
integer  NOUT,
integer  INFO 
)

CCHKBD

Purpose:
 CCHKBD checks the singular value decomposition (SVD) routines.

 CGEBRD reduces a complex general m by n matrix A to real upper or
 lower bidiagonal form by an orthogonal transformation: Q' * A * P = B
 (or A = Q * B * P').  The matrix B is upper bidiagonal if m >= n
 and lower bidiagonal if m < n.

 CUNGBR generates the orthogonal matrices Q and P' from CGEBRD.
 Note that Q and P are not necessarily square.

 CBDSQR computes the singular value decomposition of the bidiagonal
 matrix B as B = U S V'.  It is called three times to compute
    1)  B = U S1 V', where S1 is the diagonal matrix of singular
        values and the columns of the matrices U and V are the left
        and right singular vectors, respectively, of B.
    2)  Same as 1), but the singular values are stored in S2 and the
        singular vectors are not computed.
    3)  A = (UQ) S (P'V'), the SVD of the original matrix A.
 In addition, CBDSQR has an option to apply the left orthogonal matrix
 U to a matrix X, useful in least squares applications.

 For each pair of matrix dimensions (M,N) and each selected matrix
 type, an M by N matrix A and an M by NRHS matrix X are generated.
 The problem dimensions are as follows
    A:          M x N
    Q:          M x min(M,N) (but M x M if NRHS > 0)
    P:          min(M,N) x N
    B:          min(M,N) x min(M,N)
    U, V:       min(M,N) x min(M,N)
    S1, S2      diagonal, order min(M,N)
    X:          M x NRHS

 For each generated matrix, 14 tests are performed:

 Test CGEBRD and CUNGBR

 (1)   | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P'

 (2)   | I - Q' Q | / ( M ulp )

 (3)   | I - PT PT' | / ( N ulp )

 Test CBDSQR on bidiagonal matrix B

 (4)   | B - U S1 VT | / ( |B| min(M,N) ulp ), VT = V'

 (5)   | Y - U Z | / ( |Y| max(min(M,N),k) ulp ), where Y = Q' X
                                                  and   Z = U' Y.
 (6)   | I - U' U | / ( min(M,N) ulp )

 (7)   | I - VT VT' | / ( min(M,N) ulp )

 (8)   S1 contains min(M,N) nonnegative values in decreasing order.
       (Return 0 if true, 1/ULP if false.)

 (9)   0 if the true singular values of B are within THRESH of
       those in S1.  2*THRESH if they are not.  (Tested using
       SSVDCH)

 (10)  | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                   computing U and V.

 Test CBDSQR on matrix A

 (11)  | A - (QU) S (VT PT) | / ( |A| max(M,N) ulp )

 (12)  | X - (QU) Z | / ( |X| max(M,k) ulp )

 (13)  | I - (QU)'(QU) | / ( M ulp )

 (14)  | I - (VT PT) (PT'VT') | / ( N ulp )

 The possible matrix types are

 (1)  The zero matrix.
 (2)  The identity matrix.

 (3)  A diagonal matrix with evenly spaced entries
      1, ..., ULP  and random signs.
      (ULP = (first number larger than 1) - 1 )
 (4)  A diagonal matrix with geometrically spaced entries
      1, ..., ULP  and random signs.
 (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
      and random signs.

 (6)  Same as (3), but multiplied by SQRT( overflow threshold )
 (7)  Same as (3), but multiplied by SQRT( underflow threshold )

 (8)  A matrix of the form  U D V, where U and V are orthogonal and
      D has evenly spaced entries 1, ..., ULP with random signs
      on the diagonal.

 (9)  A matrix of the form  U D V, where U and V are orthogonal and
      D has geometrically spaced entries 1, ..., ULP with random
      signs on the diagonal.

 (10) A matrix of the form  U D V, where U and V are orthogonal and
      D has "clustered" entries 1, ULP,..., ULP with random
      signs on the diagonal.

 (11) Same as (8), but multiplied by SQRT( overflow threshold )
 (12) Same as (8), but multiplied by SQRT( underflow threshold )

 (13) Rectangular matrix with random entries chosen from (-1,1).
 (14) Same as (13), but multiplied by SQRT( overflow threshold )
 (15) Same as (13), but multiplied by SQRT( underflow threshold )

 Special case:
 (16) A bidiagonal matrix with random entries chosen from a
      logarithmic distribution on [ulp^2,ulp^(-2)]  (I.e., each
      entry is  e^x, where x is chosen uniformly on
      [ 2 log(ulp), -2 log(ulp) ] .)  For *this* type:
      (a) CGEBRD is not called to reduce it to bidiagonal form.
      (b) the bidiagonal is  min(M,N) x min(M,N); if M<N, the
          matrix will be lower bidiagonal, otherwise upper.
      (c) only tests 5--8 and 14 are performed.

 A subset of the full set of matrix types may be selected through
 the logical array DOTYPE.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of values of M and N contained in the vectors
          MVAL and NVAL.  The matrix sizes are used in pairs (M,N).
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NVAL
          NVAL is INTEGER array, dimension (NM)
          The values of the matrix column dimension N.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, CCHKBD
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrices are in A and B.
          This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
          of type j will be generated.  If NTYPES is smaller than the
          maximum number of types defined (PARAMETER MAXTYP), then
          types NTYPES+1 through MAXTYP will not be generated.  If
          NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
          DOTYPE(NTYPES) will be ignored.
[in]NRHS
          NRHS is INTEGER
          The number of columns in the "right-hand side" matrices X, Y,
          and Z, used in testing CBDSQR.  If NRHS = 0, then the
          operations on the right-hand side will not be tested.
          NRHS must be at least 0.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator. The array elements should be between 0 and 4095;
          if not they will be reduced mod 4096.  Also, ISEED(4) must
          be odd.  The values of ISEED are changed on exit, and can be
          used in the next call to CCHKBD to continue the same random
          number sequence.
[in]THRESH
          THRESH is REAL
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.  Note that the
          expected value of the test ratios is O(1), so THRESH should
          be a reasonably small multiple of 1, e.g., 10 or 100.
[out]A
          A is COMPLEX array, dimension (LDA,NMAX)
          where NMAX is the maximum value of N in NVAL.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,MMAX),
          where MMAX is the maximum value of M in MVAL.
[out]BD
          BD is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]BE
          BE is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S1
          S1 is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S2
          S2 is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]X
          X is COMPLEX array, dimension (LDX,NRHS)
[in]LDX
          LDX is INTEGER
          The leading dimension of the arrays X, Y, and Z.
          LDX >= max(1,MMAX).
[out]Y
          Y is COMPLEX array, dimension (LDX,NRHS)
[out]Z
          Z is COMPLEX array, dimension (LDX,NRHS)
[out]Q
          Q is COMPLEX array, dimension (LDQ,MMAX)
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.  LDQ >= max(1,MMAX).
[out]PT
          PT is COMPLEX array, dimension (LDPT,NMAX)
[in]LDPT
          LDPT is INTEGER
          The leading dimension of the arrays PT, U, and V.
          LDPT >= max(1, max(min(MVAL(j),NVAL(j)))).
[out]U
          U is COMPLEX array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]VT
          VT is COMPLEX array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          3(M+N) and  M(M + max(M,N,k) + 1) + N*min(M,N)  for all
          pairs  (M,N)=(MM(j),NN(j))
[out]RWORK
          RWORK is REAL array, dimension
                      (5*max(min(M,N)))
[in]NOUT
          NOUT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.
           -1: NSIZES < 0
           -2: Some MM(j) < 0
           -3: Some NN(j) < 0
           -4: NTYPES < 0
           -6: NRHS  < 0
           -8: THRESH < 0
          -11: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
          -17: LDB < 1 or LDB < MMAX.
          -21: LDQ < 1 or LDQ < MMAX.
          -23: LDP < 1 or LDP < MNMAX.
          -27: LWORK too small.
          If  CLATMR, CLATMS, CGEBRD, CUNGBR, or CBDSQR,
              returns an error code, the
              absolute value of it is returned.

-----------------------------------------------------------------------

     Some Local Variables and Parameters:
     ---- ----- --------- --- ----------

     ZERO, ONE       Real 0 and 1.
     MAXTYP          The number of types defined.
     NTEST           The number of tests performed, or which can
                     be performed so far, for the current matrix.
     MMAX            Largest value in NN.
     NMAX            Largest value in NN.
     MNMIN           min(MM(j), NN(j)) (the dimension of the bidiagonal
                     matrix.)
     MNMAX           The maximum value of MNMIN for j=1,...,NSIZES.
     NFAIL           The number of tests which have exceeded THRESH
     COND, IMODE     Values to be passed to the matrix generators.
     ANORM           Norm of A; passed to matrix generators.

     OVFL, UNFL      Overflow and underflow thresholds.
     RTOVFL, RTUNFL  Square roots of the previous 2 values.
     ULP, ULPINV     Finest relative precision and its inverse.

             The following four arrays decode JTYPE:
     KTYPE(j)        The general type (1-10) for type "j".
     KMODE(j)        The MODE value to be passed to the matrix
                     generator for type "j".
     KMAGN(j)        The order of magnitude ( O(1),
                     O(overflow^(1/2) ), O(underflow^(1/2) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 417 of file cchkbd.f.

417 *
418 * -- LAPACK test routine (version 3.4.0) --
419 * -- LAPACK is a software package provided by Univ. of Tennessee, --
420 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
421 * November 2011
422 *
423 * .. Scalar Arguments ..
424  INTEGER info, lda, ldpt, ldq, ldx, lwork, nout, nrhs,
425  $ nsizes, ntypes
426  REAL thresh
427 * ..
428 * .. Array Arguments ..
429  LOGICAL dotype( * )
430  INTEGER iseed( 4 ), mval( * ), nval( * )
431  REAL bd( * ), be( * ), rwork( * ), s1( * ), s2( * )
432  COMPLEX a( lda, * ), pt( ldpt, * ), q( ldq, * ),
433  $ u( ldpt, * ), vt( ldpt, * ), work( * ),
434  $ x( ldx, * ), y( ldx, * ), z( ldx, * )
435 * ..
436 *
437 * ======================================================================
438 *
439 * .. Parameters ..
440  REAL zero, one, two, half
441  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
442  $ half = 0.5e0 )
443  COMPLEX czero, cone
444  parameter( czero = ( 0.0e+0, 0.0e+0 ),
445  $ cone = ( 1.0e+0, 0.0e+0 ) )
446  INTEGER maxtyp
447  parameter( maxtyp = 16 )
448 * ..
449 * .. Local Scalars ..
450  LOGICAL badmm, badnn, bidiag
451  CHARACTER uplo
452  CHARACTER*3 path
453  INTEGER i, iinfo, imode, itype, j, jcol, jsize, jtype,
454  $ log2ui, m, minwrk, mmax, mnmax, mnmin, mq,
455  $ mtypes, n, nfail, nmax, ntest
456  REAL amninv, anorm, cond, ovfl, rtovfl, rtunfl,
457  $ temp1, temp2, ulp, ulpinv, unfl
458 * ..
459 * .. Local Arrays ..
460  INTEGER ioldsd( 4 ), iwork( 1 ), kmagn( maxtyp ),
461  $ kmode( maxtyp ), ktype( maxtyp )
462  REAL dumma( 1 ), result( 14 )
463 * ..
464 * .. External Functions ..
465  REAL slamch, slarnd
466  EXTERNAL slamch, slarnd
467 * ..
468 * .. External Subroutines ..
469  EXTERNAL alasum, cbdsqr, cbdt01, cbdt02, cbdt03, cgebrd,
472 * ..
473 * .. Intrinsic Functions ..
474  INTRINSIC abs, exp, int, log, max, min, sqrt
475 * ..
476 * .. Scalars in Common ..
477  LOGICAL lerr, ok
478  CHARACTER*32 srnamt
479  INTEGER infot, nunit
480 * ..
481 * .. Common blocks ..
482  COMMON / infoc / infot, nunit, ok, lerr
483  COMMON / srnamc / srnamt
484 * ..
485 * .. Data statements ..
486  DATA ktype / 1, 2, 5*4, 5*6, 3*9, 10 /
487  DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 /
488  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
489  $ 0, 0, 0 /
490 * ..
491 * .. Executable Statements ..
492 *
493 * Check for errors
494 *
495  info = 0
496 *
497  badmm = .false.
498  badnn = .false.
499  mmax = 1
500  nmax = 1
501  mnmax = 1
502  minwrk = 1
503  DO 10 j = 1, nsizes
504  mmax = max( mmax, mval( j ) )
505  IF( mval( j ).LT.0 )
506  $ badmm = .true.
507  nmax = max( nmax, nval( j ) )
508  IF( nval( j ).LT.0 )
509  $ badnn = .true.
510  mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
511  minwrk = max( minwrk, 3*( mval( j )+nval( j ) ),
512  $ mval( j )*( mval( j )+max( mval( j ), nval( j ),
513  $ nrhs )+1 )+nval( j )*min( nval( j ), mval( j ) ) )
514  10 CONTINUE
515 *
516 * Check for errors
517 *
518  IF( nsizes.LT.0 ) THEN
519  info = -1
520  ELSE IF( badmm ) THEN
521  info = -2
522  ELSE IF( badnn ) THEN
523  info = -3
524  ELSE IF( ntypes.LT.0 ) THEN
525  info = -4
526  ELSE IF( nrhs.LT.0 ) THEN
527  info = -6
528  ELSE IF( lda.LT.mmax ) THEN
529  info = -11
530  ELSE IF( ldx.LT.mmax ) THEN
531  info = -17
532  ELSE IF( ldq.LT.mmax ) THEN
533  info = -21
534  ELSE IF( ldpt.LT.mnmax ) THEN
535  info = -23
536  ELSE IF( minwrk.GT.lwork ) THEN
537  info = -27
538  END IF
539 *
540  IF( info.NE.0 ) THEN
541  CALL xerbla( 'CCHKBD', -info )
542  RETURN
543  END IF
544 *
545 * Initialize constants
546 *
547  path( 1: 1 ) = 'Complex precision'
548  path( 2: 3 ) = 'BD'
549  nfail = 0
550  ntest = 0
551  unfl = slamch( 'Safe minimum' )
552  ovfl = slamch( 'Overflow' )
553  CALL slabad( unfl, ovfl )
554  ulp = slamch( 'Precision' )
555  ulpinv = one / ulp
556  log2ui = int( log( ulpinv ) / log( two ) )
557  rtunfl = sqrt( unfl )
558  rtovfl = sqrt( ovfl )
559  infot = 0
560 *
561 * Loop over sizes, types
562 *
563  DO 180 jsize = 1, nsizes
564  m = mval( jsize )
565  n = nval( jsize )
566  mnmin = min( m, n )
567  amninv = one / max( m, n, 1 )
568 *
569  IF( nsizes.NE.1 ) THEN
570  mtypes = min( maxtyp, ntypes )
571  ELSE
572  mtypes = min( maxtyp+1, ntypes )
573  END IF
574 *
575  DO 170 jtype = 1, mtypes
576  IF( .NOT.dotype( jtype ) )
577  $ GO TO 170
578 *
579  DO 20 j = 1, 4
580  ioldsd( j ) = iseed( j )
581  20 CONTINUE
582 *
583  DO 30 j = 1, 14
584  result( j ) = -one
585  30 CONTINUE
586 *
587  uplo = ' '
588 *
589 * Compute "A"
590 *
591 * Control parameters:
592 *
593 * KMAGN KMODE KTYPE
594 * =1 O(1) clustered 1 zero
595 * =2 large clustered 2 identity
596 * =3 small exponential (none)
597 * =4 arithmetic diagonal, (w/ eigenvalues)
598 * =5 random symmetric, w/ eigenvalues
599 * =6 nonsymmetric, w/ singular values
600 * =7 random diagonal
601 * =8 random symmetric
602 * =9 random nonsymmetric
603 * =10 random bidiagonal (log. distrib.)
604 *
605  IF( mtypes.GT.maxtyp )
606  $ GO TO 100
607 *
608  itype = ktype( jtype )
609  imode = kmode( jtype )
610 *
611 * Compute norm
612 *
613  GO TO ( 40, 50, 60 )kmagn( jtype )
614 *
615  40 CONTINUE
616  anorm = one
617  GO TO 70
618 *
619  50 CONTINUE
620  anorm = ( rtovfl*ulp )*amninv
621  GO TO 70
622 *
623  60 CONTINUE
624  anorm = rtunfl*max( m, n )*ulpinv
625  GO TO 70
626 *
627  70 CONTINUE
628 *
629  CALL claset( 'Full', lda, n, czero, czero, a, lda )
630  iinfo = 0
631  cond = ulpinv
632 *
633  bidiag = .false.
634  IF( itype.EQ.1 ) THEN
635 *
636 * Zero matrix
637 *
638  iinfo = 0
639 *
640  ELSE IF( itype.EQ.2 ) THEN
641 *
642 * Identity
643 *
644  DO 80 jcol = 1, mnmin
645  a( jcol, jcol ) = anorm
646  80 CONTINUE
647 *
648  ELSE IF( itype.EQ.4 ) THEN
649 *
650 * Diagonal Matrix, [Eigen]values Specified
651 *
652  CALL clatms( mnmin, mnmin, 'S', iseed, 'N', rwork, imode,
653  $ cond, anorm, 0, 0, 'N', a, lda, work,
654  $ iinfo )
655 *
656  ELSE IF( itype.EQ.5 ) THEN
657 *
658 * Symmetric, eigenvalues specified
659 *
660  CALL clatms( mnmin, mnmin, 'S', iseed, 'S', rwork, imode,
661  $ cond, anorm, m, n, 'N', a, lda, work,
662  $ iinfo )
663 *
664  ELSE IF( itype.EQ.6 ) THEN
665 *
666 * Nonsymmetric, singular values specified
667 *
668  CALL clatms( m, n, 'S', iseed, 'N', rwork, imode, cond,
669  $ anorm, m, n, 'N', a, lda, work, iinfo )
670 *
671  ELSE IF( itype.EQ.7 ) THEN
672 *
673 * Diagonal, random entries
674 *
675  CALL clatmr( mnmin, mnmin, 'S', iseed, 'N', work, 6, one,
676  $ cone, 'T', 'N', work( mnmin+1 ), 1, one,
677  $ work( 2*mnmin+1 ), 1, one, 'N', iwork, 0, 0,
678  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
679 *
680  ELSE IF( itype.EQ.8 ) THEN
681 *
682 * Symmetric, random entries
683 *
684  CALL clatmr( mnmin, mnmin, 'S', iseed, 'S', work, 6, one,
685  $ cone, 'T', 'N', work( mnmin+1 ), 1, one,
686  $ work( m+mnmin+1 ), 1, one, 'N', iwork, m, n,
687  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
688 *
689  ELSE IF( itype.EQ.9 ) THEN
690 *
691 * Nonsymmetric, random entries
692 *
693  CALL clatmr( m, n, 'S', iseed, 'N', work, 6, one, cone,
694  $ 'T', 'N', work( mnmin+1 ), 1, one,
695  $ work( m+mnmin+1 ), 1, one, 'N', iwork, m, n,
696  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
697 *
698  ELSE IF( itype.EQ.10 ) THEN
699 *
700 * Bidiagonal, random entries
701 *
702  temp1 = -two*log( ulp )
703  DO 90 j = 1, mnmin
704  bd( j ) = exp( temp1*slarnd( 2, iseed ) )
705  IF( j.LT.mnmin )
706  $ be( j ) = exp( temp1*slarnd( 2, iseed ) )
707  90 CONTINUE
708 *
709  iinfo = 0
710  bidiag = .true.
711  IF( m.GE.n ) THEN
712  uplo = 'U'
713  ELSE
714  uplo = 'L'
715  END IF
716  ELSE
717  iinfo = 1
718  END IF
719 *
720  IF( iinfo.EQ.0 ) THEN
721 *
722 * Generate Right-Hand Side
723 *
724  IF( bidiag ) THEN
725  CALL clatmr( mnmin, nrhs, 'S', iseed, 'N', work, 6,
726  $ one, cone, 'T', 'N', work( mnmin+1 ), 1,
727  $ one, work( 2*mnmin+1 ), 1, one, 'N',
728  $ iwork, mnmin, nrhs, zero, one, 'NO', y,
729  $ ldx, iwork, iinfo )
730  ELSE
731  CALL clatmr( m, nrhs, 'S', iseed, 'N', work, 6, one,
732  $ cone, 'T', 'N', work( m+1 ), 1, one,
733  $ work( 2*m+1 ), 1, one, 'N', iwork, m,
734  $ nrhs, zero, one, 'NO', x, ldx, iwork,
735  $ iinfo )
736  END IF
737  END IF
738 *
739 * Error Exit
740 *
741  IF( iinfo.NE.0 ) THEN
742  WRITE( nout, fmt = 9998 )'Generator', iinfo, m, n,
743  $ jtype, ioldsd
744  info = abs( iinfo )
745  RETURN
746  END IF
747 *
748  100 CONTINUE
749 *
750 * Call CGEBRD and CUNGBR to compute B, Q, and P, do tests.
751 *
752  IF( .NOT.bidiag ) THEN
753 *
754 * Compute transformations to reduce A to bidiagonal form:
755 * B := Q' * A * P.
756 *
757  CALL clacpy( ' ', m, n, a, lda, q, ldq )
758  CALL cgebrd( m, n, q, ldq, bd, be, work, work( mnmin+1 ),
759  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
760 *
761 * Check error code from CGEBRD.
762 *
763  IF( iinfo.NE.0 ) THEN
764  WRITE( nout, fmt = 9998 )'CGEBRD', iinfo, m, n,
765  $ jtype, ioldsd
766  info = abs( iinfo )
767  RETURN
768  END IF
769 *
770  CALL clacpy( ' ', m, n, q, ldq, pt, ldpt )
771  IF( m.GE.n ) THEN
772  uplo = 'U'
773  ELSE
774  uplo = 'L'
775  END IF
776 *
777 * Generate Q
778 *
779  mq = m
780  IF( nrhs.LE.0 )
781  $ mq = mnmin
782  CALL cungbr( 'Q', m, mq, n, q, ldq, work,
783  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
784 *
785 * Check error code from CUNGBR.
786 *
787  IF( iinfo.NE.0 ) THEN
788  WRITE( nout, fmt = 9998 )'CUNGBR(Q)', iinfo, m, n,
789  $ jtype, ioldsd
790  info = abs( iinfo )
791  RETURN
792  END IF
793 *
794 * Generate P'
795 *
796  CALL cungbr( 'P', mnmin, n, m, pt, ldpt, work( mnmin+1 ),
797  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
798 *
799 * Check error code from CUNGBR.
800 *
801  IF( iinfo.NE.0 ) THEN
802  WRITE( nout, fmt = 9998 )'CUNGBR(P)', iinfo, m, n,
803  $ jtype, ioldsd
804  info = abs( iinfo )
805  RETURN
806  END IF
807 *
808 * Apply Q' to an M by NRHS matrix X: Y := Q' * X.
809 *
810  CALL cgemm( 'Conjugate transpose', 'No transpose', m,
811  $ nrhs, m, cone, q, ldq, x, ldx, czero, y,
812  $ ldx )
813 *
814 * Test 1: Check the decomposition A := Q * B * PT
815 * 2: Check the orthogonality of Q
816 * 3: Check the orthogonality of PT
817 *
818  CALL cbdt01( m, n, 1, a, lda, q, ldq, bd, be, pt, ldpt,
819  $ work, rwork, result( 1 ) )
820  CALL cunt01( 'Columns', m, mq, q, ldq, work, lwork,
821  $ rwork, result( 2 ) )
822  CALL cunt01( 'Rows', mnmin, n, pt, ldpt, work, lwork,
823  $ rwork, result( 3 ) )
824  END IF
825 *
826 * Use CBDSQR to form the SVD of the bidiagonal matrix B:
827 * B := U * S1 * VT, and compute Z = U' * Y.
828 *
829  CALL scopy( mnmin, bd, 1, s1, 1 )
830  IF( mnmin.GT.0 )
831  $ CALL scopy( mnmin-1, be, 1, rwork, 1 )
832  CALL clacpy( ' ', m, nrhs, y, ldx, z, ldx )
833  CALL claset( 'Full', mnmin, mnmin, czero, cone, u, ldpt )
834  CALL claset( 'Full', mnmin, mnmin, czero, cone, vt, ldpt )
835 *
836  CALL cbdsqr( uplo, mnmin, mnmin, mnmin, nrhs, s1, rwork, vt,
837  $ ldpt, u, ldpt, z, ldx, rwork( mnmin+1 ),
838  $ iinfo )
839 *
840 * Check error code from CBDSQR.
841 *
842  IF( iinfo.NE.0 ) THEN
843  WRITE( nout, fmt = 9998 )'CBDSQR(vects)', iinfo, m, n,
844  $ jtype, ioldsd
845  info = abs( iinfo )
846  IF( iinfo.LT.0 ) THEN
847  RETURN
848  ELSE
849  result( 4 ) = ulpinv
850  GO TO 150
851  END IF
852  END IF
853 *
854 * Use CBDSQR to compute only the singular values of the
855 * bidiagonal matrix B; U, VT, and Z should not be modified.
856 *
857  CALL scopy( mnmin, bd, 1, s2, 1 )
858  IF( mnmin.GT.0 )
859  $ CALL scopy( mnmin-1, be, 1, rwork, 1 )
860 *
861  CALL cbdsqr( uplo, mnmin, 0, 0, 0, s2, rwork, vt, ldpt, u,
862  $ ldpt, z, ldx, rwork( mnmin+1 ), iinfo )
863 *
864 * Check error code from CBDSQR.
865 *
866  IF( iinfo.NE.0 ) THEN
867  WRITE( nout, fmt = 9998 )'CBDSQR(values)', iinfo, m, n,
868  $ jtype, ioldsd
869  info = abs( iinfo )
870  IF( iinfo.LT.0 ) THEN
871  RETURN
872  ELSE
873  result( 9 ) = ulpinv
874  GO TO 150
875  END IF
876  END IF
877 *
878 * Test 4: Check the decomposition B := U * S1 * VT
879 * 5: Check the computation Z := U' * Y
880 * 6: Check the orthogonality of U
881 * 7: Check the orthogonality of VT
882 *
883  CALL cbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
884  $ work, result( 4 ) )
885  CALL cbdt02( mnmin, nrhs, y, ldx, z, ldx, u, ldpt, work,
886  $ rwork, result( 5 ) )
887  CALL cunt01( 'Columns', mnmin, mnmin, u, ldpt, work, lwork,
888  $ rwork, result( 6 ) )
889  CALL cunt01( 'Rows', mnmin, mnmin, vt, ldpt, work, lwork,
890  $ rwork, result( 7 ) )
891 *
892 * Test 8: Check that the singular values are sorted in
893 * non-increasing order and are non-negative
894 *
895  result( 8 ) = zero
896  DO 110 i = 1, mnmin - 1
897  IF( s1( i ).LT.s1( i+1 ) )
898  $ result( 8 ) = ulpinv
899  IF( s1( i ).LT.zero )
900  $ result( 8 ) = ulpinv
901  110 CONTINUE
902  IF( mnmin.GE.1 ) THEN
903  IF( s1( mnmin ).LT.zero )
904  $ result( 8 ) = ulpinv
905  END IF
906 *
907 * Test 9: Compare CBDSQR with and without singular vectors
908 *
909  temp2 = zero
910 *
911  DO 120 j = 1, mnmin
912  temp1 = abs( s1( j )-s2( j ) ) /
913  $ max( sqrt( unfl )*max( s1( 1 ), one ),
914  $ ulp*max( abs( s1( j ) ), abs( s2( j ) ) ) )
915  temp2 = max( temp1, temp2 )
916  120 CONTINUE
917 *
918  result( 9 ) = temp2
919 *
920 * Test 10: Sturm sequence test of singular values
921 * Go up by factors of two until it succeeds
922 *
923  temp1 = thresh*( half-ulp )
924 *
925  DO 130 j = 0, log2ui
926  CALL ssvdch( mnmin, bd, be, s1, temp1, iinfo )
927  IF( iinfo.EQ.0 )
928  $ GO TO 140
929  temp1 = temp1*two
930  130 CONTINUE
931 *
932  140 CONTINUE
933  result( 10 ) = temp1
934 *
935 * Use CBDSQR to form the decomposition A := (QU) S (VT PT)
936 * from the bidiagonal form A := Q B PT.
937 *
938  IF( .NOT.bidiag ) THEN
939  CALL scopy( mnmin, bd, 1, s2, 1 )
940  IF( mnmin.GT.0 )
941  $ CALL scopy( mnmin-1, be, 1, rwork, 1 )
942 *
943  CALL cbdsqr( uplo, mnmin, n, m, nrhs, s2, rwork, pt,
944  $ ldpt, q, ldq, y, ldx, rwork( mnmin+1 ),
945  $ iinfo )
946 *
947 * Test 11: Check the decomposition A := Q*U * S2 * VT*PT
948 * 12: Check the computation Z := U' * Q' * X
949 * 13: Check the orthogonality of Q*U
950 * 14: Check the orthogonality of VT*PT
951 *
952  CALL cbdt01( m, n, 0, a, lda, q, ldq, s2, dumma, pt,
953  $ ldpt, work, rwork, result( 11 ) )
954  CALL cbdt02( m, nrhs, x, ldx, y, ldx, q, ldq, work,
955  $ rwork, result( 12 ) )
956  CALL cunt01( 'Columns', m, mq, q, ldq, work, lwork,
957  $ rwork, result( 13 ) )
958  CALL cunt01( 'Rows', mnmin, n, pt, ldpt, work, lwork,
959  $ rwork, result( 14 ) )
960  END IF
961 *
962 * End of Loop -- Check for RESULT(j) > THRESH
963 *
964  150 CONTINUE
965  DO 160 j = 1, 14
966  IF( result( j ).GE.thresh ) THEN
967  IF( nfail.EQ.0 )
968  $ CALL slahd2( nout, path )
969  WRITE( nout, fmt = 9999 )m, n, jtype, ioldsd, j,
970  $ result( j )
971  nfail = nfail + 1
972  END IF
973  160 CONTINUE
974  IF( .NOT.bidiag ) THEN
975  ntest = ntest + 14
976  ELSE
977  ntest = ntest + 5
978  END IF
979 *
980  170 CONTINUE
981  180 CONTINUE
982 *
983 * Summary
984 *
985  CALL alasum( path, nout, nfail, ntest, 0 )
986 *
987  RETURN
988 *
989 * End of CCHKBD
990 *
991  9999 FORMAT( ' M=', i5, ', N=', i5, ', type ', i2, ', seed=',
992  $ 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
993  9998 FORMAT( ' CCHKBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
994  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
995  $ i5, ')' )
996 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
CBDT02
Definition: cbdt02.f:121
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:189
subroutine ssvdch(N, S, E, SVD, TOL, INFO)
SSVDCH
Definition: ssvdch.f:99
subroutine cungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGBR
Definition: cungbr.f:159
subroutine cgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
CGEBRD
Definition: cgebrd.f:208
subroutine cbdt03(UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
CBDT03
Definition: cbdt03.f:137
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine slahd2(IOUNIT, PATH)
SLAHD2
Definition: slahd2.f:67
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
Definition: cunt01.f:128
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
CBDT01
Definition: cbdt01.f:148
subroutine cbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
CBDSQR
Definition: cbdsqr.f:224
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:75

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkbk ( integer  NIN,
integer  NOUT 
)

CCHKBK

Purpose:
 CCHKBK tests CGEBAK, a routine for backward transformation of
 the computed right or left eigenvectors if the orginal matrix
 was preprocessed by balance subroutine CGEBAL.
Parameters
[in]NIN
          NIN is INTEGER
          The logical unit number for input.  NIN > 0.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.  NOUT > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 57 of file cchkbk.f.

57 *
58 * -- LAPACK test routine (version 3.4.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2011
62 *
63 * .. Scalar Arguments ..
64  INTEGER nin, nout
65 * ..
66 *
67 * ======================================================================
68 *
69 * .. Parameters ..
70  INTEGER lde
71  parameter( lde = 20 )
72  REAL zero
73  parameter( zero = 0.0e0 )
74 * ..
75 * .. Local Scalars ..
76  INTEGER i, ihi, ilo, info, j, knt, n, ninfo
77  REAL eps, rmax, safmin, vmax, x
78  COMPLEX cdum
79 * ..
80 * .. Local Arrays ..
81  INTEGER lmax( 2 )
82  REAL scale( lde )
83  COMPLEX e( lde, lde ), ein( lde, lde )
84 * ..
85 * .. External Functions ..
86  REAL slamch
87  EXTERNAL slamch
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL cgebak
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, aimag, max, real
94 * ..
95 * .. Statement Functions ..
96  REAL cabs1
97 * ..
98 * .. Statement Function definitions ..
99  cabs1( cdum ) = abs( REAL( CDUM ) ) + abs( aimag( cdum ) )
100 * ..
101 * .. Executable Statements ..
102 *
103  lmax( 1 ) = 0
104  lmax( 2 ) = 0
105  ninfo = 0
106  knt = 0
107  rmax = zero
108  eps = slamch( 'E' )
109  safmin = slamch( 'S' )
110 *
111  10 CONTINUE
112 *
113  READ( nin, fmt = * )n, ilo, ihi
114  IF( n.EQ.0 )
115  $ GO TO 60
116 *
117  READ( nin, fmt = * )( scale( i ), i = 1, n )
118  DO 20 i = 1, n
119  READ( nin, fmt = * )( e( i, j ), j = 1, n )
120  20 CONTINUE
121 *
122  DO 30 i = 1, n
123  READ( nin, fmt = * )( ein( i, j ), j = 1, n )
124  30 CONTINUE
125 *
126  knt = knt + 1
127  CALL cgebak( 'B', 'R', n, ilo, ihi, scale, n, e, lde, info )
128 *
129  IF( info.NE.0 ) THEN
130  ninfo = ninfo + 1
131  lmax( 1 ) = knt
132  END IF
133 *
134  vmax = zero
135  DO 50 i = 1, n
136  DO 40 j = 1, n
137  x = cabs1( e( i, j )-ein( i, j ) ) / eps
138  IF( cabs1( e( i, j ) ).GT.safmin )
139  $ x = x / cabs1( e( i, j ) )
140  vmax = max( vmax, x )
141  40 CONTINUE
142  50 CONTINUE
143 *
144  IF( vmax.GT.rmax ) THEN
145  lmax( 2 ) = knt
146  rmax = vmax
147  END IF
148 *
149  GO TO 10
150 *
151  60 CONTINUE
152 *
153  WRITE( nout, fmt = 9999 )
154  9999 FORMAT( 1x, '.. test output of CGEBAK .. ' )
155 *
156  WRITE( nout, fmt = 9998 )rmax
157  9998 FORMAT( 1x, 'value of largest test error = ', e12.3 )
158  WRITE( nout, fmt = 9997 )lmax( 1 )
159  9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
160  WRITE( nout, fmt = 9996 )lmax( 2 )
161  9996 FORMAT( 1x, 'example number having largest error = ', i4 )
162  WRITE( nout, fmt = 9995 )ninfo
163  9995 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
164  WRITE( nout, fmt = 9994 )knt
165  9994 FORMAT( 1x, 'total number of examples tested = ', i4 )
166 *
167  RETURN
168 *
169 * End of CCHKBK
170 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
Definition: cgebak.f:133
logical function lde(RI, RJ, LR)
Definition: dblat2.f:2945

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkbl ( integer  NIN,
integer  NOUT 
)

CCHKBL

Purpose:
 CCHKBL tests CGEBAL, a routine for balancing a general complex
 matrix and isolating some of its eigenvalues.
Parameters
[in]NIN
          NIN is INTEGER
          The logical unit number for input.  NIN > 0.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.  NOUT > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 56 of file cchkbl.f.

56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  INTEGER nin, nout
64 * ..
65 *
66 * ======================================================================
67 *
68 * .. Parameters ..
69  INTEGER lda
70  parameter( lda = 20 )
71  REAL zero
72  parameter( zero = 0.0e+0 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
76  $ ninfo
77  REAL anorm, meps, rmax, sfmin, temp, vmax
78  COMPLEX cdum
79 * ..
80 * .. Local Arrays ..
81  INTEGER lmax( 3 )
82  REAL dummy( 1 ), scale( lda ), scalin( lda )
83  COMPLEX a( lda, lda ), ain( lda, lda )
84 * ..
85 * .. External Functions ..
86  REAL clange, slamch
87  EXTERNAL clange, slamch
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL cgebal
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, aimag, max, real
94 * ..
95 * .. Statement Functions ..
96  REAL cabs1
97 * ..
98 * .. Statement Function definitions ..
99  cabs1( cdum ) = abs( REAL( CDUM ) ) + abs( aimag( cdum ) )
100 * ..
101 * .. Executable Statements ..
102 *
103  lmax( 1 ) = 0
104  lmax( 2 ) = 0
105  lmax( 3 ) = 0
106  ninfo = 0
107  knt = 0
108  rmax = zero
109  vmax = zero
110  sfmin = slamch( 'S' )
111  meps = slamch( 'E' )
112 *
113  10 CONTINUE
114 *
115  READ( nin, fmt = * )n
116  IF( n.EQ.0 )
117  $ GO TO 70
118  DO 20 i = 1, n
119  READ( nin, fmt = * )( a( i, j ), j = 1, n )
120  20 CONTINUE
121 *
122  READ( nin, fmt = * )iloin, ihiin
123  DO 30 i = 1, n
124  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
125  30 CONTINUE
126  READ( nin, fmt = * )( scalin( i ), i = 1, n )
127 *
128  anorm = clange( 'M', n, n, a, lda, dummy )
129  knt = knt + 1
130  CALL cgebal( 'B', n, a, lda, ilo, ihi, scale, info )
131 *
132  IF( info.NE.0 ) THEN
133  ninfo = ninfo + 1
134  lmax( 1 ) = knt
135  END IF
136 *
137  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
138  ninfo = ninfo + 1
139  lmax( 2 ) = knt
140  END IF
141 *
142  DO 50 i = 1, n
143  DO 40 j = 1, n
144  temp = max( cabs1( a( i, j ) ), cabs1( ain( i, j ) ) )
145  temp = max( temp, sfmin )
146  vmax = max( vmax, cabs1( a( i, j )-ain( i, j ) ) / temp )
147  40 CONTINUE
148  50 CONTINUE
149 *
150  DO 60 i = 1, n
151  temp = max( scale( i ), scalin( i ) )
152  temp = max( temp, sfmin )
153  vmax = max( vmax, abs( scale( i )-scalin( i ) ) / temp )
154  60 CONTINUE
155 *
156  IF( vmax.GT.rmax ) THEN
157  lmax( 3 ) = knt
158  rmax = vmax
159  END IF
160 *
161  GO TO 10
162 *
163  70 CONTINUE
164 *
165  WRITE( nout, fmt = 9999 )
166  9999 FORMAT( 1x, '.. test output of CGEBAL .. ' )
167 *
168  WRITE( nout, fmt = 9998 )rmax
169  9998 FORMAT( 1x, 'value of largest test error = ', e12.3 )
170  WRITE( nout, fmt = 9997 )lmax( 1 )
171  9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
172  WRITE( nout, fmt = 9996 )lmax( 2 )
173  9996 FORMAT( 1x, 'example number where ILO or IHI wrong = ', i4 )
174  WRITE( nout, fmt = 9995 )lmax( 3 )
175  9995 FORMAT( 1x, 'example number having largest error = ', i4 )
176  WRITE( nout, fmt = 9994 )ninfo
177  9994 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
178  WRITE( nout, fmt = 9993 )knt
179  9993 FORMAT( 1x, 'total number of examples tested = ', i4 )
180 *
181  RETURN
182 *
183 * End of CCHKBL
184 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
Definition: cgebal.f:163
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:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkec ( real  THRESH,
logical  TSTERR,
integer  NIN,
integer  NOUT 
)

CCHKEC

Purpose:
 CCHKEC tests eigen- condition estimation routines
        CTRSYL, CTREXC, CTRSNA, CTRSEN

 In all cases, the routine runs through a fixed set of numerical
 examples, subjects them to various tests, and compares the test
 results to a threshold THRESH. In addition, CTRSNA and CTRSEN are
 tested by reading in precomputed examples from a file (on input unit
 NIN).  Output is written to output unit NOUT.
Parameters
[in]THRESH
          THRESH is REAL
          Threshold for residual tests.  A computed test ratio passes
          the threshold if it is less than THRESH.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NIN
          NIN is INTEGER
          The logical unit number for input.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 77 of file cchkec.f.

77 *
78 * -- LAPACK test routine (version 3.4.0) --
79 * -- LAPACK is a software package provided by Univ. of Tennessee, --
80 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
81 * November 2011
82 *
83 * .. Scalar Arguments ..
84  LOGICAL tsterr
85  INTEGER nin, nout
86  REAL thresh
87 * ..
88 *
89 * =====================================================================
90 *
91 * .. Local Scalars ..
92  LOGICAL ok
93  CHARACTER*3 path
94  INTEGER ktrexc, ktrsen, ktrsna, ktrsyl, ltrexc, ltrsyl,
95  $ ntests, ntrexc, ntrsyl
96  REAL eps, rtrexc, rtrsyl, sfmin
97 * ..
98 * .. Local Arrays ..
99  INTEGER ltrsen( 3 ), ltrsna( 3 ), ntrsen( 3 ),
100  $ ntrsna( 3 )
101  REAL rtrsen( 3 ), rtrsna( 3 )
102 * ..
103 * .. External Subroutines ..
104  EXTERNAL cerrec, cget35, cget36, cget37, cget38
105 * ..
106 * .. External Functions ..
107  REAL slamch
108  EXTERNAL slamch
109 * ..
110 * .. Executable Statements ..
111 *
112  path( 1: 1 ) = 'Complex precision'
113  path( 2: 3 ) = 'EC'
114  eps = slamch( 'P' )
115  sfmin = slamch( 'S' )
116  WRITE( nout, fmt = 9994 )
117  WRITE( nout, fmt = 9993 )eps, sfmin
118  WRITE( nout, fmt = 9992 )thresh
119 *
120 * Test error exits if TSTERR is .TRUE.
121 *
122  IF( tsterr )
123  $ CALL cerrec( path, nout )
124 *
125  ok = .true.
126  CALL cget35( rtrsyl, ltrsyl, ntrsyl, ktrsyl, nin )
127  IF( rtrsyl.GT.thresh ) THEN
128  ok = .false.
129  WRITE( nout, fmt = 9999 )rtrsyl, ltrsyl, ntrsyl, ktrsyl
130  END IF
131 *
132  CALL cget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
133  IF( rtrexc.GT.thresh .OR. ntrexc.GT.0 ) THEN
134  ok = .false.
135  WRITE( nout, fmt = 9998 )rtrexc, ltrexc, ntrexc, ktrexc
136  END IF
137 *
138  CALL cget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
139  IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
140  $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
141  $ THEN
142  ok = .false.
143  WRITE( nout, fmt = 9997 )rtrsna, ltrsna, ntrsna, ktrsna
144  END IF
145 *
146  CALL cget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
147  IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
148  $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
149  $ THEN
150  ok = .false.
151  WRITE( nout, fmt = 9996 )rtrsen, ltrsen, ntrsen, ktrsen
152  END IF
153 *
154  ntests = ktrsyl + ktrexc + ktrsna + ktrsen
155  IF( ok )
156  $ WRITE( nout, fmt = 9995 )path, ntests
157 *
158  9999 FORMAT( ' Error in CTRSYL: RMAX =', e12.3, / ' LMAX = ', i8,
159  $ ' NINFO=', i8, ' KNT=', i8 )
160  9998 FORMAT( ' Error in CTREXC: RMAX =', e12.3, / ' LMAX = ', i8,
161  $ ' NINFO=', i8, ' KNT=', i8 )
162  9997 FORMAT( ' Error in CTRSNA: RMAX =', 3e12.3, / ' LMAX = ',
163  $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
164  9996 FORMAT( ' Error in CTRSEN: RMAX =', 3e12.3, / ' LMAX = ',
165  $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
166  9995 FORMAT( / 1x, 'All tests for ', a3,
167  $ ' routines passed the threshold ( ', i6, ' tests run)' )
168  9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
169  $ ' estimation routines', / ' CTRSYL, CTREXC, CTRSNA, CTRSEN',
170  $ / )
171  9993 FORMAT( ' Relative machine precision (EPS) = ', e16.6,
172  $ / ' Safe minimum (SFMIN) = ', e16.6, / )
173  9992 FORMAT( ' Routines pass computational tests if test ratio is ',
174  $ 'less than', f8.2, / / )
175  RETURN
176 *
177 * End of CCHKEC
178 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cget37(RMAX, LMAX, NINFO, KNT, NIN)
CGET37
Definition: cget37.f:92
subroutine cget35(RMAX, LMAX, NINFO, KNT, NIN)
CGET35
Definition: cget35.f:86
subroutine cerrec(PATH, NUNIT)
CERREC
Definition: cerrec.f:58
subroutine cget38(RMAX, LMAX, NINFO, KNT, NIN)
CGET38
Definition: cget38.f:93
subroutine cget36(RMAX, LMAX, NINFO, KNT, NIN)
CGET36
Definition: cget36.f:87

Here is the call graph for this function:

Here is the caller graph for this function:

program cchkee ( )

CCHKEE

Purpose:
 CCHKEE tests the COMPLEX LAPACK subroutines for the matrix
 eigenvalue problem.  The test paths in this version are

 NEP (Nonsymmetric Eigenvalue Problem):
     Test CGEHRD, CUNGHR, CHSEQR, CTREVC, CHSEIN, and CUNMHR

 SEP (Hermitian Eigenvalue Problem):
     Test CHETRD, CUNGTR, CSTEQR, CSTERF, CSTEIN, CSTEDC,
     and drivers CHEEV(X), CHBEV(X), CHPEV(X),
                 CHEEVD,   CHBEVD,   CHPEVD

 SVD (Singular Value Decomposition):
     Test CGEBRD, CUNGBR, and CBDSQR
     and the drivers CGESVD, CGESDD

 CEV (Nonsymmetric Eigenvalue/eigenvector Driver):
     Test CGEEV

 CES (Nonsymmetric Schur form Driver):
     Test CGEES

 CVX (Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test CGEEVX

 CSX (Nonsymmetric Schur form Expert Driver):
     Test CGEESX

 CGG (Generalized Nonsymmetric Eigenvalue Problem):
     Test CGGHD3, CGGBAL, CGGBAK, CHGEQZ, and CTGEVC

 CGS (Generalized Nonsymmetric Schur form Driver):
     Test CGGES

 CGV (Generalized Nonsymmetric Eigenvalue/eigenvector Driver):
     Test CGGEV

 CGX (Generalized Nonsymmetric Schur form Expert Driver):
     Test CGGESX

 CXV (Generalized Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test CGGEVX

 CSG (Hermitian Generalized Eigenvalue Problem):
     Test CHEGST, CHEGV, CHEGVD, CHEGVX, CHPGST, CHPGV, CHPGVD,
     CHPGVX, CHBGST, CHBGV, CHBGVD, and CHBGVX

 CHB (Hermitian Band Eigenvalue Problem):
     Test CHBTRD

 CBB (Band Singular Value Decomposition):
     Test CGBBRD

 CEC (Eigencondition estimation):
     Test CTRSYL, CTREXC, CTRSNA, and CTRSEN

 CBL (Balancing a general matrix)
     Test CGEBAL

 CBK (Back transformation on a balanced matrix)
     Test CGEBAK

 CGL (Balancing a matrix pair)
     Test CGGBAL

 CGK (Back transformation on a matrix pair)
     Test CGGBAK

 GLM (Generalized Linear Regression Model):
     Tests CGGGLM

 GQR (Generalized QR and RQ factorizations):
     Tests CGGQRF and CGGRQF

 GSV (Generalized Singular Value Decomposition):
     Tests CGGSVD, CGGSVP, CTGSJA, CLAGS2, CLAPLL, and CLAPMT

 CSD (CS decomposition):
     Tests CUNCSD

 LSE (Constrained Linear Least Squares):
     Tests CGGLSE

 Each test path has a different set of inputs, but the data sets for
 the driver routines xEV, xES, xVX, and xSX can be concatenated in a
 single input file.  The first line of input should contain one of the
 3-character path names in columns 1-3.  The number of remaining lines
 depends on what is found on the first line.

 The number of matrix types used in testing is often controllable from
 the input file.  The number of matrix types for each path, and the
 test routine that describes them, is as follows:

 Path name(s)  Types    Test routine

 CHS or NEP      21     CCHKHS
 CST or SEP      21     CCHKST (routines)
                 18     CDRVST (drivers)
 CBD or SVD      16     CCHKBD (routines)
                  5     CDRVBD (drivers)
 CEV             21     CDRVEV
 CES             21     CDRVES
 CVX             21     CDRVVX
 CSX             21     CDRVSX
 CGG             26     CCHKGG (routines)
 CGS             26     CDRGES
 CGX              5     CDRGSX
 CGV             26     CDRGEV
 CXV              2     CDRGVX
 CSG             21     CDRVSG
 CHB             15     CCHKHB
 CBB             15     CCHKBB
 CEC              -     CCHKEC
 CBL              -     CCHKBL
 CBK              -     CCHKBK
 CGL              -     CCHKGL
 CGK              -     CCHKGK
 GLM              8     CCKGLM
 GQR              8     CCKGQR
 GSV              8     CCKGSV
 CSD              3     CCKCSD
 LSE              8     CCKLSE

-----------------------------------------------------------------------

 NEP input file:

 line 2:  NN, INTEGER
          Number of values of N.

 line 3:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix dimension N.

 line 4:  NPARMS, INTEGER
          Number of values of the parameters NB, NBMIN, NX, NS, and
          MAXB.

 line 5:  NBVAL, INTEGER array, dimension (NPARMS)
          The values for the blocksize NB.

 line 6:  NBMIN, INTEGER array, dimension (NPARMS)
          The values for the minimum blocksize NBMIN.

 line 7:  NXVAL, INTEGER array, dimension (NPARMS)
          The values for the crossover point NX.

 line 8:  INMIN, INTEGER array, dimension (NPARMS)
          LAHQR vs TTQRE crossover point, >= 11

 line 9:  INWIN, INTEGER array, dimension (NPARMS)
          recommended deflation window size

 line 10: INIBL, INTEGER array, dimension (NPARMS)
          nibble crossover point

 line 11:  ISHFTS, INTEGER array, dimension (NPARMS)
          number of simultaneous shifts)

 line 12:  IACC22, INTEGER array, dimension (NPARMS)
          select structured matrix multiply: 0, 1 or 2)

 line 13: THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.  To have all of the test
          ratios printed, use THRESH = 0.0 .

 line 14: NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 14 was 2:

 line 15: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 15-EOF:  The remaining lines occur in sets of 1 or 2 and allow
          the user to specify the matrix types.  Each line contains
          a 3-character path name in columns 1-3, and the number
          of matrix types must be the first nonblank item in columns
          4-80.  If the number of matrix types is at least 1 but is
          less than the maximum number of possible types, a second
          line will be read to get the numbers of the matrix types to
          be used.  For example,
 NEP 21
          requests all of the matrix types for the nonsymmetric
          eigenvalue problem, while
 NEP  4
 9 10 11 12
          requests only matrices of type 9, 10, 11, and 12.

          The valid 3-character path names are 'NEP' or 'CHS' for the
          nonsymmetric eigenvalue routines.

-----------------------------------------------------------------------

 SEP or CSG input file:

 line 2:  NN, INTEGER
          Number of values of N.

 line 3:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix dimension N.

 line 4:  NPARMS, INTEGER
          Number of values of the parameters NB, NBMIN, and NX.

 line 5:  NBVAL, INTEGER array, dimension (NPARMS)
          The values for the blocksize NB.

 line 6:  NBMIN, INTEGER array, dimension (NPARMS)
          The values for the minimum blocksize NBMIN.

 line 7:  NXVAL, INTEGER array, dimension (NPARMS)
          The values for the crossover point NX.

 line 8:  THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 9:  TSTCHK, LOGICAL
          Flag indicating whether or not to test the LAPACK routines.

 line 10: TSTDRV, LOGICAL
          Flag indicating whether or not to test the driver routines.

 line 11: TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 12: NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 12 was 2:

 line 13: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 13-EOF:  Lines specifying matrix types, as for NEP.
          The valid 3-character path names are 'SEP' or 'CST' for the
          Hermitian eigenvalue routines and driver routines, and
          'CSG' for the routines for the Hermitian generalized
          eigenvalue problem.

-----------------------------------------------------------------------

 SVD input file:

 line 2:  NN, INTEGER
          Number of values of M and N.

 line 3:  MVAL, INTEGER array, dimension (NN)
          The values for the matrix row dimension M.

 line 4:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix column dimension N.

 line 5:  NPARMS, INTEGER
          Number of values of the parameter NB, NBMIN, NX, and NRHS.

 line 6:  NBVAL, INTEGER array, dimension (NPARMS)
          The values for the blocksize NB.

 line 7:  NBMIN, INTEGER array, dimension (NPARMS)
          The values for the minimum blocksize NBMIN.

 line 8:  NXVAL, INTEGER array, dimension (NPARMS)
          The values for the crossover point NX.

 line 9:  NSVAL, INTEGER array, dimension (NPARMS)
          The values for the number of right hand sides NRHS.

 line 10: THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 11: TSTCHK, LOGICAL
          Flag indicating whether or not to test the LAPACK routines.

 line 12: TSTDRV, LOGICAL
          Flag indicating whether or not to test the driver routines.

 line 13: TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 14: NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 14 was 2:

 line 15: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 15-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path names are 'SVD' or 'CBD' for both the
          SVD routines and the SVD driver routines.

-----------------------------------------------------------------------

 CEV and CES data files:

 line 1:  'CEV' or 'CES' in columns 1 to 3.

 line 2:  NSIZES, INTEGER
          Number of sizes of matrices to use. Should be at least 0
          and at most 20. If NSIZES = 0, no testing is done
          (although the remaining  3 lines are still read).

 line 3:  NN, INTEGER array, dimension(NSIZES)
          Dimensions of matrices to be tested.

 line 4:  NB, NBMIN, NX, NS, NBCOL, INTEGERs
          These integer parameters determine how blocking is done
          (see ILAENV for details)
          NB     : block size
          NBMIN  : minimum block size
          NX     : minimum dimension for blocking
          NS     : number of shifts in xHSEQR
          NBCOL  : minimum column dimension for blocking

 line 5:  THRESH, REAL
          The test threshold against which computed residuals are
          compared. Should generally be in the range from 10. to 20.
          If it is 0., all test case data will be printed.

 line 6:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 6 was 2:

 line 7:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 8 and following:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'CEV' to test CGEEV, or
          'CES' to test CGEES.

-----------------------------------------------------------------------

 The CVX data has two parts. The first part is identical to CEV,
 and the second part consists of test matrices with precomputed
 solutions.

 line 1:  'CVX' in columns 1-3.

 line 2:  NSIZES, INTEGER
          If NSIZES = 0, no testing of randomly generated examples
          is done, but any precomputed examples are tested.

 line 3:  NN, INTEGER array, dimension(NSIZES)

 line 4:  NB, NBMIN, NX, NS, NBCOL, INTEGERs

 line 5:  THRESH, REAL

 line 6:  NEWSD, INTEGER

 If line 6 was 2:

 line 7:  INTEGER array, dimension (4)

 lines 8 and following: The first line contains 'CVX' in columns 1-3
          followed by the number of matrix types, possibly with
          a second line to specify certain matrix types.
          If the number of matrix types = 0, no testing of randomly
          generated examples is done, but any precomputed examples
          are tested.

 remaining lines : Each matrix is stored on 1+N+N**2 lines, where N is
          its dimension. The first line contains the dimension N and
          ISRT (two integers). ISRT indicates whether the last N lines
          are sorted by increasing real part of the eigenvalue
          (ISRT=0) or by increasing imaginary part (ISRT=1). The next
          N**2 lines contain the matrix rowwise, one entry per line.
          The last N lines correspond to each eigenvalue. Each of
          these last N lines contains 4 real values: the real part of
          the eigenvalues, the imaginary part of the eigenvalue, the
          reciprocal condition number of the eigenvalues, and the
          reciprocal condition number of the vector eigenvector. The
          end of data is indicated by dimension N=0. Even if no data
          is to be tested, there must be at least one line containing
          N=0.

-----------------------------------------------------------------------

 The CSX data is like CVX. The first part is identical to CEV, and the
 second part consists of test matrices with precomputed solutions.

 line 1:  'CSX' in columns 1-3.

 line 2:  NSIZES, INTEGER
          If NSIZES = 0, no testing of randomly generated examples
          is done, but any precomputed examples are tested.

 line 3:  NN, INTEGER array, dimension(NSIZES)

 line 4:  NB, NBMIN, NX, NS, NBCOL, INTEGERs

 line 5:  THRESH, REAL

 line 6:  NEWSD, INTEGER

 If line 6 was 2:

 line 7:  INTEGER array, dimension (4)

 lines 8 and following: The first line contains 'CSX' in columns 1-3
          followed by the number of matrix types, possibly with
          a second line to specify certain matrix types.
          If the number of matrix types = 0, no testing of randomly
          generated examples is done, but any precomputed examples
          are tested.

 remaining lines : Each matrix is stored on 3+N**2 lines, where N is
          its dimension. The first line contains the dimension N, the
          dimension M of an invariant subspace, and ISRT. The second
          line contains M integers, identifying the eigenvalues in the
          invariant subspace (by their position in a list of
          eigenvalues ordered by increasing real part (if ISRT=0) or
          by increasing imaginary part (if ISRT=1)). The next N**2
          lines contain the matrix rowwise. The last line contains the
          reciprocal condition number for the average of the selected
          eigenvalues, and the reciprocal condition number for the
          corresponding right invariant subspace. The end of data in
          indicated by a line containing N=0, M=0, and ISRT = 0.  Even
          if no data is to be tested, there must be at least one line
          containing N=0, M=0 and ISRT=0.

-----------------------------------------------------------------------

 CGG input file:

 line 2:  NN, INTEGER
          Number of values of N.

 line 3:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix dimension N.

 line 4:  NPARMS, INTEGER
          Number of values of the parameters NB, NBMIN, NBCOL, NS, and
          MAXB.

 line 5:  NBVAL, INTEGER array, dimension (NPARMS)
          The values for the blocksize NB.

 line 6:  NBMIN, INTEGER array, dimension (NPARMS)
          The values for NBMIN, the minimum row dimension for blocks.

 line 7:  NSVAL, INTEGER array, dimension (NPARMS)
          The values for the number of shifts.

 line 8:  MXBVAL, INTEGER array, dimension (NPARMS)
          The values for MAXB, used in determining minimum blocksize.

 line 9:  IACC22, INTEGER array, dimension (NPARMS)
          select structured matrix multiply: 1 or 2)

 line 10: NBCOL, INTEGER array, dimension (NPARMS)
          The values for NBCOL, the minimum column dimension for
          blocks.

 line 11: THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 12: TSTCHK, LOGICAL
          Flag indicating whether or not to test the LAPACK routines.

 line 13: TSTDRV, LOGICAL
          Flag indicating whether or not to test the driver routines.

 line 14: TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 15: NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 15 was 2:

 line 16: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 17-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'CGG' for the generalized
          eigenvalue problem routines and driver routines.

-----------------------------------------------------------------------

 CGS and CGV input files:

 line 1:  'CGS' or 'CGV' in columns 1 to 3.

 line 2:  NN, INTEGER
          Number of values of N.

 line 3:  NVAL, INTEGER array, dimension(NN)
          Dimensions of matrices to be tested.

 line 4:  NB, NBMIN, NX, NS, NBCOL, INTEGERs
          These integer parameters determine how blocking is done
          (see ILAENV for details)
          NB     : block size
          NBMIN  : minimum block size
          NX     : minimum dimension for blocking
          NS     : number of shifts in xHGEQR
          NBCOL  : minimum column dimension for blocking

 line 5:  THRESH, REAL
          The test threshold against which computed residuals are
          compared. Should generally be in the range from 10. to 20.
          If it is 0., all test case data will be printed.

 line 6:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits.

 line 7:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 17 was 2:

 line 7:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 7-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'CGS' for the generalized
          eigenvalue problem routines and driver routines.

-----------------------------------------------------------------------

 CGX input file:
 line 1:  'CGX' in columns 1 to 3.

 line 2:  N, INTEGER
          Value of N.

 line 3:  NB, NBMIN, NX, NS, NBCOL, INTEGERs
          These integer parameters determine how blocking is done
          (see ILAENV for details)
          NB     : block size
          NBMIN  : minimum block size
          NX     : minimum dimension for blocking
          NS     : number of shifts in xHGEQR
          NBCOL  : minimum column dimension for blocking

 line 4:  THRESH, REAL
          The test threshold against which computed residuals are
          compared. Should generally be in the range from 10. to 20.
          Information will be printed about each test for which the
          test ratio is greater than or equal to the threshold.

 line 5:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 6:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 6 was 2:

 line 7: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 If line 2 was 0:

 line 7-EOF: Precomputed examples are tested.

 remaining lines : Each example is stored on 3+2*N*N lines, where N is
          its dimension. The first line contains the dimension (a
          single integer).  The next line contains an integer k such
          that only the last k eigenvalues will be selected and appear
          in the leading diagonal blocks of $A$ and $B$. The next N*N
          lines contain the matrix A, one element per line. The next N*N
          lines contain the matrix B. The last line contains the
          reciprocal of the eigenvalue cluster condition number and the
          reciprocal of the deflating subspace (associated with the
          selected eigencluster) condition number.  The end of data is
          indicated by dimension N=0.  Even if no data is to be tested,
          there must be at least one line containing N=0.

-----------------------------------------------------------------------

 CXV input files:
 line 1:  'CXV' in columns 1 to 3.

 line 2:  N, INTEGER
          Value of N.

 line 3:  NB, NBMIN, NX, NS, NBCOL, INTEGERs
          These integer parameters determine how blocking is done
          (see ILAENV for details)
          NB     : block size
          NBMIN  : minimum block size
          NX     : minimum dimension for blocking
          NS     : number of shifts in xHGEQR
          NBCOL  : minimum column dimension for blocking

 line 4:  THRESH, REAL
          The test threshold against which computed residuals are
          compared. Should generally be in the range from 10. to 20.
          Information will be printed about each test for which the
          test ratio is greater than or equal to the threshold.

 line 5:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 6:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 6 was 2:

 line 7: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 If line 2 was 0:

 line 7-EOF: Precomputed examples are tested.

 remaining lines : Each example is stored on 3+2*N*N lines, where N is
          its dimension. The first line contains the dimension (a
          single integer). The next N*N lines contain the matrix A, one
          element per line. The next N*N lines contain the matrix B.
          The next line contains the reciprocals of the eigenvalue
          condition numbers.  The last line contains the reciprocals of
          the eigenvector condition numbers.  The end of data is
          indicated by dimension N=0.  Even if no data is to be tested,
          there must be at least one line containing N=0.

-----------------------------------------------------------------------

 CHB input file:

 line 2:  NN, INTEGER
          Number of values of N.

 line 3:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix dimension N.

 line 4:  NK, INTEGER
          Number of values of K.

 line 5:  KVAL, INTEGER array, dimension (NK)
          The values for the matrix dimension K.

 line 6:  THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 7 was 2:

 line 8:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 8-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'CHB'.

-----------------------------------------------------------------------

 CBB input file:

 line 2:  NN, INTEGER
          Number of values of M and N.

 line 3:  MVAL, INTEGER array, dimension (NN)
          The values for the matrix row dimension M.

 line 4:  NVAL, INTEGER array, dimension (NN)
          The values for the matrix column dimension N.

 line 4:  NK, INTEGER
          Number of values of K.

 line 5:  KVAL, INTEGER array, dimension (NK)
          The values for the matrix bandwidth K.

 line 6:  NPARMS, INTEGER
          Number of values of the parameter NRHS

 line 7:  NSVAL, INTEGER array, dimension (NPARMS)
          The values for the number of right hand sides NRHS.

 line 8:  THRESH
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 9:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 9 was 2:

 line 10: INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 10-EOF:  Lines specifying matrix types, as for SVD.
          The 3-character path name is 'CBB'.

-----------------------------------------------------------------------

 CEC input file:

 line  2: THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 lines  3-EOF:

 Input for testing the eigencondition routines consists of a set of
 specially constructed test cases and their solutions.  The data
 format is not intended to be modified by the user.

-----------------------------------------------------------------------

 CBL and CBK input files:

 line 1:  'CBL' in columns 1-3 to test CGEBAL, or 'CBK' in
          columns 1-3 to test CGEBAK.

 The remaining lines consist of specially constructed test cases.

-----------------------------------------------------------------------

 CGL and CGK input files:

 line 1:  'CGL' in columns 1-3 to test CGGBAL, or 'CGK' in
          columns 1-3 to test CGGBAK.

 The remaining lines consist of specially constructed test cases.

-----------------------------------------------------------------------

 GLM data file:

 line 1:  'GLM' in columns 1 to 3.

 line 2:  NN, INTEGER
          Number of values of M, P, and N.

 line 3:  MVAL, INTEGER array, dimension(NN)
          Values of M (row dimension).

 line 4:  PVAL, INTEGER array, dimension(NN)
          Values of P (row dimension).

 line 5:  NVAL, INTEGER array, dimension(NN)
          Values of N (column dimension), note M <= N <= M+P.

 line 6:  THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 8:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 8 was 2:

 line 9:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 9-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'GLM' for the generalized
          linear regression model routines.

-----------------------------------------------------------------------

 GQR data file:

 line 1:  'GQR' in columns 1 to 3.

 line 2:  NN, INTEGER
          Number of values of M, P, and N.

 line 3:  MVAL, INTEGER array, dimension(NN)
          Values of M.

 line 4:  PVAL, INTEGER array, dimension(NN)
          Values of P.

 line 5:  NVAL, INTEGER array, dimension(NN)
          Values of N.

 line 6:  THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 8:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 8 was 2:

 line 9:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 9-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'GQR' for the generalized
          QR and RQ routines.

-----------------------------------------------------------------------

 GSV data file:

 line 1:  'GSV' in columns 1 to 3.

 line 2:  NN, INTEGER
          Number of values of M, P, and N.

 line 3:  MVAL, INTEGER array, dimension(NN)
          Values of M (row dimension).

 line 4:  PVAL, INTEGER array, dimension(NN)
          Values of P (row dimension).

 line 5:  NVAL, INTEGER array, dimension(NN)
          Values of N (column dimension).

 line 6:  THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 8:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 8 was 2:

 line 9:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 9-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'GSV' for the generalized
          SVD routines.

-----------------------------------------------------------------------

 CSD data file:

 line 1:  'CSD' in columns 1 to 3.

 line 2:  NM, INTEGER
          Number of values of M, P, and N.

 line 3:  MVAL, INTEGER array, dimension(NM)
          Values of M (row and column dimension of orthogonal matrix).

 line 4:  PVAL, INTEGER array, dimension(NM)
          Values of P (row dimension of top-left block).

 line 5:  NVAL, INTEGER array, dimension(NM)
          Values of N (column dimension of top-left block).

 line 6:  THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 8:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 8 was 2:

 line 9:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 9-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'CSD' for the CSD routine.

-----------------------------------------------------------------------

 LSE data file:

 line 1:  'LSE' in columns 1 to 3.

 line 2:  NN, INTEGER
          Number of values of M, P, and N.

 line 3:  MVAL, INTEGER array, dimension(NN)
          Values of M.

 line 4:  PVAL, INTEGER array, dimension(NN)
          Values of P.

 line 5:  NVAL, INTEGER array, dimension(NN)
          Values of N, note P <= N <= P+M.

 line 6:  THRESH, REAL
          Threshold value for the test ratios.  Information will be
          printed about each test for which the test ratio is greater
          than or equal to the threshold.

 line 7:  TSTERR, LOGICAL
          Flag indicating whether or not to test the error exits for
          the LAPACK routines and driver routines.

 line 8:  NEWSD, INTEGER
          A code indicating how to set the random number seed.
          = 0:  Set the seed to a default value before each run
          = 1:  Initialize the seed to a default value only before the
                first run
          = 2:  Like 1, but use the seed values on the next line

 If line 8 was 2:

 line 9:  INTEGER array, dimension (4)
          Four integer values for the random number seed.

 lines 9-EOF:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'GSV' for the generalized
          SVD routines.

-----------------------------------------------------------------------

 NMAX is currently set to 132 and must be at least 12 for some of the
 precomputed examples, and LWORK = NMAX*(5*NMAX+20) in the parameter
 statements below.  For SVD, we assume NRHS may be as big as N.  The
 parameter NEED is set to 14 to allow for 14 N-by-N matrices for CGG.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 1035 of file cchkee.f.

Here is the call graph for this function:

subroutine cchkgg ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
logical  TSTDIF,
real  THRSHN,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( lda, * )  B,
complex, dimension( lda, * )  H,
complex, dimension( lda, * )  T,
complex, dimension( lda, * )  S1,
complex, dimension( lda, * )  S2,
complex, dimension( lda, * )  P1,
complex, dimension( lda, * )  P2,
complex, dimension( ldu, * )  U,
integer  LDU,
complex, dimension( ldu, * )  V,
complex, dimension( ldu, * )  Q,
complex, dimension( ldu, * )  Z,
complex, dimension( * )  ALPHA1,
complex, dimension( * )  BETA1,
complex, dimension( * )  ALPHA3,
complex, dimension( * )  BETA3,
complex, dimension( ldu, * )  EVECTL,
complex, dimension( ldu, * )  EVECTR,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
logical, dimension( * )  LLWORK,
real, dimension( 15 )  RESULT,
integer  INFO 
)

CCHKGG

Purpose:
 CCHKGG  checks the nonsymmetric generalized eigenvalue problem
 routines.
                                H          H        H
 CGGHRD factors A and B as U H V  and U T V , where   means conjugate
 transpose, H is hessenberg, T is triangular and U and V are unitary.

                                 H          H
 CHGEQZ factors H and T as  Q S Z  and Q P Z , where P and S are upper
 triangular and Q and Z are unitary.  It also computes the generalized
 eigenvalues (alpha(1),beta(1)),...,(alpha(n),beta(n)), where
 alpha(j)=S(j,j) and beta(j)=P(j,j) -- thus, w(j) = alpha(j)/beta(j)
 is a root of the generalized eigenvalue problem

     det( A - w(j) B ) = 0

 and m(j) = beta(j)/alpha(j) is a root of the essentially equivalent
 problem

     det( m(j) A - B ) = 0

 CTGEVC computes the matrix L of left eigenvectors and the matrix R
 of right eigenvectors for the matrix pair ( S, P ).  In the
 description below,  l and r are left and right eigenvectors
 corresponding to the generalized eigenvalues (alpha,beta).

 When CCHKGG is called, a number of matrix "sizes" ("n's") and a
 number of matrix "types" are specified.  For each size ("n")
 and each type of matrix, one matrix will be generated and used
 to test the nonsymmetric eigenroutines.  For each matrix, 13
 tests will be performed.  The first twelve "test ratios" should be
 small -- O(1).  They will be compared with the threshhold THRESH:

                  H
 (1)   | A - U H V  | / ( |A| n ulp )

                  H
 (2)   | B - U T V  | / ( |B| n ulp )

               H
 (3)   | I - UU  | / ( n ulp )

               H
 (4)   | I - VV  | / ( n ulp )

                  H
 (5)   | H - Q S Z  | / ( |H| n ulp )

                  H
 (6)   | T - Q P Z  | / ( |T| n ulp )

               H
 (7)   | I - QQ  | / ( n ulp )

               H
 (8)   | I - ZZ  | / ( n ulp )

 (9)   max over all left eigenvalue/-vector pairs (beta/alpha,l) of
                           H
       | (beta A - alpha B) l | / ( ulp max( |beta A|, |alpha B| ) )

 (10)  max over all left eigenvalue/-vector pairs (beta/alpha,l') of
                           H
       | (beta H - alpha T) l' | / ( ulp max( |beta H|, |alpha T| ) )

       where the eigenvectors l' are the result of passing Q to
       STGEVC and back transforming (JOB='B').

 (11)  max over all right eigenvalue/-vector pairs (beta/alpha,r) of

       | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )

 (12)  max over all right eigenvalue/-vector pairs (beta/alpha,r') of

       | (beta H - alpha T) r' | / ( ulp max( |beta H|, |alpha T| ) )

       where the eigenvectors r' are the result of passing Z to
       STGEVC and back transforming (JOB='B').

 The last three test ratios will usually be small, but there is no
 mathematical requirement that they be so.  They are therefore
 compared with THRESH only if TSTDIF is .TRUE.

 (13)  | S(Q,Z computed) - S(Q,Z not computed) | / ( |S| ulp )

 (14)  | P(Q,Z computed) - P(Q,Z not computed) | / ( |P| ulp )

 (15)  max( |alpha(Q,Z computed) - alpha(Q,Z not computed)|/|S| ,
            |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp

 In addition, the normalization of L and R are checked, and compared
 with the threshhold THRSHN.

 Test Matrices
 ---- --------

 The sizes of the test matrices are specified by an array
 NN(1:NSIZES); the value of each element NN(j) specifies one size.
 The "types" are specified by a logical array DOTYPE( 1:NTYPES ); if
 DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
 Currently, the list of possible types is:

 (1)  ( 0, 0 )         (a pair of zero matrices)

 (2)  ( I, 0 )         (an identity and a zero matrix)

 (3)  ( 0, I )         (an identity and a zero matrix)

 (4)  ( I, I )         (a pair of identity matrices)

         t   t
 (5)  ( J , J  )       (a pair of transposed Jordan blocks)

                                     t                ( I   0  )
 (6)  ( X, Y )         where  X = ( J   0  )  and Y = (      t )
                                  ( 0   I  )          ( 0   J  )
                       and I is a k x k identity and J a (k+1)x(k+1)
                       Jordan block; k=(N-1)/2

 (7)  ( D, I )         where D is P*D1, P is a random unitary diagonal
                       matrix (i.e., with random magnitude 1 entries
                       on the diagonal), and D1=diag( 0, 1,..., N-1 )
                       (i.e., a diagonal matrix with D1(1,1)=0,
                       D1(2,2)=1, ..., D1(N,N)=N-1.)
 (8)  ( I, D )

 (9)  ( big*D, small*I ) where "big" is near overflow and small=1/big

 (10) ( small*D, big*I )

 (11) ( big*I, small*D )

 (12) ( small*I, big*D )

 (13) ( big*D, big*I )

 (14) ( small*D, small*I )

 (15) ( D1, D2 )        where D1=P*diag( 0, 0, 1, ..., N-3, 0 ) and
                        D2=Q*diag( 0, N-3, N-4,..., 1, 0, 0 ), and
                        P and Q are random unitary diagonal matrices.
           t   t
 (16) U ( J , J ) V     where U and V are random unitary matrices.

 (17) U ( T1, T2 ) V    where T1 and T2 are upper triangular matrices
                        with random O(1) entries above the diagonal
                        and diagonal entries diag(T1) =
                        P*( 0, 0, 1, ..., N-3, 0 ) and diag(T2) =
                        Q*( 0, N-3, N-4,..., 1, 0, 0 )

 (18) U ( T1, T2 ) V    diag(T1) = ( 0, 0, 1, 1, s, ..., s, 0 )
                        diag(T2) = ( 0, 1, 0, 1,..., 1, 0 )
                        s = machine precision.

 (19) U ( T1, T2 ) V    diag(T1)=( 0,0,1,1, 1-d, ..., 1-(N-5)*d=s, 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0 )

                                                        N-5
 (20) U ( T1, T2 ) V    diag(T1)=( 0, 0, 1, 1, a, ..., a   =s, 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )

 (21) U ( T1, T2 ) V    diag(T1)=( 0, 0, 1, r1, r2, ..., r(N-4), 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )
                        where r1,..., r(N-4) are random.

 (22) U ( big*T1, small*T2 ) V   diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (23) U ( small*T1, big*T2 ) V   diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (24) U ( small*T1, small*T2 ) V diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (25) U ( big*T1, big*T2 ) V     diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (26) U ( T1, T2 ) V     where T1 and T2 are random upper-triangular
                         matrices.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          CCHKGG does nothing.  It must be at least zero.
[in]NN
          NN is INTEGER array, dimension (NSIZES)
          An array containing the sizes to be used for the matrices.
          Zero values will be skipped.  The values must be at least
          zero.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, CCHKGG
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrix is in A.  This
          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size in NN a
          matrix of that size and of type j will be generated.
          If NTYPES is smaller than the maximum number of types
          defined (PARAMETER MAXTYP), then types NTYPES+1 through
          MAXTYP will not be generated.  If NTYPES is larger
          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
          will be ignored.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator. The array elements should be between 0 and 4095;
          if not they will be reduced mod 4096.  Also, ISEED(4) must
          be odd.  The random number generator uses a linear
          congruential sequence limited to small integers, and so
          should produce machine independent random numbers. The
          values of ISEED are changed on exit, and can be used in the
          next call to CCHKGG to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]TSTDIF
          TSTDIF is LOGICAL
          Specifies whether test ratios 13-15 will be computed and
          compared with THRESH.
          = .FALSE.: Only test ratios 1-12 will be computed and tested.
                     Ratios 13-15 will be set to zero.
          = .TRUE.:  All the test ratios 1-15 will be computed and
                     tested.
[in]THRSHN
          THRSHN is REAL
          Threshhold for reporting eigenvector normalization error.
          If the normalization of any eigenvector differs from 1 by
          more than THRSHN*ulp, then a special error message will be
          printed.  (This is handled separately from the other tests,
          since only a compiler or programming error should cause an
          error message, at least if THRSHN is at least 5--10.)
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is COMPLEX array, dimension (LDA, max(NN))
          Used to hold the original A matrix.  Used as input only
          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
          DOTYPE(MAXTYP+1)=.TRUE.
[in]LDA
          LDA is INTEGER
          The leading dimension of A, B, H, T, S1, P1, S2, and P2.
          It must be at least 1 and at least max( NN ).
[in,out]B
          B is COMPLEX array, dimension (LDA, max(NN))
          Used to hold the original B matrix.  Used as input only
          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
          DOTYPE(MAXTYP+1)=.TRUE.
[out]H
          H is COMPLEX array, dimension (LDA, max(NN))
          The upper Hessenberg matrix computed from A by CGGHRD.
[out]T
          T is COMPLEX array, dimension (LDA, max(NN))
          The upper triangular matrix computed from B by CGGHRD.
[out]S1
          S1 is COMPLEX array, dimension (LDA, max(NN))
          The Schur (upper triangular) matrix computed from H by CHGEQZ
          when Q and Z are also computed.
[out]S2
          S2 is COMPLEX array, dimension (LDA, max(NN))
          The Schur (upper triangular) matrix computed from H by CHGEQZ
          when Q and Z are not computed.
[out]P1
          P1 is COMPLEX array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by CHGEQZ
          when Q and Z are also computed.
[out]P2
          P2 is COMPLEX array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by CHGEQZ
          when Q and Z are not computed.
[out]U
          U is COMPLEX array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by CGGHRD.
[in]LDU
          LDU is INTEGER
          The leading dimension of U, V, Q, Z, EVECTL, and EVECTR.  It
          must be at least 1 and at least max( NN ).
[out]V
          V is COMPLEX array, dimension (LDU, max(NN))
          The (right) unitary matrix computed by CGGHRD.
[out]Q
          Q is COMPLEX array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by CHGEQZ.
[out]Z
          Z is COMPLEX array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by CHGEQZ.
[out]ALPHA1
          ALPHA1 is COMPLEX array, dimension (max(NN))
[out]BETA1
          BETA1 is COMPLEX array, dimension (max(NN))
          The generalized eigenvalues of (A,B) computed by CHGEQZ
          when Q, Z, and the full Schur matrices are computed.
[out]ALPHA3
          ALPHA3 is COMPLEX array, dimension (max(NN))
[out]BETA3
          BETA3 is COMPLEX array, dimension (max(NN))
          The generalized eigenvalues of (A,B) computed by CHGEQZ
          when neither Q, Z, nor the Schur matrices are computed.
[out]EVECTL
          EVECTL is COMPLEX array, dimension (LDU, max(NN))
          The (lower triangular) left eigenvector matrix for the
          matrices in S1 and P1.
[out]EVECTR
          EVECTR is COMPLEX array, dimension (LDU, max(NN))
          The (upper triangular) right eigenvector matrix for the
          matrices in S1 and P1.
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max( 4*N, 2 * N**2, 1 ), for all N=NN(j).
[out]RWORK
          RWORK is REAL array, dimension (2*max(NN))
[out]LLWORK
          LLWORK is LOGICAL array, dimension (max(NN))
[out]RESULT
          RESULT is REAL array, dimension (15)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit.
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  A routine returned an error code.  INFO is the
                absolute value of the INFO value returned.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 505 of file cchkgg.f.

505 *
506 * -- LAPACK test routine (version 3.4.0) --
507 * -- LAPACK is a software package provided by Univ. of Tennessee, --
508 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
509 * November 2011
510 *
511 * .. Scalar Arguments ..
512  LOGICAL tstdif
513  INTEGER info, lda, ldu, lwork, nounit, nsizes, ntypes
514  REAL thresh, thrshn
515 * ..
516 * .. Array Arguments ..
517  LOGICAL dotype( * ), llwork( * )
518  INTEGER iseed( 4 ), nn( * )
519  REAL result( 15 ), rwork( * )
520  COMPLEX a( lda, * ), alpha1( * ), alpha3( * ),
521  $ b( lda, * ), beta1( * ), beta3( * ),
522  $ evectl( ldu, * ), evectr( ldu, * ),
523  $ h( lda, * ), p1( lda, * ), p2( lda, * ),
524  $ q( ldu, * ), s1( lda, * ), s2( lda, * ),
525  $ t( lda, * ), u( ldu, * ), v( ldu, * ),
526  $ work( * ), z( ldu, * )
527 * ..
528 *
529 * =====================================================================
530 *
531 * .. Parameters ..
532  REAL zero, one
533  parameter( zero = 0.0e+0, one = 1.0e+0 )
534  COMPLEX czero, cone
535  parameter( czero = ( 0.0e+0, 0.0e+0 ),
536  $ cone = ( 1.0e+0, 0.0e+0 ) )
537  INTEGER maxtyp
538  parameter( maxtyp = 26 )
539 * ..
540 * .. Local Scalars ..
541  LOGICAL badnn
542  INTEGER i1, iadd, iinfo, in, j, jc, jr, jsize, jtype,
543  $ lwkopt, mtypes, n, n1, nerrs, nmats, nmax,
544  $ ntest, ntestt
545  REAL anorm, bnorm, safmax, safmin, temp1, temp2,
546  $ ulp, ulpinv
547  COMPLEX ctemp
548 * ..
549 * .. Local Arrays ..
550  LOGICAL lasign( maxtyp ), lbsign( maxtyp )
551  INTEGER ioldsd( 4 ), kadd( 6 ), kamagn( maxtyp ),
552  $ katype( maxtyp ), kazero( maxtyp ),
553  $ kbmagn( maxtyp ), kbtype( maxtyp ),
554  $ kbzero( maxtyp ), kclass( maxtyp ),
555  $ ktrian( maxtyp ), kz1( 6 ), kz2( 6 )
556  REAL dumma( 4 ), rmagn( 0: 3 )
557  COMPLEX cdumma( 4 )
558 * ..
559 * .. External Functions ..
560  REAL clange, slamch
561  COMPLEX clarnd
562  EXTERNAL clange, slamch, clarnd
563 * ..
564 * .. External Subroutines ..
565  EXTERNAL cgeqr2, cget51, cget52, cgghrd, chgeqz, clacpy,
567  $ slasum, xerbla
568 * ..
569 * .. Intrinsic Functions ..
570  INTRINSIC abs, conjg, max, min, REAL, sign
571 * ..
572 * .. Data statements ..
573  DATA kclass / 15*1, 10*2, 1*3 /
574  DATA kz1 / 0, 1, 2, 1, 3, 3 /
575  DATA kz2 / 0, 0, 1, 2, 1, 1 /
576  DATA kadd / 0, 0, 0, 0, 3, 2 /
577  DATA katype / 0, 1, 0, 1, 2, 3, 4, 1, 4, 4, 1, 1, 4,
578  $ 4, 4, 2, 4, 5, 8, 7, 9, 4*4, 0 /
579  DATA kbtype / 0, 0, 1, 1, 2, -3, 1, 4, 1, 1, 4, 4,
580  $ 1, 1, -4, 2, -4, 8*8, 0 /
581  DATA kazero / 6*1, 2, 1, 2*2, 2*1, 2*2, 3, 1, 3,
582  $ 4*5, 4*3, 1 /
583  DATA kbzero / 6*1, 1, 2, 2*1, 2*2, 2*1, 4, 1, 4,
584  $ 4*6, 4*4, 1 /
585  DATA kamagn / 8*1, 2, 3, 2, 3, 2, 3, 7*1, 2, 3, 3,
586  $ 2, 1 /
587  DATA kbmagn / 8*1, 3, 2, 3, 2, 2, 3, 7*1, 3, 2, 3,
588  $ 2, 1 /
589  DATA ktrian / 16*0, 10*1 /
590  DATA lasign / 6*.false., .true., .false., 2*.true.,
591  $ 2*.false., 3*.true., .false., .true.,
592  $ 3*.false., 5*.true., .false. /
593  DATA lbsign / 7*.false., .true., 2*.false.,
594  $ 2*.true., 2*.false., .true., .false., .true.,
595  $ 9*.false. /
596 * ..
597 * .. Executable Statements ..
598 *
599 * Check for errors
600 *
601  info = 0
602 *
603  badnn = .false.
604  nmax = 1
605  DO 10 j = 1, nsizes
606  nmax = max( nmax, nn( j ) )
607  IF( nn( j ).LT.0 )
608  $ badnn = .true.
609  10 CONTINUE
610 *
611  lwkopt = max( 2*nmax*nmax, 4*nmax, 1 )
612 *
613 * Check for errors
614 *
615  IF( nsizes.LT.0 ) THEN
616  info = -1
617  ELSE IF( badnn ) THEN
618  info = -2
619  ELSE IF( ntypes.LT.0 ) THEN
620  info = -3
621  ELSE IF( thresh.LT.zero ) THEN
622  info = -6
623  ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
624  info = -10
625  ELSE IF( ldu.LE.1 .OR. ldu.LT.nmax ) THEN
626  info = -19
627  ELSE IF( lwkopt.GT.lwork ) THEN
628  info = -30
629  END IF
630 *
631  IF( info.NE.0 ) THEN
632  CALL xerbla( 'CCHKGG', -info )
633  RETURN
634  END IF
635 *
636 * Quick return if possible
637 *
638  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
639  $ RETURN
640 *
641  safmin = slamch( 'Safe minimum' )
642  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
643  safmin = safmin / ulp
644  safmax = one / safmin
645  CALL slabad( safmin, safmax )
646  ulpinv = one / ulp
647 *
648 * The values RMAGN(2:3) depend on N, see below.
649 *
650  rmagn( 0 ) = zero
651  rmagn( 1 ) = one
652 *
653 * Loop over sizes, types
654 *
655  ntestt = 0
656  nerrs = 0
657  nmats = 0
658 *
659  DO 240 jsize = 1, nsizes
660  n = nn( jsize )
661  n1 = max( 1, n )
662  rmagn( 2 ) = safmax*ulp / REAL( n1 )
663  rmagn( 3 ) = safmin*ulpinv*n1
664 *
665  IF( nsizes.NE.1 ) THEN
666  mtypes = min( maxtyp, ntypes )
667  ELSE
668  mtypes = min( maxtyp+1, ntypes )
669  END IF
670 *
671  DO 230 jtype = 1, mtypes
672  IF( .NOT.dotype( jtype ) )
673  $ GO TO 230
674  nmats = nmats + 1
675  ntest = 0
676 *
677 * Save ISEED in case of an error.
678 *
679  DO 20 j = 1, 4
680  ioldsd( j ) = iseed( j )
681  20 CONTINUE
682 *
683 * Initialize RESULT
684 *
685  DO 30 j = 1, 15
686  result( j ) = zero
687  30 CONTINUE
688 *
689 * Compute A and B
690 *
691 * Description of control parameters:
692 *
693 * KCLASS: =1 means w/o rotation, =2 means w/ rotation,
694 * =3 means random.
695 * KATYPE: the "type" to be passed to CLATM4 for computing A.
696 * KAZERO: the pattern of zeros on the diagonal for A:
697 * =1: ( xxx ), =2: (0, xxx ) =3: ( 0, 0, xxx, 0 ),
698 * =4: ( 0, xxx, 0, 0 ), =5: ( 0, 0, 1, xxx, 0 ),
699 * =6: ( 0, 1, 0, xxx, 0 ). (xxx means a string of
700 * non-zero entries.)
701 * KAMAGN: the magnitude of the matrix: =0: zero, =1: O(1),
702 * =2: large, =3: small.
703 * LASIGN: .TRUE. if the diagonal elements of A are to be
704 * multiplied by a random magnitude 1 number.
705 * KBTYPE, KBZERO, KBMAGN, LBSIGN: the same, but for B.
706 * KTRIAN: =0: don't fill in the upper triangle, =1: do.
707 * KZ1, KZ2, KADD: used to implement KAZERO and KBZERO.
708 * RMAGN: used to implement KAMAGN and KBMAGN.
709 *
710  IF( mtypes.GT.maxtyp )
711  $ GO TO 110
712  iinfo = 0
713  IF( kclass( jtype ).LT.3 ) THEN
714 *
715 * Generate A (w/o rotation)
716 *
717  IF( abs( katype( jtype ) ).EQ.3 ) THEN
718  in = 2*( ( n-1 ) / 2 ) + 1
719  IF( in.NE.n )
720  $ CALL claset( 'Full', n, n, czero, czero, a, lda )
721  ELSE
722  in = n
723  END IF
724  CALL clatm4( katype( jtype ), in, kz1( kazero( jtype ) ),
725  $ kz2( kazero( jtype ) ), lasign( jtype ),
726  $ rmagn( kamagn( jtype ) ), ulp,
727  $ rmagn( ktrian( jtype )*kamagn( jtype ) ), 4,
728  $ iseed, a, lda )
729  iadd = kadd( kazero( jtype ) )
730  IF( iadd.GT.0 .AND. iadd.LE.n )
731  $ a( iadd, iadd ) = rmagn( kamagn( jtype ) )
732 *
733 * Generate B (w/o rotation)
734 *
735  IF( abs( kbtype( jtype ) ).EQ.3 ) THEN
736  in = 2*( ( n-1 ) / 2 ) + 1
737  IF( in.NE.n )
738  $ CALL claset( 'Full', n, n, czero, czero, b, lda )
739  ELSE
740  in = n
741  END IF
742  CALL clatm4( kbtype( jtype ), in, kz1( kbzero( jtype ) ),
743  $ kz2( kbzero( jtype ) ), lbsign( jtype ),
744  $ rmagn( kbmagn( jtype ) ), one,
745  $ rmagn( ktrian( jtype )*kbmagn( jtype ) ), 4,
746  $ iseed, b, lda )
747  iadd = kadd( kbzero( jtype ) )
748  IF( iadd.NE.0 )
749  $ b( iadd, iadd ) = rmagn( kbmagn( jtype ) )
750 *
751  IF( kclass( jtype ).EQ.2 .AND. n.GT.0 ) THEN
752 *
753 * Include rotations
754 *
755 * Generate U, V as Householder transformations times a
756 * diagonal matrix. (Note that CLARFG makes U(j,j) and
757 * V(j,j) real.)
758 *
759  DO 50 jc = 1, n - 1
760  DO 40 jr = jc, n
761  u( jr, jc ) = clarnd( 3, iseed )
762  v( jr, jc ) = clarnd( 3, iseed )
763  40 CONTINUE
764  CALL clarfg( n+1-jc, u( jc, jc ), u( jc+1, jc ), 1,
765  $ work( jc ) )
766  work( 2*n+jc ) = sign( one, REAL( U( JC, JC ) ) )
767  u( jc, jc ) = cone
768  CALL clarfg( n+1-jc, v( jc, jc ), v( jc+1, jc ), 1,
769  $ work( n+jc ) )
770  work( 3*n+jc ) = sign( one, REAL( V( JC, JC ) ) )
771  v( jc, jc ) = cone
772  50 CONTINUE
773  ctemp = clarnd( 3, iseed )
774  u( n, n ) = cone
775  work( n ) = czero
776  work( 3*n ) = ctemp / abs( ctemp )
777  ctemp = clarnd( 3, iseed )
778  v( n, n ) = cone
779  work( 2*n ) = czero
780  work( 4*n ) = ctemp / abs( ctemp )
781 *
782 * Apply the diagonal matrices
783 *
784  DO 70 jc = 1, n
785  DO 60 jr = 1, n
786  a( jr, jc ) = work( 2*n+jr )*
787  $ conjg( work( 3*n+jc ) )*
788  $ a( jr, jc )
789  b( jr, jc ) = work( 2*n+jr )*
790  $ conjg( work( 3*n+jc ) )*
791  $ b( jr, jc )
792  60 CONTINUE
793  70 CONTINUE
794  CALL cunm2r( 'L', 'N', n, n, n-1, u, ldu, work, a,
795  $ lda, work( 2*n+1 ), iinfo )
796  IF( iinfo.NE.0 )
797  $ GO TO 100
798  CALL cunm2r( 'R', 'C', n, n, n-1, v, ldu, work( n+1 ),
799  $ a, lda, work( 2*n+1 ), iinfo )
800  IF( iinfo.NE.0 )
801  $ GO TO 100
802  CALL cunm2r( 'L', 'N', n, n, n-1, u, ldu, work, b,
803  $ lda, work( 2*n+1 ), iinfo )
804  IF( iinfo.NE.0 )
805  $ GO TO 100
806  CALL cunm2r( 'R', 'C', n, n, n-1, v, ldu, work( n+1 ),
807  $ b, lda, work( 2*n+1 ), iinfo )
808  IF( iinfo.NE.0 )
809  $ GO TO 100
810  END IF
811  ELSE
812 *
813 * Random matrices
814 *
815  DO 90 jc = 1, n
816  DO 80 jr = 1, n
817  a( jr, jc ) = rmagn( kamagn( jtype ) )*
818  $ clarnd( 4, iseed )
819  b( jr, jc ) = rmagn( kbmagn( jtype ) )*
820  $ clarnd( 4, iseed )
821  80 CONTINUE
822  90 CONTINUE
823  END IF
824 *
825  anorm = clange( '1', n, n, a, lda, rwork )
826  bnorm = clange( '1', n, n, b, lda, rwork )
827 *
828  100 CONTINUE
829 *
830  IF( iinfo.NE.0 ) THEN
831  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
832  $ ioldsd
833  info = abs( iinfo )
834  RETURN
835  END IF
836 *
837  110 CONTINUE
838 *
839 * Call CGEQR2, CUNM2R, and CGGHRD to compute H, T, U, and V
840 *
841  CALL clacpy( ' ', n, n, a, lda, h, lda )
842  CALL clacpy( ' ', n, n, b, lda, t, lda )
843  ntest = 1
844  result( 1 ) = ulpinv
845 *
846  CALL cgeqr2( n, n, t, lda, work, work( n+1 ), iinfo )
847  IF( iinfo.NE.0 ) THEN
848  WRITE( nounit, fmt = 9999 )'CGEQR2', iinfo, n, jtype,
849  $ ioldsd
850  info = abs( iinfo )
851  GO TO 210
852  END IF
853 *
854  CALL cunm2r( 'L', 'C', n, n, n, t, lda, work, h, lda,
855  $ work( n+1 ), iinfo )
856  IF( iinfo.NE.0 ) THEN
857  WRITE( nounit, fmt = 9999 )'CUNM2R', iinfo, n, jtype,
858  $ ioldsd
859  info = abs( iinfo )
860  GO TO 210
861  END IF
862 *
863  CALL claset( 'Full', n, n, czero, cone, u, ldu )
864  CALL cunm2r( 'R', 'N', n, n, n, t, lda, work, u, ldu,
865  $ work( n+1 ), iinfo )
866  IF( iinfo.NE.0 ) THEN
867  WRITE( nounit, fmt = 9999 )'CUNM2R', iinfo, n, jtype,
868  $ ioldsd
869  info = abs( iinfo )
870  GO TO 210
871  END IF
872 *
873  CALL cgghrd( 'V', 'I', n, 1, n, h, lda, t, lda, u, ldu, v,
874  $ ldu, iinfo )
875  IF( iinfo.NE.0 ) THEN
876  WRITE( nounit, fmt = 9999 )'CGGHRD', iinfo, n, jtype,
877  $ ioldsd
878  info = abs( iinfo )
879  GO TO 210
880  END IF
881  ntest = 4
882 *
883 * Do tests 1--4
884 *
885  CALL cget51( 1, n, a, lda, h, lda, u, ldu, v, ldu, work,
886  $ rwork, result( 1 ) )
887  CALL cget51( 1, n, b, lda, t, lda, u, ldu, v, ldu, work,
888  $ rwork, result( 2 ) )
889  CALL cget51( 3, n, b, lda, t, lda, u, ldu, u, ldu, work,
890  $ rwork, result( 3 ) )
891  CALL cget51( 3, n, b, lda, t, lda, v, ldu, v, ldu, work,
892  $ rwork, result( 4 ) )
893 *
894 * Call CHGEQZ to compute S1, P1, S2, P2, Q, and Z, do tests.
895 *
896 * Compute T1 and UZ
897 *
898 * Eigenvalues only
899 *
900  CALL clacpy( ' ', n, n, h, lda, s2, lda )
901  CALL clacpy( ' ', n, n, t, lda, p2, lda )
902  ntest = 5
903  result( 5 ) = ulpinv
904 *
905  CALL chgeqz( 'E', 'N', 'N', n, 1, n, s2, lda, p2, lda,
906  $ alpha3, beta3, q, ldu, z, ldu, work, lwork,
907  $ rwork, iinfo )
908  IF( iinfo.NE.0 ) THEN
909  WRITE( nounit, fmt = 9999 )'CHGEQZ(E)', iinfo, n, jtype,
910  $ ioldsd
911  info = abs( iinfo )
912  GO TO 210
913  END IF
914 *
915 * Eigenvalues and Full Schur Form
916 *
917  CALL clacpy( ' ', n, n, h, lda, s2, lda )
918  CALL clacpy( ' ', n, n, t, lda, p2, lda )
919 *
920  CALL chgeqz( 'S', 'N', 'N', n, 1, n, s2, lda, p2, lda,
921  $ alpha1, beta1, q, ldu, z, ldu, work, lwork,
922  $ rwork, iinfo )
923  IF( iinfo.NE.0 ) THEN
924  WRITE( nounit, fmt = 9999 )'CHGEQZ(S)', iinfo, n, jtype,
925  $ ioldsd
926  info = abs( iinfo )
927  GO TO 210
928  END IF
929 *
930 * Eigenvalues, Schur Form, and Schur Vectors
931 *
932  CALL clacpy( ' ', n, n, h, lda, s1, lda )
933  CALL clacpy( ' ', n, n, t, lda, p1, lda )
934 *
935  CALL chgeqz( 'S', 'I', 'I', n, 1, n, s1, lda, p1, lda,
936  $ alpha1, beta1, q, ldu, z, ldu, work, lwork,
937  $ rwork, iinfo )
938  IF( iinfo.NE.0 ) THEN
939  WRITE( nounit, fmt = 9999 )'CHGEQZ(V)', iinfo, n, jtype,
940  $ ioldsd
941  info = abs( iinfo )
942  GO TO 210
943  END IF
944 *
945  ntest = 8
946 *
947 * Do Tests 5--8
948 *
949  CALL cget51( 1, n, h, lda, s1, lda, q, ldu, z, ldu, work,
950  $ rwork, result( 5 ) )
951  CALL cget51( 1, n, t, lda, p1, lda, q, ldu, z, ldu, work,
952  $ rwork, result( 6 ) )
953  CALL cget51( 3, n, t, lda, p1, lda, q, ldu, q, ldu, work,
954  $ rwork, result( 7 ) )
955  CALL cget51( 3, n, t, lda, p1, lda, z, ldu, z, ldu, work,
956  $ rwork, result( 8 ) )
957 *
958 * Compute the Left and Right Eigenvectors of (S1,P1)
959 *
960 * 9: Compute the left eigenvector Matrix without
961 * back transforming:
962 *
963  ntest = 9
964  result( 9 ) = ulpinv
965 *
966 * To test "SELECT" option, compute half of the eigenvectors
967 * in one call, and half in another
968 *
969  i1 = n / 2
970  DO 120 j = 1, i1
971  llwork( j ) = .true.
972  120 CONTINUE
973  DO 130 j = i1 + 1, n
974  llwork( j ) = .false.
975  130 CONTINUE
976 *
977  CALL ctgevc( 'L', 'S', llwork, n, s1, lda, p1, lda, evectl,
978  $ ldu, cdumma, ldu, n, in, work, rwork, iinfo )
979  IF( iinfo.NE.0 ) THEN
980  WRITE( nounit, fmt = 9999 )'CTGEVC(L,S1)', iinfo, n,
981  $ jtype, ioldsd
982  info = abs( iinfo )
983  GO TO 210
984  END IF
985 *
986  i1 = in
987  DO 140 j = 1, i1
988  llwork( j ) = .false.
989  140 CONTINUE
990  DO 150 j = i1 + 1, n
991  llwork( j ) = .true.
992  150 CONTINUE
993 *
994  CALL ctgevc( 'L', 'S', llwork, n, s1, lda, p1, lda,
995  $ evectl( 1, i1+1 ), ldu, cdumma, ldu, n, in,
996  $ work, rwork, iinfo )
997  IF( iinfo.NE.0 ) THEN
998  WRITE( nounit, fmt = 9999 )'CTGEVC(L,S2)', iinfo, n,
999  $ jtype, ioldsd
1000  info = abs( iinfo )
1001  GO TO 210
1002  END IF
1003 *
1004  CALL cget52( .true., n, s1, lda, p1, lda, evectl, ldu,
1005  $ alpha1, beta1, work, rwork, dumma( 1 ) )
1006  result( 9 ) = dumma( 1 )
1007  IF( dumma( 2 ).GT.thrshn ) THEN
1008  WRITE( nounit, fmt = 9998 )'Left', 'CTGEVC(HOWMNY=S)',
1009  $ dumma( 2 ), n, jtype, ioldsd
1010  END IF
1011 *
1012 * 10: Compute the left eigenvector Matrix with
1013 * back transforming:
1014 *
1015  ntest = 10
1016  result( 10 ) = ulpinv
1017  CALL clacpy( 'F', n, n, q, ldu, evectl, ldu )
1018  CALL ctgevc( 'L', 'B', llwork, n, s1, lda, p1, lda, evectl,
1019  $ ldu, cdumma, ldu, n, in, work, rwork, iinfo )
1020  IF( iinfo.NE.0 ) THEN
1021  WRITE( nounit, fmt = 9999 )'CTGEVC(L,B)', iinfo, n,
1022  $ jtype, ioldsd
1023  info = abs( iinfo )
1024  GO TO 210
1025  END IF
1026 *
1027  CALL cget52( .true., n, h, lda, t, lda, evectl, ldu, alpha1,
1028  $ beta1, work, rwork, dumma( 1 ) )
1029  result( 10 ) = dumma( 1 )
1030  IF( dumma( 2 ).GT.thrshn ) THEN
1031  WRITE( nounit, fmt = 9998 )'Left', 'CTGEVC(HOWMNY=B)',
1032  $ dumma( 2 ), n, jtype, ioldsd
1033  END IF
1034 *
1035 * 11: Compute the right eigenvector Matrix without
1036 * back transforming:
1037 *
1038  ntest = 11
1039  result( 11 ) = ulpinv
1040 *
1041 * To test "SELECT" option, compute half of the eigenvectors
1042 * in one call, and half in another
1043 *
1044  i1 = n / 2
1045  DO 160 j = 1, i1
1046  llwork( j ) = .true.
1047  160 CONTINUE
1048  DO 170 j = i1 + 1, n
1049  llwork( j ) = .false.
1050  170 CONTINUE
1051 *
1052  CALL ctgevc( 'R', 'S', llwork, n, s1, lda, p1, lda, cdumma,
1053  $ ldu, evectr, ldu, n, in, work, rwork, iinfo )
1054  IF( iinfo.NE.0 ) THEN
1055  WRITE( nounit, fmt = 9999 )'CTGEVC(R,S1)', iinfo, n,
1056  $ jtype, ioldsd
1057  info = abs( iinfo )
1058  GO TO 210
1059  END IF
1060 *
1061  i1 = in
1062  DO 180 j = 1, i1
1063  llwork( j ) = .false.
1064  180 CONTINUE
1065  DO 190 j = i1 + 1, n
1066  llwork( j ) = .true.
1067  190 CONTINUE
1068 *
1069  CALL ctgevc( 'R', 'S', llwork, n, s1, lda, p1, lda, cdumma,
1070  $ ldu, evectr( 1, i1+1 ), ldu, n, in, work,
1071  $ rwork, iinfo )
1072  IF( iinfo.NE.0 ) THEN
1073  WRITE( nounit, fmt = 9999 )'CTGEVC(R,S2)', iinfo, n,
1074  $ jtype, ioldsd
1075  info = abs( iinfo )
1076  GO TO 210
1077  END IF
1078 *
1079  CALL cget52( .false., n, s1, lda, p1, lda, evectr, ldu,
1080  $ alpha1, beta1, work, rwork, dumma( 1 ) )
1081  result( 11 ) = dumma( 1 )
1082  IF( dumma( 2 ).GT.thresh ) THEN
1083  WRITE( nounit, fmt = 9998 )'Right', 'CTGEVC(HOWMNY=S)',
1084  $ dumma( 2 ), n, jtype, ioldsd
1085  END IF
1086 *
1087 * 12: Compute the right eigenvector Matrix with
1088 * back transforming:
1089 *
1090  ntest = 12
1091  result( 12 ) = ulpinv
1092  CALL clacpy( 'F', n, n, z, ldu, evectr, ldu )
1093  CALL ctgevc( 'R', 'B', llwork, n, s1, lda, p1, lda, cdumma,
1094  $ ldu, evectr, ldu, n, in, work, rwork, iinfo )
1095  IF( iinfo.NE.0 ) THEN
1096  WRITE( nounit, fmt = 9999 )'CTGEVC(R,B)', iinfo, n,
1097  $ jtype, ioldsd
1098  info = abs( iinfo )
1099  GO TO 210
1100  END IF
1101 *
1102  CALL cget52( .false., n, h, lda, t, lda, evectr, ldu,
1103  $ alpha1, beta1, work, rwork, dumma( 1 ) )
1104  result( 12 ) = dumma( 1 )
1105  IF( dumma( 2 ).GT.thresh ) THEN
1106  WRITE( nounit, fmt = 9998 )'Right', 'CTGEVC(HOWMNY=B)',
1107  $ dumma( 2 ), n, jtype, ioldsd
1108  END IF
1109 *
1110 * Tests 13--15 are done only on request
1111 *
1112  IF( tstdif ) THEN
1113 *
1114 * Do Tests 13--14
1115 *
1116  CALL cget51( 2, n, s1, lda, s2, lda, q, ldu, z, ldu,
1117  $ work, rwork, result( 13 ) )
1118  CALL cget51( 2, n, p1, lda, p2, lda, q, ldu, z, ldu,
1119  $ work, rwork, result( 14 ) )
1120 *
1121 * Do Test 15
1122 *
1123  temp1 = zero
1124  temp2 = zero
1125  DO 200 j = 1, n
1126  temp1 = max( temp1, abs( alpha1( j )-alpha3( j ) ) )
1127  temp2 = max( temp2, abs( beta1( j )-beta3( j ) ) )
1128  200 CONTINUE
1129 *
1130  temp1 = temp1 / max( safmin, ulp*max( temp1, anorm ) )
1131  temp2 = temp2 / max( safmin, ulp*max( temp2, bnorm ) )
1132  result( 15 ) = max( temp1, temp2 )
1133  ntest = 15
1134  ELSE
1135  result( 13 ) = zero
1136  result( 14 ) = zero
1137  result( 15 ) = zero
1138  ntest = 12
1139  END IF
1140 *
1141 * End of Loop -- Check for RESULT(j) > THRESH
1142 *
1143  210 CONTINUE
1144 *
1145  ntestt = ntestt + ntest
1146 *
1147 * Print out tests which fail.
1148 *
1149  DO 220 jr = 1, ntest
1150  IF( result( jr ).GE.thresh ) THEN
1151 *
1152 * If this is the first test to fail,
1153 * print a header to the data file.
1154 *
1155  IF( nerrs.EQ.0 ) THEN
1156  WRITE( nounit, fmt = 9997 )'CGG'
1157 *
1158 * Matrix types
1159 *
1160  WRITE( nounit, fmt = 9996 )
1161  WRITE( nounit, fmt = 9995 )
1162  WRITE( nounit, fmt = 9994 )'Unitary'
1163 *
1164 * Tests performed
1165 *
1166  WRITE( nounit, fmt = 9993 )'unitary', '*',
1167  $ 'conjugate transpose', ( '*', j = 1, 10 )
1168 *
1169  END IF
1170  nerrs = nerrs + 1
1171  IF( result( jr ).LT.10000.0 ) THEN
1172  WRITE( nounit, fmt = 9992 )n, jtype, ioldsd, jr,
1173  $ result( jr )
1174  ELSE
1175  WRITE( nounit, fmt = 9991 )n, jtype, ioldsd, jr,
1176  $ result( jr )
1177  END IF
1178  END IF
1179  220 CONTINUE
1180 *
1181  230 CONTINUE
1182  240 CONTINUE
1183 *
1184 * Summary
1185 *
1186  CALL slasum( 'CGG', nounit, nerrs, ntestt )
1187  RETURN
1188 *
1189  9999 FORMAT( ' CCHKGG: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1190  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1191 *
1192  9998 FORMAT( ' CCHKGG: ', a, ' Eigenvectors from ', a, ' incorrectly ',
1193  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
1194  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5,
1195  $ ')' )
1196 *
1197  9997 FORMAT( 1x, a3, ' -- Complex Generalized eigenvalue problem' )
1198 *
1199  9996 FORMAT( ' Matrix types (see CCHKGG for details): ' )
1200 *
1201  9995 FORMAT( ' Special Matrices:', 23x,
1202  $ '(J''=transposed Jordan block)',
1203  $ / ' 1=(0,0) 2=(I,0) 3=(0,I) 4=(I,I) 5=(J'',J'') ',
1204  $ '6=(diag(J'',I), diag(I,J''))', / ' Diagonal Matrices: ( ',
1205  $ 'D=diag(0,1,2,...) )', / ' 7=(D,I) 9=(large*D, small*I',
1206  $ ') 11=(large*I, small*D) 13=(large*D, large*I)', /
1207  $ ' 8=(I,D) 10=(small*D, large*I) 12=(small*I, large*D) ',
1208  $ ' 14=(small*D, small*I)', / ' 15=(D, reversed D)' )
1209  9994 FORMAT( ' Matrices Rotated by Random ', a, ' Matrices U, V:',
1210  $ / ' 16=Transposed Jordan Blocks 19=geometric ',
1211  $ 'alpha, beta=0,1', / ' 17=arithm. alpha&beta ',
1212  $ ' 20=arithmetic alpha, beta=0,1', / ' 18=clustered ',
1213  $ 'alpha, beta=0,1 21=random alpha, beta=0,1',
1214  $ / ' Large & Small Matrices:', / ' 22=(large, small) ',
1215  $ '23=(small,large) 24=(small,small) 25=(large,large)',
1216  $ / ' 26=random O(1) matrices.' )
1217 *
1218  9993 FORMAT( / ' Tests performed: (H is Hessenberg, S is Schur, B, ',
1219  $ 'T, P are triangular,', / 20x, 'U, V, Q, and Z are ', a,
1220  $ ', l and r are the', / 20x,
1221  $ 'appropriate left and right eigenvectors, resp., a is',
1222  $ / 20x, 'alpha, b is beta, and ', a, ' means ', a, '.)',
1223  $ / ' 1 = | A - U H V', a,
1224  $ ' | / ( |A| n ulp ) 2 = | B - U T V', a,
1225  $ ' | / ( |B| n ulp )', / ' 3 = | I - UU', a,
1226  $ ' | / ( n ulp ) 4 = | I - VV', a,
1227  $ ' | / ( n ulp )', / ' 5 = | H - Q S Z', a,
1228  $ ' | / ( |H| n ulp )', 6x, '6 = | T - Q P Z', a,
1229  $ ' | / ( |T| n ulp )', / ' 7 = | I - QQ', a,
1230  $ ' | / ( n ulp ) 8 = | I - ZZ', a,
1231  $ ' | / ( n ulp )', / ' 9 = max | ( b S - a P )', a,
1232  $ ' l | / const. 10 = max | ( b H - a T )', a,
1233  $ ' l | / const.', /
1234  $ ' 11= max | ( b S - a P ) r | / const. 12 = max | ( b H',
1235  $ ' - a T ) r | / const.', / 1x )
1236 *
1237  9992 FORMAT( ' Matrix order=', i5, ', type=', i2, ', seed=',
1238  $ 4( i4, ',' ), ' result ', i2, ' is', 0p, f8.2 )
1239  9991 FORMAT( ' Matrix order=', i5, ', type=', i2, ', seed=',
1240  $ 4( i4, ',' ), ' result ', i2, ' is', 1p, e10.3 )
1241 *
1242 * End of CCHKGG
1243 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:77
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine cget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
CGET52
Definition: cget52.f:163
subroutine ctgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTGEVC
Definition: ctgevc.f:221
subroutine cgeqr2(M, N, A, LDA, TAU, WORK, INFO)
CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
Definition: cgeqr2.f:123
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
Definition: clarfg.f:108
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine clatm4(ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
CLATM4
Definition: clatm4.f:173
subroutine cgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
CGGHRD
Definition: cgghrd.f:206
subroutine chgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
CHGEQZ
Definition: chgeqz.f:286
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
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:117
subroutine cget51(ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
CGET51
Definition: cget51.f:156
subroutine cunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
CUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition: cunm2r.f:161

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkgk ( integer  NIN,
integer  NOUT 
)

CCHKGK

Purpose:
 CCHKGK tests CGGBAK, a routine for backward balancing  of
 a matrix pair (A, B).
Parameters
[in]NIN
          NIN is INTEGER
          The logical unit number for input.  NIN > 0.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.  NOUT > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 56 of file cchkgk.f.

56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  INTEGER nin, nout
64 * ..
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69  INTEGER lda, ldb, ldvl, ldvr
70  parameter( lda = 50, ldb = 50, ldvl = 50, ldvr = 50 )
71  INTEGER lde, ldf, ldwork, lrwork
72  parameter( lde = 50, ldf = 50, ldwork = 50,
73  $ lrwork = 6*50 )
74  REAL zero
75  parameter( zero = 0.0e+0 )
76  COMPLEX czero, cone
77  parameter( czero = ( 0.0e+0, 0.0e+0 ),
78  $ cone = ( 1.0e+0, 0.0e+0 ) )
79 * ..
80 * .. Local Scalars ..
81  INTEGER i, ihi, ilo, info, j, knt, m, n, ninfo
82  REAL anorm, bnorm, eps, rmax, vmax
83  COMPLEX cdum
84 * ..
85 * .. Local Arrays ..
86  INTEGER lmax( 4 )
87  REAL lscale( lda ), rscale( lda ), rwork( lrwork )
88  COMPLEX a( lda, lda ), af( lda, lda ), b( ldb, ldb ),
89  $ bf( ldb, ldb ), e( lde, lde ), f( ldf, ldf ),
90  $ vl( ldvl, ldvl ), vlf( ldvl, ldvl ),
91  $ vr( ldvr, ldvr ), vrf( ldvr, ldvr ),
92  $ work( ldwork, ldwork )
93 * ..
94 * .. External Functions ..
95  REAL clange, slamch
96  EXTERNAL clange, slamch
97 * ..
98 * .. External Subroutines ..
99  EXTERNAL cgemm, cggbak, cggbal, clacpy
100 * ..
101 * .. Intrinsic Functions ..
102  INTRINSIC abs, aimag, max, real
103 * ..
104 * .. Statement Functions ..
105  REAL cabs1
106 * ..
107 * .. Statement Function definitions ..
108  cabs1( cdum ) = abs( REAL( CDUM ) ) + abs( aimag( cdum ) )
109 * ..
110 * .. Executable Statements ..
111 *
112  lmax( 1 ) = 0
113  lmax( 2 ) = 0
114  lmax( 3 ) = 0
115  lmax( 4 ) = 0
116  ninfo = 0
117  knt = 0
118  rmax = zero
119 *
120  eps = slamch( 'Precision' )
121 *
122  10 CONTINUE
123  READ( nin, fmt = * )n, m
124  IF( n.EQ.0 )
125  $ GO TO 100
126 *
127  DO 20 i = 1, n
128  READ( nin, fmt = * )( a( i, j ), j = 1, n )
129  20 CONTINUE
130 *
131  DO 30 i = 1, n
132  READ( nin, fmt = * )( b( i, j ), j = 1, n )
133  30 CONTINUE
134 *
135  DO 40 i = 1, n
136  READ( nin, fmt = * )( vl( i, j ), j = 1, m )
137  40 CONTINUE
138 *
139  DO 50 i = 1, n
140  READ( nin, fmt = * )( vr( i, j ), j = 1, m )
141  50 CONTINUE
142 *
143  knt = knt + 1
144 *
145  anorm = clange( 'M', n, n, a, lda, rwork )
146  bnorm = clange( 'M', n, n, b, ldb, rwork )
147 *
148  CALL clacpy( 'FULL', n, n, a, lda, af, lda )
149  CALL clacpy( 'FULL', n, n, b, ldb, bf, ldb )
150 *
151  CALL cggbal( 'B', n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
152  $ rwork, info )
153  IF( info.NE.0 ) THEN
154  ninfo = ninfo + 1
155  lmax( 1 ) = knt
156  END IF
157 *
158  CALL clacpy( 'FULL', n, m, vl, ldvl, vlf, ldvl )
159  CALL clacpy( 'FULL', n, m, vr, ldvr, vrf, ldvr )
160 *
161  CALL cggbak( 'B', 'L', n, ilo, ihi, lscale, rscale, m, vl, ldvl,
162  $ info )
163  IF( info.NE.0 ) THEN
164  ninfo = ninfo + 1
165  lmax( 2 ) = knt
166  END IF
167 *
168  CALL cggbak( 'B', 'R', n, ilo, ihi, lscale, rscale, m, vr, ldvr,
169  $ info )
170  IF( info.NE.0 ) THEN
171  ninfo = ninfo + 1
172  lmax( 3 ) = knt
173  END IF
174 *
175 * Test of CGGBAK
176 *
177 * Check tilde(VL)'*A*tilde(VR) - VL'*tilde(A)*VR
178 * where tilde(A) denotes the transformed matrix.
179 *
180  CALL cgemm( 'N', 'N', n, m, n, cone, af, lda, vr, ldvr, czero,
181  $ work, ldwork )
182  CALL cgemm( 'C', 'N', m, m, n, cone, vl, ldvl, work, ldwork,
183  $ czero, e, lde )
184 *
185  CALL cgemm( 'N', 'N', n, m, n, cone, a, lda, vrf, ldvr, czero,
186  $ work, ldwork )
187  CALL cgemm( 'C', 'N', m, m, n, cone, vlf, ldvl, work, ldwork,
188  $ czero, f, ldf )
189 *
190  vmax = zero
191  DO 70 j = 1, m
192  DO 60 i = 1, m
193  vmax = max( vmax, cabs1( e( i, j )-f( i, j ) ) )
194  60 CONTINUE
195  70 CONTINUE
196  vmax = vmax / ( eps*max( anorm, bnorm ) )
197  IF( vmax.GT.rmax ) THEN
198  lmax( 4 ) = knt
199  rmax = vmax
200  END IF
201 *
202 * Check tilde(VL)'*B*tilde(VR) - VL'*tilde(B)*VR
203 *
204  CALL cgemm( 'N', 'N', n, m, n, cone, bf, ldb, vr, ldvr, czero,
205  $ work, ldwork )
206  CALL cgemm( 'C', 'N', m, m, n, cone, vl, ldvl, work, ldwork,
207  $ czero, e, lde )
208 *
209  CALL cgemm( 'n', 'n', n, m, n, cone, b, ldb, vrf, ldvr, czero,
210  $ work, ldwork )
211  CALL cgemm( 'C', 'N', m, m, n, cone, vlf, ldvl, work, ldwork,
212  $ czero, f, ldf )
213 *
214  vmax = zero
215  DO 90 j = 1, m
216  DO 80 i = 1, m
217  vmax = max( vmax, cabs1( e( i, j )-f( i, j ) ) )
218  80 CONTINUE
219  90 CONTINUE
220  vmax = vmax / ( eps*max( anorm, bnorm ) )
221  IF( vmax.GT.rmax ) THEN
222  lmax( 4 ) = knt
223  rmax = vmax
224  END IF
225 *
226  GO TO 10
227 *
228  100 CONTINUE
229 *
230  WRITE( nout, fmt = 9999 )
231  9999 FORMAT( 1x, '.. test output of CGGBAK .. ' )
232 *
233  WRITE( nout, fmt = 9998 )rmax
234  9998 FORMAT( ' value of largest test error =', e12.3 )
235  WRITE( nout, fmt = 9997 )lmax( 1 )
236  9997 FORMAT( ' example number where CGGBAL info is not 0 =', i4 )
237  WRITE( nout, fmt = 9996 )lmax( 2 )
238  9996 FORMAT( ' example number where CGGBAK(L) info is not 0 =', i4 )
239  WRITE( nout, fmt = 9995 )lmax( 3 )
240  9995 FORMAT( ' example number where CGGBAK(R) info is not 0 =', i4 )
241  WRITE( nout, fmt = 9994 )lmax( 4 )
242  9994 FORMAT( ' example number having largest error =', i4 )
243  WRITE( nout, fmt = 9992 )ninfo
244  9992 FORMAT( ' number of examples where info is not 0 =', i4 )
245  WRITE( nout, fmt = 9991 )knt
246  9991 FORMAT( ' total number of examples tested =', i4 )
247 *
248  RETURN
249 *
250 * End of CCHKGK
251 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:189
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
Definition: cggbal.f:179
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
Definition: cggbak.f:150
logical function lde(RI, RJ, LR)
Definition: dblat2.f:2945
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:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkgl ( integer  NIN,
integer  NOUT 
)

CCHKGL

Purpose:
 CCHKGL tests CGGBAL, a routine for balancing a matrix pair (A, B).
Parameters
[in]NIN
          NIN is INTEGER
          The logical unit number for input.  NIN > 0.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.  NOUT > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 55 of file cchkgl.f.

55 *
56 * -- LAPACK test routine (version 3.4.0) --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 * November 2011
60 *
61 * .. Scalar Arguments ..
62  INTEGER nin, nout
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER lda, ldb, lwork
69  parameter( lda = 20, ldb = 20, lwork = 6*lda )
70  REAL zero
71  parameter( zero = 0.0e+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
75  $ ninfo
76  REAL anorm, bnorm, eps, rmax, vmax
77 * ..
78 * .. Local Arrays ..
79  INTEGER lmax( 3 )
80  REAL lscale( lda ), lsclin( lda ), rscale( lda ),
81  $ rsclin( lda ), work( lwork )
82  COMPLEX a( lda, lda ), ain( lda, lda ), b( ldb, ldb ),
83  $ bin( ldb, ldb )
84 * ..
85 * .. External Functions ..
86  REAL clange, slamch
87  EXTERNAL clange, slamch
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL cggbal
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, max
94 * ..
95 * .. Executable Statements ..
96 *
97  lmax( 1 ) = 0
98  lmax( 2 ) = 0
99  lmax( 3 ) = 0
100  ninfo = 0
101  knt = 0
102  rmax = zero
103 *
104  eps = slamch( 'Precision' )
105 *
106  10 CONTINUE
107 *
108  READ( nin, fmt = * )n
109  IF( n.EQ.0 )
110  $ GO TO 90
111  DO 20 i = 1, n
112  READ( nin, fmt = * )( a( i, j ), j = 1, n )
113  20 CONTINUE
114 *
115  DO 30 i = 1, n
116  READ( nin, fmt = * )( b( i, j ), j = 1, n )
117  30 CONTINUE
118 *
119  READ( nin, fmt = * )iloin, ihiin
120  DO 40 i = 1, n
121  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
122  40 CONTINUE
123  DO 50 i = 1, n
124  READ( nin, fmt = * )( bin( i, j ), j = 1, n )
125  50 CONTINUE
126 *
127  READ( nin, fmt = * )( lsclin( i ), i = 1, n )
128  READ( nin, fmt = * )( rsclin( i ), i = 1, n )
129 *
130  anorm = clange( 'M', n, n, a, lda, work )
131  bnorm = clange( 'M', n, n, b, ldb, work )
132 *
133  knt = knt + 1
134 *
135  CALL cggbal( 'B', n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
136  $ work, info )
137 *
138  IF( info.NE.0 ) THEN
139  ninfo = ninfo + 1
140  lmax( 1 ) = knt
141  END IF
142 *
143  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
144  ninfo = ninfo + 1
145  lmax( 2 ) = knt
146  END IF
147 *
148  vmax = zero
149  DO 70 i = 1, n
150  DO 60 j = 1, n
151  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) )
152  vmax = max( vmax, abs( b( i, j )-bin( i, j ) ) )
153  60 CONTINUE
154  70 CONTINUE
155 *
156  DO 80 i = 1, n
157  vmax = max( vmax, abs( lscale( i )-lsclin( i ) ) )
158  vmax = max( vmax, abs( rscale( i )-rsclin( i ) ) )
159  80 CONTINUE
160 *
161  vmax = vmax / ( eps*max( anorm, bnorm ) )
162 *
163  IF( vmax.GT.rmax ) THEN
164  lmax( 3 ) = knt
165  rmax = vmax
166  END IF
167 *
168  GO TO 10
169 *
170  90 CONTINUE
171 *
172  WRITE( nout, fmt = 9999 )
173  9999 FORMAT( ' .. test output of CGGBAL .. ' )
174 *
175  WRITE( nout, fmt = 9998 )rmax
176  9998 FORMAT( ' ratio of largest test error = ', e12.3 )
177  WRITE( nout, fmt = 9997 )lmax( 1 )
178  9997 FORMAT( ' example number where info is not zero = ', i4 )
179  WRITE( nout, fmt = 9996 )lmax( 2 )
180  9996 FORMAT( ' example number where ILO or IHI is wrong = ', i4 )
181  WRITE( nout, fmt = 9995 )lmax( 3 )
182  9995 FORMAT( ' example number having largest error = ', i4 )
183  WRITE( nout, fmt = 9994 )ninfo
184  9994 FORMAT( ' number of examples where info is not 0 = ', i4 )
185  WRITE( nout, fmt = 9993 )knt
186  9993 FORMAT( ' total number of examples tested = ', i4 )
187 *
188  RETURN
189 *
190 * End of CCHKGL
191 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
Definition: cggbal.f:179
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:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkhb ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NWDTHS,
integer, dimension( * )  KK,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  SD,
real, dimension( * )  SE,
complex, dimension( ldu, * )  U,
integer  LDU,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
real, dimension( * )  RESULT,
integer  INFO 
)

CCHKHB

Purpose:
 CCHKHB tests the reduction of a Hermitian band matrix to tridiagonal
 from, used with the Hermitian eigenvalue problem.

 CHBTRD factors a Hermitian band matrix A as  U S U* , where * means
 conjugate transpose, S is symmetric tridiagonal, and U is unitary.
 CHBTRD can use either just the lower or just the upper triangle
 of A; CCHKHB checks both cases.

 When CCHKHB is called, a number of matrix "sizes" ("n's"), a number
 of bandwidths ("k's"), and a number of matrix "types" are
 specified.  For each size ("n"), each bandwidth ("k") less than or
 equal to "n", and each type of matrix, one matrix will be generated
 and used to test the hermitian banded reduction routine.  For each
 matrix, a number of tests will be performed:

 (1)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
                                         UPLO='U'

 (2)     | I - UU* | / ( n ulp )

 (3)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
                                         UPLO='L'

 (4)     | I - UU* | / ( n ulp )

 The "sizes" are specified by an array NN(1:NSIZES); the value of
 each element NN(j) specifies one size.
 The "types" are specified by a logical array DOTYPE( 1:NTYPES );
 if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
 Currently, the list of possible types is:

 (1)  The zero matrix.
 (2)  The identity matrix.

 (3)  A diagonal matrix with evenly spaced entries
      1, ..., ULP  and random signs.
      (ULP = (first number larger than 1) - 1 )
 (4)  A diagonal matrix with geometrically spaced entries
      1, ..., ULP  and random signs.
 (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
      and random signs.

 (6)  Same as (4), but multiplied by SQRT( overflow threshold )
 (7)  Same as (4), but multiplied by SQRT( underflow threshold )

 (8)  A matrix of the form  U* D U, where U is unitary and
      D has evenly spaced entries 1, ..., ULP with random signs
      on the diagonal.

 (9)  A matrix of the form  U* D U, where U is unitary and
      D has geometrically spaced entries 1, ..., ULP with random
      signs on the diagonal.

 (10) A matrix of the form  U* D U, where U is unitary and
      D has "clustered" entries 1, ULP,..., ULP with random
      signs on the diagonal.

 (11) Same as (8), but multiplied by SQRT( overflow threshold )
 (12) Same as (8), but multiplied by SQRT( underflow threshold )

 (13) Hermitian matrix with random entries chosen from (-1,1).
 (14) Same as (13), but multiplied by SQRT( overflow threshold )
 (15) Same as (13), but multiplied by SQRT( underflow threshold )
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          CCHKHB does nothing.  It must be at least zero.
[in]NN
          NN is INTEGER array, dimension (NSIZES)
          An array containing the sizes to be used for the matrices.
          Zero values will be skipped.  The values must be at least
          zero.
[in]NWDTHS
          NWDTHS is INTEGER
          The number of bandwidths to use.  If it is zero,
          CCHKHB does nothing.  It must be at least zero.
[in]KK
          KK is INTEGER array, dimension (NWDTHS)
          An array containing the bandwidths to be used for the band
          matrices.  The values must be at least zero.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, CCHKHB
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrix is in A.  This
          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size in NN a
          matrix of that size and of type j will be generated.
          If NTYPES is smaller than the maximum number of types
          defined (PARAMETER MAXTYP), then types NTYPES+1 through
          MAXTYP will not be generated.  If NTYPES is larger
          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
          will be ignored.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator. The array elements should be between 0 and 4095;
          if not they will be reduced mod 4096.  Also, ISEED(4) must
          be odd.  The random number generator uses a linear
          congruential sequence limited to small integers, and so
          should produce machine independent random numbers. The
          values of ISEED are changed on exit, and can be used in the
          next call to CCHKHB to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is COMPLEX array, dimension
                            (LDA, max(NN))
          Used to hold the matrix whose eigenvalues are to be
          computed.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at least 2 (not 1!)
          and at least max( KK )+1.
[out]SD
          SD is REAL array, dimension (max(NN))
          Used to hold the diagonal of the tridiagonal matrix computed
          by CHBTRD.
[out]SE
          SE is REAL array, dimension (max(NN))
          Used to hold the off-diagonal of the tridiagonal matrix
          computed by CHBTRD.
[out]U
          U is COMPLEX array, dimension (LDU, max(NN))
          Used to hold the unitary matrix computed by CHBTRD.
[in]LDU
          LDU is INTEGER
          The leading dimension of U.  It must be at least 1
          and at least max( NN ).
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max( LDA+1, max(NN)+1 )*max(NN).
[out]RWORK
          RWORK is REAL array
[out]RESULT
          RESULT is REAL array, dimension (4)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.

-----------------------------------------------------------------------

       Some Local Variables and Parameters:
       ---- ----- --------- --- ----------
       ZERO, ONE       Real 0 and 1.
       MAXTYP          The number of types defined.
       NTEST           The number of tests performed, or which can
                       be performed so far, for the current matrix.
       NTESTT          The total number of tests performed so far.
       NMAX            Largest value in NN.
       NMATS           The number of matrices generated so far.
       NERRS           The number of tests which have exceeded THRESH
                       so far.
       COND, IMODE     Values to be passed to the matrix generators.
       ANORM           Norm of A; passed to matrix generators.

       OVFL, UNFL      Overflow and underflow thresholds.
       ULP, ULPINV     Finest relative precision and its inverse.
       RTOVFL, RTUNFL  Square roots of the previous 2 values.
               The following four arrays decode JTYPE:
       KTYPE(j)        The general type (1-10) for type "j".
       KMODE(j)        The MODE value to be passed to the matrix
                       generator for type "j".
       KMAGN(j)        The order of magnitude ( O(1),
                       O(overflow^(1/2) ), O(underflow^(1/2) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 300 of file cchkhb.f.

300 *
301 * -- LAPACK test routine (version 3.4.0) --
302 * -- LAPACK is a software package provided by Univ. of Tennessee, --
303 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
304 * November 2011
305 *
306 * .. Scalar Arguments ..
307  INTEGER info, lda, ldu, lwork, nounit, nsizes, ntypes,
308  $ nwdths
309  REAL thresh
310 * ..
311 * .. Array Arguments ..
312  LOGICAL dotype( * )
313  INTEGER iseed( 4 ), kk( * ), nn( * )
314  REAL result( * ), rwork( * ), sd( * ), se( * )
315  COMPLEX a( lda, * ), u( ldu, * ), work( * )
316 * ..
317 *
318 * =====================================================================
319 *
320 * .. Parameters ..
321  COMPLEX czero, cone
322  parameter( czero = ( 0.0e+0, 0.0e+0 ),
323  $ cone = ( 1.0e+0, 0.0e+0 ) )
324  REAL zero, one, two, ten
325  parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0,
326  $ ten = 10.0e+0 )
327  REAL half
328  parameter( half = one / two )
329  INTEGER maxtyp
330  parameter( maxtyp = 15 )
331 * ..
332 * .. Local Scalars ..
333  LOGICAL badnn, badnnb
334  INTEGER i, iinfo, imode, itype, j, jc, jcol, jr, jsize,
335  $ jtype, jwidth, k, kmax, mtypes, n, nerrs,
336  $ nmats, nmax, ntest, ntestt
337  REAL aninv, anorm, cond, ovfl, rtovfl, rtunfl,
338  $ temp1, ulp, ulpinv, unfl
339 * ..
340 * .. Local Arrays ..
341  INTEGER idumma( 1 ), ioldsd( 4 ), kmagn( maxtyp ),
342  $ kmode( maxtyp ), ktype( maxtyp )
343 * ..
344 * .. External Functions ..
345  REAL slamch
346  EXTERNAL slamch
347 * ..
348 * .. External Subroutines ..
349  EXTERNAL chbt21, chbtrd, clacpy, clatmr, clatms, claset,
350  $ slasum, xerbla
351 * ..
352 * .. Intrinsic Functions ..
353  INTRINSIC abs, conjg, max, min, REAL, sqrt
354 * ..
355 * .. Data statements ..
356  DATA ktype / 1, 2, 5*4, 5*5, 3*8 /
357  DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
358  $ 2, 3 /
359  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
360  $ 0, 0 /
361 * ..
362 * .. Executable Statements ..
363 *
364 * Check for errors
365 *
366  ntestt = 0
367  info = 0
368 *
369 * Important constants
370 *
371  badnn = .false.
372  nmax = 1
373  DO 10 j = 1, nsizes
374  nmax = max( nmax, nn( j ) )
375  IF( nn( j ).LT.0 )
376  $ badnn = .true.
377  10 CONTINUE
378 *
379  badnnb = .false.
380  kmax = 0
381  DO 20 j = 1, nsizes
382  kmax = max( kmax, kk( j ) )
383  IF( kk( j ).LT.0 )
384  $ badnnb = .true.
385  20 CONTINUE
386  kmax = min( nmax-1, kmax )
387 *
388 * Check for errors
389 *
390  IF( nsizes.LT.0 ) THEN
391  info = -1
392  ELSE IF( badnn ) THEN
393  info = -2
394  ELSE IF( nwdths.LT.0 ) THEN
395  info = -3
396  ELSE IF( badnnb ) THEN
397  info = -4
398  ELSE IF( ntypes.LT.0 ) THEN
399  info = -5
400  ELSE IF( lda.LT.kmax+1 ) THEN
401  info = -11
402  ELSE IF( ldu.LT.nmax ) THEN
403  info = -15
404  ELSE IF( ( max( lda, nmax )+1 )*nmax.GT.lwork ) THEN
405  info = -17
406  END IF
407 *
408  IF( info.NE.0 ) THEN
409  CALL xerbla( 'CCHKHB', -info )
410  RETURN
411  END IF
412 *
413 * Quick return if possible
414 *
415  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
416  $ RETURN
417 *
418 * More Important constants
419 *
420  unfl = slamch( 'Safe minimum' )
421  ovfl = one / unfl
422  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
423  ulpinv = one / ulp
424  rtunfl = sqrt( unfl )
425  rtovfl = sqrt( ovfl )
426 *
427 * Loop over sizes, types
428 *
429  nerrs = 0
430  nmats = 0
431 *
432  DO 190 jsize = 1, nsizes
433  n = nn( jsize )
434  aninv = one / REAL( MAX( 1, N ) )
435 *
436  DO 180 jwidth = 1, nwdths
437  k = kk( jwidth )
438  IF( k.GT.n )
439  $ GO TO 180
440  k = max( 0, min( n-1, k ) )
441 *
442  IF( nsizes.NE.1 ) THEN
443  mtypes = min( maxtyp, ntypes )
444  ELSE
445  mtypes = min( maxtyp+1, ntypes )
446  END IF
447 *
448  DO 170 jtype = 1, mtypes
449  IF( .NOT.dotype( jtype ) )
450  $ GO TO 170
451  nmats = nmats + 1
452  ntest = 0
453 *
454  DO 30 j = 1, 4
455  ioldsd( j ) = iseed( j )
456  30 CONTINUE
457 *
458 * Compute "A".
459 * Store as "Upper"; later, we will copy to other format.
460 *
461 * Control parameters:
462 *
463 * KMAGN KMODE KTYPE
464 * =1 O(1) clustered 1 zero
465 * =2 large clustered 2 identity
466 * =3 small exponential (none)
467 * =4 arithmetic diagonal, (w/ eigenvalues)
468 * =5 random log hermitian, w/ eigenvalues
469 * =6 random (none)
470 * =7 random diagonal
471 * =8 random hermitian
472 * =9 positive definite
473 * =10 diagonally dominant tridiagonal
474 *
475  IF( mtypes.GT.maxtyp )
476  $ GO TO 100
477 *
478  itype = ktype( jtype )
479  imode = kmode( jtype )
480 *
481 * Compute norm
482 *
483  GO TO ( 40, 50, 60 )kmagn( jtype )
484 *
485  40 CONTINUE
486  anorm = one
487  GO TO 70
488 *
489  50 CONTINUE
490  anorm = ( rtovfl*ulp )*aninv
491  GO TO 70
492 *
493  60 CONTINUE
494  anorm = rtunfl*n*ulpinv
495  GO TO 70
496 *
497  70 CONTINUE
498 *
499  CALL claset( 'Full', lda, n, czero, czero, a, lda )
500  iinfo = 0
501  IF( jtype.LE.15 ) THEN
502  cond = ulpinv
503  ELSE
504  cond = ulpinv*aninv / ten
505  END IF
506 *
507 * Special Matrices -- Identity & Jordan block
508 *
509 * Zero
510 *
511  IF( itype.EQ.1 ) THEN
512  iinfo = 0
513 *
514  ELSE IF( itype.EQ.2 ) THEN
515 *
516 * Identity
517 *
518  DO 80 jcol = 1, n
519  a( k+1, jcol ) = anorm
520  80 CONTINUE
521 *
522  ELSE IF( itype.EQ.4 ) THEN
523 *
524 * Diagonal Matrix, [Eigen]values Specified
525 *
526  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode,
527  $ cond, anorm, 0, 0, 'Q', a( k+1, 1 ), lda,
528  $ work, iinfo )
529 *
530  ELSE IF( itype.EQ.5 ) THEN
531 *
532 * Hermitian, eigenvalues specified
533 *
534  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode,
535  $ cond, anorm, k, k, 'Q', a, lda, work,
536  $ iinfo )
537 *
538  ELSE IF( itype.EQ.7 ) THEN
539 *
540 * Diagonal, random eigenvalues
541 *
542  CALL clatmr( n, n, 'S', iseed, 'H', work, 6, one,
543  $ cone, 'T', 'N', work( n+1 ), 1, one,
544  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
545  $ zero, anorm, 'Q', a( k+1, 1 ), lda,
546  $ idumma, iinfo )
547 *
548  ELSE IF( itype.EQ.8 ) THEN
549 *
550 * Hermitian, random eigenvalues
551 *
552  CALL clatmr( n, n, 'S', iseed, 'H', work, 6, one,
553  $ cone, 'T', 'N', work( n+1 ), 1, one,
554  $ work( 2*n+1 ), 1, one, 'N', idumma, k, k,
555  $ zero, anorm, 'Q', a, lda, idumma, iinfo )
556 *
557  ELSE IF( itype.EQ.9 ) THEN
558 *
559 * Positive definite, eigenvalues specified.
560 *
561  CALL clatms( n, n, 'S', iseed, 'P', rwork, imode,
562  $ cond, anorm, k, k, 'Q', a, lda,
563  $ work( n+1 ), iinfo )
564 *
565  ELSE IF( itype.EQ.10 ) THEN
566 *
567 * Positive definite tridiagonal, eigenvalues specified.
568 *
569  IF( n.GT.1 )
570  $ k = max( 1, k )
571  CALL clatms( n, n, 'S', iseed, 'P', rwork, imode,
572  $ cond, anorm, 1, 1, 'Q', a( k, 1 ), lda,
573  $ work, iinfo )
574  DO 90 i = 2, n
575  temp1 = abs( a( k, i ) ) /
576  $ sqrt( abs( a( k+1, i-1 )*a( k+1, i ) ) )
577  IF( temp1.GT.half ) THEN
578  a( k, i ) = half*sqrt( abs( a( k+1,
579  $ i-1 )*a( k+1, i ) ) )
580  END IF
581  90 CONTINUE
582 *
583  ELSE
584 *
585  iinfo = 1
586  END IF
587 *
588  IF( iinfo.NE.0 ) THEN
589  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n,
590  $ jtype, ioldsd
591  info = abs( iinfo )
592  RETURN
593  END IF
594 *
595  100 CONTINUE
596 *
597 * Call CHBTRD to compute S and U from upper triangle.
598 *
599  CALL clacpy( ' ', k+1, n, a, lda, work, lda )
600 *
601  ntest = 1
602  CALL chbtrd( 'V', 'U', n, k, work, lda, sd, se, u, ldu,
603  $ work( lda*n+1 ), iinfo )
604 *
605  IF( iinfo.NE.0 ) THEN
606  WRITE( nounit, fmt = 9999 )'CHBTRD(U)', iinfo, n,
607  $ jtype, ioldsd
608  info = abs( iinfo )
609  IF( iinfo.LT.0 ) THEN
610  RETURN
611  ELSE
612  result( 1 ) = ulpinv
613  GO TO 150
614  END IF
615  END IF
616 *
617 * Do tests 1 and 2
618 *
619  CALL chbt21( 'Upper', n, k, 1, a, lda, sd, se, u, ldu,
620  $ work, rwork, result( 1 ) )
621 *
622 * Convert A from Upper-Triangle-Only storage to
623 * Lower-Triangle-Only storage.
624 *
625  DO 120 jc = 1, n
626  DO 110 jr = 0, min( k, n-jc )
627  a( jr+1, jc ) = conjg( a( k+1-jr, jc+jr ) )
628  110 CONTINUE
629  120 CONTINUE
630  DO 140 jc = n + 1 - k, n
631  DO 130 jr = min( k, n-jc ) + 1, k
632  a( jr+1, jc ) = zero
633  130 CONTINUE
634  140 CONTINUE
635 *
636 * Call CHBTRD to compute S and U from lower triangle
637 *
638  CALL clacpy( ' ', k+1, n, a, lda, work, lda )
639 *
640  ntest = 3
641  CALL chbtrd( 'V', 'L', n, k, work, lda, sd, se, u, ldu,
642  $ work( lda*n+1 ), iinfo )
643 *
644  IF( iinfo.NE.0 ) THEN
645  WRITE( nounit, fmt = 9999 )'CHBTRD(L)', iinfo, n,
646  $ jtype, ioldsd
647  info = abs( iinfo )
648  IF( iinfo.LT.0 ) THEN
649  RETURN
650  ELSE
651  result( 3 ) = ulpinv
652  GO TO 150
653  END IF
654  END IF
655  ntest = 4
656 *
657 * Do tests 3 and 4
658 *
659  CALL chbt21( 'Lower', n, k, 1, a, lda, sd, se, u, ldu,
660  $ work, rwork, result( 3 ) )
661 *
662 * End of Loop -- Check for RESULT(j) > THRESH
663 *
664  150 CONTINUE
665  ntestt = ntestt + ntest
666 *
667 * Print out tests which fail.
668 *
669  DO 160 jr = 1, ntest
670  IF( result( jr ).GE.thresh ) THEN
671 *
672 * If this is the first test to fail,
673 * print a header to the data file.
674 *
675  IF( nerrs.EQ.0 ) THEN
676  WRITE( nounit, fmt = 9998 )'CHB'
677  WRITE( nounit, fmt = 9997 )
678  WRITE( nounit, fmt = 9996 )
679  WRITE( nounit, fmt = 9995 )'Hermitian'
680  WRITE( nounit, fmt = 9994 )'unitary', '*',
681  $ 'conjugate transpose', ( '*', j = 1, 4 )
682  END IF
683  nerrs = nerrs + 1
684  WRITE( nounit, fmt = 9993 )n, k, ioldsd, jtype,
685  $ jr, result( jr )
686  END IF
687  160 CONTINUE
688 *
689  170 CONTINUE
690  180 CONTINUE
691  190 CONTINUE
692 *
693 * Summary
694 *
695  CALL slasum( 'CHB', nounit, nerrs, ntestt )
696  RETURN
697 *
698  9999 FORMAT( ' CCHKHB: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
699  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
700  9998 FORMAT( / 1x, a3,
701  $ ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
702  $ )
703  9997 FORMAT( ' Matrix types (see SCHK23 for details): ' )
704 *
705  9996 FORMAT( / ' Special Matrices:',
706  $ / ' 1=Zero matrix. ',
707  $ ' 5=Diagonal: clustered entries.',
708  $ / ' 2=Identity matrix. ',
709  $ ' 6=Diagonal: large, evenly spaced.',
710  $ / ' 3=Diagonal: evenly spaced entries. ',
711  $ ' 7=Diagonal: small, evenly spaced.',
712  $ / ' 4=Diagonal: geometr. spaced entries.' )
713  9995 FORMAT( ' Dense ', a, ' Banded Matrices:',
714  $ / ' 8=Evenly spaced eigenvals. ',
715  $ ' 12=Small, evenly spaced eigenvals.',
716  $ / ' 9=Geometrically spaced eigenvals. ',
717  $ ' 13=Matrix with random O(1) entries.',
718  $ / ' 10=Clustered eigenvalues. ',
719  $ ' 14=Matrix with large random entries.',
720  $ / ' 11=Large, evenly spaced eigenvals. ',
721  $ ' 15=Matrix with small random entries.' )
722 *
723  9994 FORMAT( / ' Tests performed: (S is Tridiag, U is ', a, ',',
724  $ / 20x, a, ' means ', a, '.', / ' UPLO=''U'':',
725  $ / ' 1= | A - U S U', a1, ' | / ( |A| n ulp ) ',
726  $ ' 2= | I - U U', a1, ' | / ( n ulp )', / ' UPLO=''L'':',
727  $ / ' 3= | A - U S U', a1, ' | / ( |A| n ulp ) ',
728  $ ' 4= | I - U U', a1, ' | / ( n ulp )' )
729  9993 FORMAT( ' N=', i5, ', K=', i4, ', seed=', 4( i4, ',' ), ' type ',
730  $ i2, ', test(', i2, ')=', g10.3 )
731 *
732 * End of CCHKHB
733 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
Definition: chbtrd.f:165
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine chbt21(UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RWORK, RESULT)
CHBT21
Definition: chbt21.f:152

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkhs ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( lda, * )  H,
complex, dimension( lda, * )  T1,
complex, dimension( lda, * )  T2,
complex, dimension( ldu, * )  U,
integer  LDU,
complex, dimension( ldu, * )  Z,
complex, dimension( ldu, * )  UZ,
complex, dimension( * )  W1,
complex, dimension( * )  W3,
complex, dimension( ldu, * )  EVECTL,
complex, dimension( ldu, * )  EVECTR,
complex, dimension( ldu, * )  EVECTY,
complex, dimension( ldu, * )  EVECTX,
complex, dimension( ldu, * )  UU,
complex, dimension( * )  TAU,
complex, dimension( * )  WORK,
integer  NWORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
logical, dimension( * )  SELECT,
real, dimension( 14 )  RESULT,
integer  INFO 
)

CCHKHS

Purpose:
    CCHKHS  checks the nonsymmetric eigenvalue problem routines.

            CGEHRD factors A as  U H U' , where ' means conjugate
            transpose, H is hessenberg, and U is unitary.

            CUNGHR generates the unitary matrix U.

            CUNMHR multiplies a matrix by the unitary matrix U.

            CHSEQR factors H as  Z T Z' , where Z is unitary and T
            is upper triangular.  It also computes the eigenvalues,
            w(1), ..., w(n); we define a diagonal matrix W whose
            (diagonal) entries are the eigenvalues.

            CTREVC computes the left eigenvector matrix L and the
            right eigenvector matrix R for the matrix T.  The
            columns of L are the complex conjugates of the left
            eigenvectors of T.  The columns of R are the right
            eigenvectors of T.  L is lower triangular, and R is
            upper triangular.

            CHSEIN computes the left eigenvector matrix Y and the
            right eigenvector matrix X for the matrix H.  The
            columns of Y are the complex conjugates of the left
            eigenvectors of H.  The columns of X are the right
            eigenvectors of H.  Y is lower triangular, and X is
            upper triangular.

    When CCHKHS is called, a number of matrix "sizes" ("n's") and a
    number of matrix "types" are specified.  For each size ("n")
    and each type of matrix, one matrix will be generated and used
    to test the nonsymmetric eigenroutines.  For each matrix, 14
    tests will be performed:

    (1)     | A - U H U**H | / ( |A| n ulp )

    (2)     | I - UU**H | / ( n ulp )

    (3)     | H - Z T Z**H | / ( |H| n ulp )

    (4)     | I - ZZ**H | / ( n ulp )

    (5)     | A - UZ H (UZ)**H | / ( |A| n ulp )

    (6)     | I - UZ (UZ)**H | / ( n ulp )

    (7)     | T(Z computed) - T(Z not computed) | / ( |T| ulp )

    (8)     | W(Z computed) - W(Z not computed) | / ( |W| ulp )

    (9)     | TR - RW | / ( |T| |R| ulp )

    (10)    | L**H T - W**H L | / ( |T| |L| ulp )

    (11)    | HX - XW | / ( |H| |X| ulp )

    (12)    | Y**H H - W**H Y | / ( |H| |Y| ulp )

    (13)    | AX - XW | / ( |A| |X| ulp )

    (14)    | Y**H A - W**H Y | / ( |A| |Y| ulp )

    The "sizes" are specified by an array NN(1:NSIZES); the value of
    each element NN(j) specifies one size.
    The "types" are specified by a logical array DOTYPE( 1:NTYPES );
    if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
    Currently, the list of possible types is:

    (1)  The zero matrix.
    (2)  The identity matrix.
    (3)  A (transposed) Jordan block, with 1's on the diagonal.

    (4)  A diagonal matrix with evenly spaced entries
         1, ..., ULP  and random complex angles.
         (ULP = (first number larger than 1) - 1 )
    (5)  A diagonal matrix with geometrically spaced entries
         1, ..., ULP  and random complex angles.
    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
         and random complex angles.

    (7)  Same as (4), but multiplied by SQRT( overflow threshold )
    (8)  Same as (4), but multiplied by SQRT( underflow threshold )

    (9)  A matrix of the form  U' T U, where U is unitary and
         T has evenly spaced entries 1, ..., ULP with random complex
         angles on the diagonal and random O(1) entries in the upper
         triangle.

    (10) A matrix of the form  U' T U, where U is unitary and
         T has geometrically spaced entries 1, ..., ULP with random
         complex angles on the diagonal and random O(1) entries in
         the upper triangle.

    (11) A matrix of the form  U' T U, where U is unitary and
         T has "clustered" entries 1, ULP,..., ULP with random
         complex angles on the diagonal and random O(1) entries in
         the upper triangle.

    (12) A matrix of the form  U' T U, where U is unitary and
         T has complex eigenvalues randomly chosen from
         ULP < |z| < 1   and random O(1) entries in the upper
         triangle.

    (13) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
         with random complex angles on the diagonal and random O(1)
         entries in the upper triangle.

    (14) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has geometrically spaced entries
         1, ..., ULP with random complex angles on the diagonal
         and random O(1) entries in the upper triangle.

    (15) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
         with random complex angles on the diagonal and random O(1)
         entries in the upper triangle.

    (16) A matrix of the form  X' T X, where X has condition
         SQRT( ULP ) and T has complex eigenvalues randomly chosen
         from   ULP < |z| < 1   and random O(1) entries in the upper
         triangle.

    (17) Same as (16), but multiplied by SQRT( overflow threshold )
    (18) Same as (16), but multiplied by SQRT( underflow threshold )

    (19) Nonsymmetric matrix with random entries chosen from |z| < 1
    (20) Same as (19), but multiplied by SQRT( overflow threshold )
    (21) Same as (19), but multiplied by SQRT( underflow threshold )
  NSIZES - INTEGER
           The number of sizes of matrices to use.  If it is zero,
           CCHKHS does nothing.  It must be at least zero.
           Not modified.

  NN     - INTEGER array, dimension (NSIZES)
           An array containing the sizes to be used for the matrices.
           Zero values will be skipped.  The values must be at least
           zero.
           Not modified.

  NTYPES - INTEGER
           The number of elements in DOTYPE.   If it is zero, CCHKHS
           does nothing.  It must be at least zero.  If it is MAXTYP+1
           and NSIZES is 1, then an additional type, MAXTYP+1 is
           defined, which is to use whatever matrix is in A.  This
           is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
           DOTYPE(MAXTYP+1) is .TRUE. .
           Not modified.

  DOTYPE - LOGICAL array, dimension (NTYPES)
           If DOTYPE(j) is .TRUE., then for each size in NN a
           matrix of that size and of type j will be generated.
           If NTYPES is smaller than the maximum number of types
           defined (PARAMETER MAXTYP), then types NTYPES+1 through
           MAXTYP will not be generated.  If NTYPES is larger
           than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
           will be ignored.
           Not modified.

  ISEED  - INTEGER array, dimension (4)
           On entry ISEED specifies the seed of the random number
           generator. The array elements should be between 0 and 4095;
           if not they will be reduced mod 4096.  Also, ISEED(4) must
           be odd.  The random number generator uses a linear
           congruential sequence limited to small integers, and so
           should produce machine independent random numbers. The
           values of ISEED are changed on exit, and can be used in the
           next call to CCHKHS to continue the same random number
           sequence.
           Modified.

  THRESH - REAL
           A test will count as "failed" if the "error", computed as
           described above, exceeds THRESH.  Note that the error
           is scaled to be O(1), so THRESH should be a reasonably
           small multiple of 1, e.g., 10 or 100.  In particular,
           it should not depend on the precision (single vs. double)
           or the size of the matrix.  It must be at least zero.
           Not modified.

  NOUNIT - INTEGER
           The FORTRAN unit number for printing out error messages
           (e.g., if a routine returns IINFO not equal to 0.)
           Not modified.

  A      - COMPLEX array, dimension (LDA,max(NN))
           Used to hold the matrix whose eigenvalues are to be
           computed.  On exit, A contains the last matrix actually
           used.
           Modified.

  LDA    - INTEGER
           The leading dimension of A, H, T1 and T2.  It must be at
           least 1 and at least max( NN ).
           Not modified.

  H      - COMPLEX array, dimension (LDA,max(NN))
           The upper hessenberg matrix computed by CGEHRD.  On exit,
           H contains the Hessenberg form of the matrix in A.
           Modified.

  T1     - COMPLEX array, dimension (LDA,max(NN))
           The Schur (="quasi-triangular") matrix computed by CHSEQR
           if Z is computed.  On exit, T1 contains the Schur form of
           the matrix in A.
           Modified.

  T2     - COMPLEX array, dimension (LDA,max(NN))
           The Schur matrix computed by CHSEQR when Z is not computed.
           This should be identical to T1.
           Modified.

  LDU    - INTEGER
           The leading dimension of U, Z, UZ and UU.  It must be at
           least 1 and at least max( NN ).
           Not modified.

  U      - COMPLEX array, dimension (LDU,max(NN))
           The unitary matrix computed by CGEHRD.
           Modified.

  Z      - COMPLEX array, dimension (LDU,max(NN))
           The unitary matrix computed by CHSEQR.
           Modified.

  UZ     - COMPLEX array, dimension (LDU,max(NN))
           The product of U times Z.
           Modified.

  W1     - COMPLEX array, dimension (max(NN))
           The eigenvalues of A, as computed by a full Schur
           decomposition H = Z T Z'.  On exit, W1 contains the
           eigenvalues of the matrix in A.
           Modified.

  W3     - COMPLEX array, dimension (max(NN))
           The eigenvalues of A, as computed by a partial Schur
           decomposition (Z not computed, T only computed as much
           as is necessary for determining eigenvalues).  On exit,
           W3 contains the eigenvalues of the matrix in A, possibly
           perturbed by CHSEIN.
           Modified.

  EVECTL - COMPLEX array, dimension (LDU,max(NN))
           The conjugate transpose of the (upper triangular) left
           eigenvector matrix for the matrix in T1.
           Modified.

  EVECTR - COMPLEX array, dimension (LDU,max(NN))
           The (upper triangular) right eigenvector matrix for the
           matrix in T1.
           Modified.

  EVECTY - COMPLEX array, dimension (LDU,max(NN))
           The conjugate transpose of the left eigenvector matrix
           for the matrix in H.
           Modified.

  EVECTX - COMPLEX array, dimension (LDU,max(NN))
           The right eigenvector matrix for the matrix in H.
           Modified.

  UU     - COMPLEX array, dimension (LDU,max(NN))
           Details of the unitary matrix computed by CGEHRD.
           Modified.

  TAU    - COMPLEX array, dimension (max(NN))
           Further details of the unitary matrix computed by CGEHRD.
           Modified.

  WORK   - COMPLEX array, dimension (NWORK)
           Workspace.
           Modified.

  NWORK  - INTEGER
           The number of entries in WORK.  NWORK >= 4*NN(j)*NN(j) + 2.

  RWORK  - REAL array, dimension (max(NN))
           Workspace.  Could be equivalenced to IWORK, but not SELECT.
           Modified.

  IWORK  - INTEGER array, dimension (max(NN))
           Workspace.
           Modified.

  SELECT - LOGICAL array, dimension (max(NN))
           Workspace.  Could be equivalenced to IWORK, but not RWORK.
           Modified.

  RESULT - REAL array, dimension (14)
           The values computed by the fourteen tests described above.
           The values are currently limited to 1/ulp, to avoid
           overflow.
           Modified.

  INFO   - INTEGER
           If 0, then everything ran OK.
            -1: NSIZES < 0
            -2: Some NN(j) < 0
            -3: NTYPES < 0
            -6: THRESH < 0
            -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
           -14: LDU < 1 or LDU < NMAX.
           -26: NWORK too small.
           If  CLATMR, CLATMS, or CLATME returns an error code, the
               absolute value of it is returned.
           If 1, then CHSEQR could not find all the shifts.
           If 2, then the EISPACK code (for small blocks) failed.
           If >2, then 30*N iterations were not enough to find an
               eigenvalue or to decompose the problem.
           Modified.

-----------------------------------------------------------------------

     Some Local Variables and Parameters:
     ---- ----- --------- --- ----------

     ZERO, ONE       Real 0 and 1.
     MAXTYP          The number of types defined.
     MTEST           The number of tests defined: care must be taken
                     that (1) the size of RESULT, (2) the number of
                     tests actually performed, and (3) MTEST agree.
     NTEST           The number of tests performed on this matrix
                     so far.  This should be less than MTEST, and
                     equal to it by the last test.  It will be less
                     if any of the routines being tested indicates
                     that it could not compute the matrices that
                     would be tested.
     NMAX            Largest value in NN.
     NMATS           The number of matrices generated so far.
     NERRS           The number of tests which have exceeded THRESH
                     so far (computed by SLAFTS).
     COND, CONDS,
     IMODE           Values to be passed to the matrix generators.
     ANORM           Norm of A; passed to matrix generators.

     OVFL, UNFL      Overflow and underflow thresholds.
     ULP, ULPINV     Finest relative precision and its inverse.
     RTOVFL, RTUNFL,
     RTULP, RTULPI   Square roots of the previous 4 values.

             The following four arrays decode JTYPE:
     KTYPE(j)        The general type (1-10) for type "j".
     KMODE(j)        The MODE value to be passed to the matrix
                     generator for type "j".
     KMAGN(j)        The order of magnitude ( O(1),
                     O(overflow^(1/2) ), O(underflow^(1/2) )
     KCONDS(j)       Selects whether CONDS is to be 1 or
                     1/sqrt(ulp).  (0 means irrelevant.)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 414 of file cchkhs.f.

414 *
415 * -- LAPACK test routine (version 3.4.0) --
416 * -- LAPACK is a software package provided by Univ. of Tennessee, --
417 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
418 * November 2011
419 *
420 * .. Scalar Arguments ..
421  INTEGER info, lda, ldu, nounit, nsizes, ntypes, nwork
422  REAL thresh
423 * ..
424 * .. Array Arguments ..
425  LOGICAL dotype( * ), select( * )
426  INTEGER iseed( 4 ), iwork( * ), nn( * )
427  REAL result( 14 ), rwork( * )
428  COMPLEX a( lda, * ), evectl( ldu, * ),
429  $ evectr( ldu, * ), evectx( ldu, * ),
430  $ evecty( ldu, * ), h( lda, * ), t1( lda, * ),
431  $ t2( lda, * ), tau( * ), u( ldu, * ),
432  $ uu( ldu, * ), uz( ldu, * ), w1( * ), w3( * ),
433  $ work( * ), z( ldu, * )
434 * ..
435 *
436 * =====================================================================
437 *
438 * .. Parameters ..
439  REAL zero, one
440  parameter( zero = 0.0e+0, one = 1.0e+0 )
441  COMPLEX czero, cone
442  parameter( czero = ( 0.0e+0, 0.0e+0 ),
443  $ cone = ( 1.0e+0, 0.0e+0 ) )
444  INTEGER maxtyp
445  parameter( maxtyp = 21 )
446 * ..
447 * .. Local Scalars ..
448  LOGICAL badnn, match
449  INTEGER i, ihi, iinfo, ilo, imode, in, itype, j, jcol,
450  $ jj, jsize, jtype, k, mtypes, n, n1, nerrs,
451  $ nmats, nmax, ntest, ntestt
452  REAL aninv, anorm, cond, conds, ovfl, rtovfl, rtulp,
453  $ rtulpi, rtunfl, temp1, temp2, ulp, ulpinv, unfl
454 * ..
455 * .. Local Arrays ..
456  INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
457  $ kmagn( maxtyp ), kmode( maxtyp ),
458  $ ktype( maxtyp )
459  REAL dumma( 4 )
460  COMPLEX cdumma( 4 )
461 * ..
462 * .. External Functions ..
463  REAL slamch
464  EXTERNAL slamch
465 * ..
466 * .. External Subroutines ..
467  EXTERNAL ccopy, cgehrd, cgemm, cget10, cget22, chsein,
470  $ slasum, xerbla
471 * ..
472 * .. Intrinsic Functions ..
473  INTRINSIC abs, max, min, REAL, sqrt
474 * ..
475 * .. Data statements ..
476  DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
477  DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
478  $ 3, 1, 2, 3 /
479  DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
480  $ 1, 5, 5, 5, 4, 3, 1 /
481  DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
482 * ..
483 * .. Executable Statements ..
484 *
485 * Check for errors
486 *
487  ntestt = 0
488  info = 0
489 *
490  badnn = .false.
491  nmax = 0
492  DO 10 j = 1, nsizes
493  nmax = max( nmax, nn( j ) )
494  IF( nn( j ).LT.0 )
495  $ badnn = .true.
496  10 CONTINUE
497 *
498 * Check for errors
499 *
500  IF( nsizes.LT.0 ) THEN
501  info = -1
502  ELSE IF( badnn ) THEN
503  info = -2
504  ELSE IF( ntypes.LT.0 ) THEN
505  info = -3
506  ELSE IF( thresh.LT.zero ) THEN
507  info = -6
508  ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
509  info = -9
510  ELSE IF( ldu.LE.1 .OR. ldu.LT.nmax ) THEN
511  info = -14
512  ELSE IF( 4*nmax*nmax+2.GT.nwork ) THEN
513  info = -26
514  END IF
515 *
516  IF( info.NE.0 ) THEN
517  CALL xerbla( 'CCHKHS', -info )
518  RETURN
519  END IF
520 *
521 * Quick return if possible
522 *
523  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
524  $ RETURN
525 *
526 * More important constants
527 *
528  unfl = slamch( 'Safe minimum' )
529  ovfl = slamch( 'Overflow' )
530  CALL slabad( unfl, ovfl )
531  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
532  ulpinv = one / ulp
533  rtunfl = sqrt( unfl )
534  rtovfl = sqrt( ovfl )
535  rtulp = sqrt( ulp )
536  rtulpi = one / rtulp
537 *
538 * Loop over sizes, types
539 *
540  nerrs = 0
541  nmats = 0
542 *
543  DO 260 jsize = 1, nsizes
544  n = nn( jsize )
545  IF( n.EQ.0 )
546  $ GO TO 260
547  n1 = max( 1, n )
548  aninv = one / REAL( n1 )
549 *
550  IF( nsizes.NE.1 ) THEN
551  mtypes = min( maxtyp, ntypes )
552  ELSE
553  mtypes = min( maxtyp+1, ntypes )
554  END IF
555 *
556  DO 250 jtype = 1, mtypes
557  IF( .NOT.dotype( jtype ) )
558  $ GO TO 250
559  nmats = nmats + 1
560  ntest = 0
561 *
562 * Save ISEED in case of an error.
563 *
564  DO 20 j = 1, 4
565  ioldsd( j ) = iseed( j )
566  20 CONTINUE
567 *
568 * Initialize RESULT
569 *
570  DO 30 j = 1, 14
571  result( j ) = zero
572  30 CONTINUE
573 *
574 * Compute "A"
575 *
576 * Control parameters:
577 *
578 * KMAGN KCONDS KMODE KTYPE
579 * =1 O(1) 1 clustered 1 zero
580 * =2 large large clustered 2 identity
581 * =3 small exponential Jordan
582 * =4 arithmetic diagonal, (w/ eigenvalues)
583 * =5 random log hermitian, w/ eigenvalues
584 * =6 random general, w/ eigenvalues
585 * =7 random diagonal
586 * =8 random hermitian
587 * =9 random general
588 * =10 random triangular
589 *
590  IF( mtypes.GT.maxtyp )
591  $ GO TO 100
592 *
593  itype = ktype( jtype )
594  imode = kmode( jtype )
595 *
596 * Compute norm
597 *
598  GO TO ( 40, 50, 60 )kmagn( jtype )
599 *
600  40 CONTINUE
601  anorm = one
602  GO TO 70
603 *
604  50 CONTINUE
605  anorm = ( rtovfl*ulp )*aninv
606  GO TO 70
607 *
608  60 CONTINUE
609  anorm = rtunfl*n*ulpinv
610  GO TO 70
611 *
612  70 CONTINUE
613 *
614  CALL claset( 'Full', lda, n, czero, czero, a, lda )
615  iinfo = 0
616  cond = ulpinv
617 *
618 * Special Matrices
619 *
620  IF( itype.EQ.1 ) THEN
621 *
622 * Zero
623 *
624  iinfo = 0
625  ELSE IF( itype.EQ.2 ) THEN
626 *
627 * Identity
628 *
629  DO 80 jcol = 1, n
630  a( jcol, jcol ) = anorm
631  80 CONTINUE
632 *
633  ELSE IF( itype.EQ.3 ) THEN
634 *
635 * Jordan Block
636 *
637  DO 90 jcol = 1, n
638  a( jcol, jcol ) = anorm
639  IF( jcol.GT.1 )
640  $ a( jcol, jcol-1 ) = one
641  90 CONTINUE
642 *
643  ELSE IF( itype.EQ.4 ) THEN
644 *
645 * Diagonal Matrix, [Eigen]values Specified
646 *
647  CALL clatmr( n, n, 'D', iseed, 'N', work, imode, cond,
648  $ cone, 'T', 'N', work( n+1 ), 1, one,
649  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
650  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
651 *
652  ELSE IF( itype.EQ.5 ) THEN
653 *
654 * Hermitian, eigenvalues specified
655 *
656  CALL clatms( n, n, 'D', iseed, 'H', rwork, imode, cond,
657  $ anorm, n, n, 'N', a, lda, work, iinfo )
658 *
659  ELSE IF( itype.EQ.6 ) THEN
660 *
661 * General, eigenvalues specified
662 *
663  IF( kconds( jtype ).EQ.1 ) THEN
664  conds = one
665  ELSE IF( kconds( jtype ).EQ.2 ) THEN
666  conds = rtulpi
667  ELSE
668  conds = zero
669  END IF
670 *
671  CALL clatme( n, 'D', iseed, work, imode, cond, cone,
672  $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
673  $ a, lda, work( n+1 ), iinfo )
674 *
675  ELSE IF( itype.EQ.7 ) THEN
676 *
677 * Diagonal, random eigenvalues
678 *
679  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
680  $ 'T', 'N', work( n+1 ), 1, one,
681  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
682  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
683 *
684  ELSE IF( itype.EQ.8 ) THEN
685 *
686 * Hermitian, random eigenvalues
687 *
688  CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
689  $ 'T', 'N', work( n+1 ), 1, one,
690  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
691  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
692 *
693  ELSE IF( itype.EQ.9 ) THEN
694 *
695 * General, random eigenvalues
696 *
697  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
698  $ 'T', 'N', work( n+1 ), 1, one,
699  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
700  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
701 *
702  ELSE IF( itype.EQ.10 ) THEN
703 *
704 * Triangular, random eigenvalues
705 *
706  CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
707  $ 'T', 'N', work( n+1 ), 1, one,
708  $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
709  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
710 *
711  ELSE
712 *
713  iinfo = 1
714  END IF
715 *
716  IF( iinfo.NE.0 ) THEN
717  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
718  $ ioldsd
719  info = abs( iinfo )
720  RETURN
721  END IF
722 *
723  100 CONTINUE
724 *
725 * Call CGEHRD to compute H and U, do tests.
726 *
727  CALL clacpy( ' ', n, n, a, lda, h, lda )
728  ntest = 1
729 *
730  ilo = 1
731  ihi = n
732 *
733  CALL cgehrd( n, ilo, ihi, h, lda, work, work( n+1 ),
734  $ nwork-n, iinfo )
735 *
736  IF( iinfo.NE.0 ) THEN
737  result( 1 ) = ulpinv
738  WRITE( nounit, fmt = 9999 )'CGEHRD', iinfo, n, jtype,
739  $ ioldsd
740  info = abs( iinfo )
741  GO TO 240
742  END IF
743 *
744  DO 120 j = 1, n - 1
745  uu( j+1, j ) = czero
746  DO 110 i = j + 2, n
747  u( i, j ) = h( i, j )
748  uu( i, j ) = h( i, j )
749  h( i, j ) = czero
750  110 CONTINUE
751  120 CONTINUE
752  CALL ccopy( n-1, work, 1, tau, 1 )
753  CALL cunghr( n, ilo, ihi, u, ldu, work, work( n+1 ),
754  $ nwork-n, iinfo )
755  ntest = 2
756 *
757  CALL chst01( n, ilo, ihi, a, lda, h, lda, u, ldu, work,
758  $ nwork, rwork, result( 1 ) )
759 *
760 * Call CHSEQR to compute T1, T2 and Z, do tests.
761 *
762 * Eigenvalues only (W3)
763 *
764  CALL clacpy( ' ', n, n, h, lda, t2, lda )
765  ntest = 3
766  result( 3 ) = ulpinv
767 *
768  CALL chseqr( 'E', 'N', n, ilo, ihi, t2, lda, w3, uz, ldu,
769  $ work, nwork, iinfo )
770  IF( iinfo.NE.0 ) THEN
771  WRITE( nounit, fmt = 9999 )'CHSEQR(E)', iinfo, n, jtype,
772  $ ioldsd
773  IF( iinfo.LE.n+2 ) THEN
774  info = abs( iinfo )
775  GO TO 240
776  END IF
777  END IF
778 *
779 * Eigenvalues (W1) and Full Schur Form (T2)
780 *
781  CALL clacpy( ' ', n, n, h, lda, t2, lda )
782 *
783  CALL chseqr( 'S', 'N', n, ilo, ihi, t2, lda, w1, uz, ldu,
784  $ work, nwork, iinfo )
785  IF( iinfo.NE.0 .AND. iinfo.LE.n+2 ) THEN
786  WRITE( nounit, fmt = 9999 )'CHSEQR(S)', iinfo, n, jtype,
787  $ ioldsd
788  info = abs( iinfo )
789  GO TO 240
790  END IF
791 *
792 * Eigenvalues (W1), Schur Form (T1), and Schur Vectors (UZ)
793 *
794  CALL clacpy( ' ', n, n, h, lda, t1, lda )
795  CALL clacpy( ' ', n, n, u, ldu, uz, ldu )
796 *
797  CALL chseqr( 'S', 'V', n, ilo, ihi, t1, lda, w1, uz, ldu,
798  $ work, nwork, iinfo )
799  IF( iinfo.NE.0 .AND. iinfo.LE.n+2 ) THEN
800  WRITE( nounit, fmt = 9999 )'CHSEQR(V)', iinfo, n, jtype,
801  $ ioldsd
802  info = abs( iinfo )
803  GO TO 240
804  END IF
805 *
806 * Compute Z = U' UZ
807 *
808  CALL cgemm( 'C', 'N', n, n, n, cone, u, ldu, uz, ldu, czero,
809  $ z, ldu )
810  ntest = 8
811 *
812 * Do Tests 3: | H - Z T Z' | / ( |H| n ulp )
813 * and 4: | I - Z Z' | / ( n ulp )
814 *
815  CALL chst01( n, ilo, ihi, h, lda, t1, lda, z, ldu, work,
816  $ nwork, rwork, result( 3 ) )
817 *
818 * Do Tests 5: | A - UZ T (UZ)' | / ( |A| n ulp )
819 * and 6: | I - UZ (UZ)' | / ( n ulp )
820 *
821  CALL chst01( n, ilo, ihi, a, lda, t1, lda, uz, ldu, work,
822  $ nwork, rwork, result( 5 ) )
823 *
824 * Do Test 7: | T2 - T1 | / ( |T| n ulp )
825 *
826  CALL cget10( n, n, t2, lda, t1, lda, work, rwork,
827  $ result( 7 ) )
828 *
829 * Do Test 8: | W3 - W1 | / ( max(|W1|,|W3|) ulp )
830 *
831  temp1 = zero
832  temp2 = zero
833  DO 130 j = 1, n
834  temp1 = max( temp1, abs( w1( j ) ), abs( w3( j ) ) )
835  temp2 = max( temp2, abs( w1( j )-w3( j ) ) )
836  130 CONTINUE
837 *
838  result( 8 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
839 *
840 * Compute the Left and Right Eigenvectors of T
841 *
842 * Compute the Right eigenvector Matrix:
843 *
844  ntest = 9
845  result( 9 ) = ulpinv
846 *
847 * Select every other eigenvector
848 *
849  DO 140 j = 1, n
850  SELECT( j ) = .false.
851  140 CONTINUE
852  DO 150 j = 1, n, 2
853  SELECT( j ) = .true.
854  150 CONTINUE
855  CALL ctrevc( 'Right', 'All', SELECT, n, t1, lda, cdumma,
856  $ ldu, evectr, ldu, n, in, work, rwork, iinfo )
857  IF( iinfo.NE.0 ) THEN
858  WRITE( nounit, fmt = 9999 )'CTREVC(R,A)', iinfo, n,
859  $ jtype, ioldsd
860  info = abs( iinfo )
861  GO TO 240
862  END IF
863 *
864 * Test 9: | TR - RW | / ( |T| |R| ulp )
865 *
866  CALL cget22( 'N', 'N', 'N', n, t1, lda, evectr, ldu, w1,
867  $ work, rwork, dumma( 1 ) )
868  result( 9 ) = dumma( 1 )
869  IF( dumma( 2 ).GT.thresh ) THEN
870  WRITE( nounit, fmt = 9998 )'Right', 'CTREVC',
871  $ dumma( 2 ), n, jtype, ioldsd
872  END IF
873 *
874 * Compute selected right eigenvectors and confirm that
875 * they agree with previous right eigenvectors
876 *
877  CALL ctrevc( 'Right', 'Some', SELECT, n, t1, lda, cdumma,
878  $ ldu, evectl, ldu, n, in, work, rwork, iinfo )
879  IF( iinfo.NE.0 ) THEN
880  WRITE( nounit, fmt = 9999 )'CTREVC(R,S)', iinfo, n,
881  $ jtype, ioldsd
882  info = abs( iinfo )
883  GO TO 240
884  END IF
885 *
886  k = 1
887  match = .true.
888  DO 170 j = 1, n
889  IF( SELECT( j ) ) THEN
890  DO 160 jj = 1, n
891  IF( evectr( jj, j ).NE.evectl( jj, k ) ) THEN
892  match = .false.
893  GO TO 180
894  END IF
895  160 CONTINUE
896  k = k + 1
897  END IF
898  170 CONTINUE
899  180 CONTINUE
900  IF( .NOT.match )
901  $ WRITE( nounit, fmt = 9997 )'Right', 'CTREVC', n, jtype,
902  $ ioldsd
903 *
904 * Compute the Left eigenvector Matrix:
905 *
906  ntest = 10
907  result( 10 ) = ulpinv
908  CALL ctrevc( 'Left', 'All', SELECT, n, t1, lda, evectl, ldu,
909  $ cdumma, ldu, n, in, work, rwork, iinfo )
910  IF( iinfo.NE.0 ) THEN
911  WRITE( nounit, fmt = 9999 )'CTREVC(L,A)', iinfo, n,
912  $ jtype, ioldsd
913  info = abs( iinfo )
914  GO TO 240
915  END IF
916 *
917 * Test 10: | LT - WL | / ( |T| |L| ulp )
918 *
919  CALL cget22( 'C', 'N', 'C', n, t1, lda, evectl, ldu, w1,
920  $ work, rwork, dumma( 3 ) )
921  result( 10 ) = dumma( 3 )
922  IF( dumma( 4 ).GT.thresh ) THEN
923  WRITE( nounit, fmt = 9998 )'Left', 'CTREVC', dumma( 4 ),
924  $ n, jtype, ioldsd
925  END IF
926 *
927 * Compute selected left eigenvectors and confirm that
928 * they agree with previous left eigenvectors
929 *
930  CALL ctrevc( 'Left', 'Some', SELECT, n, t1, lda, evectr,
931  $ ldu, cdumma, ldu, n, in, work, rwork, iinfo )
932  IF( iinfo.NE.0 ) THEN
933  WRITE( nounit, fmt = 9999 )'CTREVC(L,S)', iinfo, n,
934  $ jtype, ioldsd
935  info = abs( iinfo )
936  GO TO 240
937  END IF
938 *
939  k = 1
940  match = .true.
941  DO 200 j = 1, n
942  IF( SELECT( j ) ) THEN
943  DO 190 jj = 1, n
944  IF( evectl( jj, j ).NE.evectr( jj, k ) ) THEN
945  match = .false.
946  GO TO 210
947  END IF
948  190 CONTINUE
949  k = k + 1
950  END IF
951  200 CONTINUE
952  210 CONTINUE
953  IF( .NOT.match )
954  $ WRITE( nounit, fmt = 9997 )'Left', 'CTREVC', n, jtype,
955  $ ioldsd
956 *
957 * Call CHSEIN for Right eigenvectors of H, do test 11
958 *
959  ntest = 11
960  result( 11 ) = ulpinv
961  DO 220 j = 1, n
962  SELECT( j ) = .true.
963  220 CONTINUE
964 *
965  CALL chsein( 'Right', 'Qr', 'Ninitv', SELECT, n, h, lda, w3,
966  $ cdumma, ldu, evectx, ldu, n1, in, work, rwork,
967  $ iwork, iwork, iinfo )
968  IF( iinfo.NE.0 ) THEN
969  WRITE( nounit, fmt = 9999 )'CHSEIN(R)', iinfo, n, jtype,
970  $ ioldsd
971  info = abs( iinfo )
972  IF( iinfo.LT.0 )
973  $ GO TO 240
974  ELSE
975 *
976 * Test 11: | HX - XW | / ( |H| |X| ulp )
977 *
978 * (from inverse iteration)
979 *
980  CALL cget22( 'N', 'N', 'N', n, h, lda, evectx, ldu, w3,
981  $ work, rwork, dumma( 1 ) )
982  IF( dumma( 1 ).LT.ulpinv )
983  $ result( 11 ) = dumma( 1 )*aninv
984  IF( dumma( 2 ).GT.thresh ) THEN
985  WRITE( nounit, fmt = 9998 )'Right', 'CHSEIN',
986  $ dumma( 2 ), n, jtype, ioldsd
987  END IF
988  END IF
989 *
990 * Call CHSEIN for Left eigenvectors of H, do test 12
991 *
992  ntest = 12
993  result( 12 ) = ulpinv
994  DO 230 j = 1, n
995  SELECT( j ) = .true.
996  230 CONTINUE
997 *
998  CALL chsein( 'Left', 'Qr', 'Ninitv', SELECT, n, h, lda, w3,
999  $ evecty, ldu, cdumma, ldu, n1, in, work, rwork,
1000  $ iwork, iwork, iinfo )
1001  IF( iinfo.NE.0 ) THEN
1002  WRITE( nounit, fmt = 9999 )'CHSEIN(L)', iinfo, n, jtype,
1003  $ ioldsd
1004  info = abs( iinfo )
1005  IF( iinfo.LT.0 )
1006  $ GO TO 240
1007  ELSE
1008 *
1009 * Test 12: | YH - WY | / ( |H| |Y| ulp )
1010 *
1011 * (from inverse iteration)
1012 *
1013  CALL cget22( 'C', 'N', 'C', n, h, lda, evecty, ldu, w3,
1014  $ work, rwork, dumma( 3 ) )
1015  IF( dumma( 3 ).LT.ulpinv )
1016  $ result( 12 ) = dumma( 3 )*aninv
1017  IF( dumma( 4 ).GT.thresh ) THEN
1018  WRITE( nounit, fmt = 9998 )'Left', 'CHSEIN',
1019  $ dumma( 4 ), n, jtype, ioldsd
1020  END IF
1021  END IF
1022 *
1023 * Call CUNMHR for Right eigenvectors of A, do test 13
1024 *
1025  ntest = 13
1026  result( 13 ) = ulpinv
1027 *
1028  CALL cunmhr( 'Left', 'No transpose', n, n, ilo, ihi, uu,
1029  $ ldu, tau, evectx, ldu, work, nwork, iinfo )
1030  IF( iinfo.NE.0 ) THEN
1031  WRITE( nounit, fmt = 9999 )'CUNMHR(L)', iinfo, n, jtype,
1032  $ ioldsd
1033  info = abs( iinfo )
1034  IF( iinfo.LT.0 )
1035  $ GO TO 240
1036  ELSE
1037 *
1038 * Test 13: | AX - XW | / ( |A| |X| ulp )
1039 *
1040 * (from inverse iteration)
1041 *
1042  CALL cget22( 'N', 'N', 'N', n, a, lda, evectx, ldu, w3,
1043  $ work, rwork, dumma( 1 ) )
1044  IF( dumma( 1 ).LT.ulpinv )
1045  $ result( 13 ) = dumma( 1 )*aninv
1046  END IF
1047 *
1048 * Call CUNMHR for Left eigenvectors of A, do test 14
1049 *
1050  ntest = 14
1051  result( 14 ) = ulpinv
1052 *
1053  CALL cunmhr( 'Left', 'No transpose', n, n, ilo, ihi, uu,
1054  $ ldu, tau, evecty, ldu, work, nwork, iinfo )
1055  IF( iinfo.NE.0 ) THEN
1056  WRITE( nounit, fmt = 9999 )'CUNMHR(L)', iinfo, n, jtype,
1057  $ ioldsd
1058  info = abs( iinfo )
1059  IF( iinfo.LT.0 )
1060  $ GO TO 240
1061  ELSE
1062 *
1063 * Test 14: | YA - WY | / ( |A| |Y| ulp )
1064 *
1065 * (from inverse iteration)
1066 *
1067  CALL cget22( 'C', 'N', 'C', n, a, lda, evecty, ldu, w3,
1068  $ work, rwork, dumma( 3 ) )
1069  IF( dumma( 3 ).LT.ulpinv )
1070  $ result( 14 ) = dumma( 3 )*aninv
1071  END IF
1072 *
1073 * End of Loop -- Check for RESULT(j) > THRESH
1074 *
1075  240 CONTINUE
1076 *
1077  ntestt = ntestt + ntest
1078  CALL slafts( 'CHS', n, n, jtype, ntest, result, ioldsd,
1079  $ thresh, nounit, nerrs )
1080 *
1081  250 CONTINUE
1082  260 CONTINUE
1083 *
1084 * Summary
1085 *
1086  CALL slasum( 'CHS', nounit, nerrs, ntestt )
1087 *
1088  RETURN
1089 *
1090  9999 FORMAT( ' CCHKHS: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1091  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1092  9998 FORMAT( ' CCHKHS: ', a, ' Eigenvectors from ', a, ' incorrectly ',
1093  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
1094  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5,
1095  $ ')' )
1096  9997 FORMAT( ' CCHKHS: Selected ', a, ' Eigenvectors from ', a,
1097  $ ' do not match other eigenvectors ', 9x, 'N=', i6,
1098  $ ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1099 *
1100 * End of CCHKHS
1101 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine clatme(N, DIST, ISEED, D, MODE, COND, DMAX, RSIGN, UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, A, LDA, WORK, INFO)
CLATME
Definition: clatme.f:303
subroutine cget10(M, N, A, LDA, B, LDB, WORK, RWORK, RESULT)
CGET10
Definition: cget10.f:101
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
SLAFTS
Definition: slafts.f:101
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
Definition: cgehrd.f:169
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:189
subroutine cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
Definition: cget22.f:145
subroutine cunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMHR
Definition: cunmhr.f:181
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
Definition: chst01.f:142
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
Definition: chseqr.f:301
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine ctrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTREVC
Definition: ctrevc.f:220
subroutine chsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
CHSEIN
Definition: chsein.f:247
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR
Definition: cunghr.f:128

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkst ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  AP,
real, dimension( * )  SD,
real, dimension( * )  SE,
real, dimension( * )  D1,
real, dimension( * )  D2,
real, dimension( * )  D3,
real, dimension( * )  D4,
real, dimension( * )  D5,
real, dimension( * )  WA1,
real, dimension( * )  WA2,
real, dimension( * )  WA3,
real, dimension( * )  WR,
complex, dimension( ldu, * )  U,
integer  LDU,
complex, dimension( ldu, * )  V,
complex, dimension( * )  VP,
complex, dimension( * )  TAU,
complex, dimension( ldu, * )  Z,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
integer  LRWORK,
integer, dimension( * )  IWORK,
integer  LIWORK,
real, dimension( * )  RESULT,
integer  INFO 
)

CCHKST

Purpose:
 CCHKST  checks the Hermitian eigenvalue problem routines.

    CHETRD factors A as  U S U* , where * means conjugate transpose,
    S is real symmetric tridiagonal, and U is unitary.
    CHETRD can use either just the lower or just the upper triangle
    of A; CCHKST checks both cases.
    U is represented as a product of Householder
    transformations, whose vectors are stored in the first
    n-1 columns of V, and whose scale factors are in TAU.

    CHPTRD does the same as CHETRD, except that A and V are stored
    in "packed" format.

    CUNGTR constructs the matrix U from the contents of V and TAU.

    CUPGTR constructs the matrix U from the contents of VP and TAU.

    CSTEQR factors S as  Z D1 Z* , where Z is the unitary
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal.  D2 is the matrix of
    eigenvalues computed when Z is not computed.

    SSTERF computes D3, the matrix of eigenvalues, by the
    PWK method, which does not yield eigenvectors.

    CPTEQR factors S as  Z4 D4 Z4* , for a
    Hermitian positive definite tridiagonal matrix.
    D5 is the matrix of eigenvalues computed when Z is not
    computed.

    SSTEBZ computes selected eigenvalues.  WA1, WA2, and
    WA3 will denote eigenvalues computed to high
    absolute accuracy, with different range options.
    WR will denote eigenvalues computed to high relative
    accuracy.

    CSTEIN computes Y, the eigenvectors of S, given the
    eigenvalues.

    CSTEDC factors S as Z D1 Z* , where Z is the unitary
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal ('I' option). It may also
    update an input unitary matrix, usually the output
    from CHETRD/CUNGTR or CHPTRD/CUPGTR ('V' option). It may
    also just compute eigenvalues ('N' option).

    CSTEMR factors S as Z D1 Z* , where Z is the unitary
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal ('I' option).  CSTEMR
    uses the Relatively Robust Representation whenever possible.

 When CCHKST is called, a number of matrix "sizes" ("n's") and a
 number of matrix "types" are specified.  For each size ("n")
 and each type of matrix, one matrix will be generated and used
 to test the Hermitian eigenroutines.  For each matrix, a number
 of tests will be performed:

 (1)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='U', ... )

 (2)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='U', ... )

 (3)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='L', ... )

 (4)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='L', ... )

 (5-8)   Same as 1-4, but for CHPTRD and CUPGTR.

 (9)     | S - Z D Z* | / ( |S| n ulp ) CSTEQR('V',...)

 (10)    | I - ZZ* | / ( n ulp )        CSTEQR('V',...)

 (11)    | D1 - D2 | / ( |D1| ulp )        CSTEQR('N',...)

 (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF

 (13)    0 if the true eigenvalues (computed by sturm count)
         of S are within THRESH of
         those in D1.  2*THRESH if they are not.  (Tested using
         SSTECH)

 For S positive definite,

 (14)    | S - Z4 D4 Z4* | / ( |S| n ulp ) CPTEQR('V',...)

 (15)    | I - Z4 Z4* | / ( n ulp )        CPTEQR('V',...)

 (16)    | D4 - D5 | / ( 100 |D4| ulp )       CPTEQR('N',...)

 When S is also diagonally dominant by the factor gamma < 1,

 (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              SSTEBZ( 'A', 'E', ...)

 (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)

 (19)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
                                              SSTEBZ( 'I', 'E', ...)

 (20)    | S - Y WA1 Y* | / ( |S| n ulp )  SSTEBZ, CSTEIN

 (21)    | I - Y Y* | / ( n ulp )          SSTEBZ, CSTEIN

 (22)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('I')

 (23)    | I - ZZ* | / ( n ulp )           CSTEDC('I')

 (24)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('V')

 (25)    | I - ZZ* | / ( n ulp )           CSTEDC('V')

 (26)    | D1 - D2 | / ( |D1| ulp )           CSTEDC('V') and
                                              CSTEDC('N')

 Test 27 is disabled at the moment because CSTEMR does not
 guarantee high relatvie accuracy.

 (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              CSTEMR('V', 'A')

 (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              CSTEMR('V', 'I')

 Tests 29 through 34 are disable at present because CSTEMR
 does not handle partial specturm requests.

 (29)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'I')

 (30)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'I')

 (31)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         CSTEMR('N', 'I') vs. CSTEMR('V', 'I')

 (32)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'V')

 (33)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'V')

 (34)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         CSTEMR('N', 'V') vs. CSTEMR('V', 'V')

 (35)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'A')

 (36)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'A')

 (37)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         CSTEMR('N', 'A') vs. CSTEMR('V', 'A')

 The "sizes" are specified by an array NN(1:NSIZES); the value of
 each element NN(j) specifies one size.
 The "types" are specified by a logical array DOTYPE( 1:NTYPES );
 if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
 Currently, the list of possible types is:

 (1)  The zero matrix.
 (2)  The identity matrix.

 (3)  A diagonal matrix with evenly spaced entries
      1, ..., ULP  and random signs.
      (ULP = (first number larger than 1) - 1 )
 (4)  A diagonal matrix with geometrically spaced entries
      1, ..., ULP  and random signs.
 (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
      and random signs.

 (6)  Same as (4), but multiplied by SQRT( overflow threshold )
 (7)  Same as (4), but multiplied by SQRT( underflow threshold )

 (8)  A matrix of the form  U* D U, where U is unitary and
      D has evenly spaced entries 1, ..., ULP with random signs
      on the diagonal.

 (9)  A matrix of the form  U* D U, where U is unitary and
      D has geometrically spaced entries 1, ..., ULP with random
      signs on the diagonal.

 (10) A matrix of the form  U* D U, where U is unitary and
      D has "clustered" entries 1, ULP,..., ULP with random
      signs on the diagonal.

 (11) Same as (8), but multiplied by SQRT( overflow threshold )
 (12) Same as (8), but multiplied by SQRT( underflow threshold )

 (13) Hermitian matrix with random entries chosen from (-1,1).
 (14) Same as (13), but multiplied by SQRT( overflow threshold )
 (15) Same as (13), but multiplied by SQRT( underflow threshold )
 (16) Same as (8), but diagonal elements are all positive.
 (17) Same as (9), but diagonal elements are all positive.
 (18) Same as (10), but diagonal elements are all positive.
 (19) Same as (16), but multiplied by SQRT( overflow threshold )
 (20) Same as (16), but multiplied by SQRT( underflow threshold )
 (21) A diagonally dominant tridiagonal matrix with geometrically
      spaced diagonal entries 1, ..., ULP.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          CCHKST does nothing.  It must be at least zero.
[in]NN
          NN is INTEGER array, dimension (NSIZES)
          An array containing the sizes to be used for the matrices.
          Zero values will be skipped.  The values must be at least
          zero.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, CCHKST
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrix is in A.  This
          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size in NN a
          matrix of that size and of type j will be generated.
          If NTYPES is smaller than the maximum number of types
          defined (PARAMETER MAXTYP), then types NTYPES+1 through
          MAXTYP will not be generated.  If NTYPES is larger
          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
          will be ignored.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator. The array elements should be between 0 and 4095;
          if not they will be reduced mod 4096.  Also, ISEED(4) must
          be odd.  The random number generator uses a linear
          congruential sequence limited to small integers, and so
          should produce machine independent random numbers. The
          values of ISEED are changed on exit, and can be used in the
          next call to CCHKST to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is COMPLEX array of
                                  dimension ( LDA , max(NN) )
          Used to hold the matrix whose eigenvalues are to be
          computed.  On exit, A contains the last matrix actually
          used.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at
          least 1 and at least max( NN ).
[out]AP
          AP is COMPLEX array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix A stored in packed format.
[out]SD
          SD is REAL array of
                             dimension( max(NN) )
          The diagonal of the tridiagonal matrix computed by CHETRD.
          On exit, SD and SE contain the tridiagonal form of the
          matrix in A.
[out]SE
          SE is REAL array of
                             dimension( max(NN) )
          The off-diagonal of the tridiagonal matrix computed by
          CHETRD.  On exit, SD and SE contain the tridiagonal form of
          the matrix in A.
[out]D1
          D1 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by CSTEQR simlutaneously
          with Z.  On exit, the eigenvalues in D1 correspond with the
          matrix in A.
[out]D2
          D2 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by CSTEQR if Z is not
          computed.  On exit, the eigenvalues in D2 correspond with
          the matrix in A.
[out]D3
          D3 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTERF.  On exit, the
          eigenvalues in D3 correspond with the matrix in A.
[out]D4
          D4 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by CPTEQR(V).
          ZPTEQR factors S as  Z4 D4 Z4*
          On exit, the eigenvalues in D4 correspond with the matrix in A.
[out]D5
          D5 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by ZPTEQR(N)
          when Z is not computed. On exit, the
          eigenvalues in D4 correspond with the matrix in A.
[out]WA1
          WA1 is REAL array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
[out]WA2
          WA2 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Choose random values for IL and IU, and ask for the
          IL-th through IU-th eigenvalues.
[out]WA3
          WA3 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Determine the values VL and VU of the IL-th and IU-th
          eigenvalues and ask for all eigenvalues in this range.
[out]WR
          WR is DOUBLE PRECISION array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different options.
          as computed by DSTEBZ.
[out]U
          U is COMPLEX array of
                             dimension( LDU, max(NN) ).
          The unitary matrix computed by CHETRD + CUNGTR.
[in]LDU
          LDU is INTEGER
          The leading dimension of U, Z, and V.  It must be at least 1
          and at least max( NN ).
[out]V
          V is COMPLEX array of
                             dimension( LDU, max(NN) ).
          The Housholder vectors computed by CHETRD in reducing A to
          tridiagonal form.  The vectors computed with UPLO='U' are
          in the upper triangle, and the vectors computed with UPLO='L'
          are in the lower triangle.  (As described in CHETRD, the
          sub- and superdiagonal are not set to 1, although the
          true Householder vector has a 1 in that position.  The
          routines that use V, such as CUNGTR, set those entries to
          1 before using them, and then restore them later.)
[out]VP
          VP is COMPLEX array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix V stored in packed format.
[out]TAU
          TAU is COMPLEX array of
                             dimension( max(NN) )
          The Householder factors computed by CHETRD in reducing A
          to tridiagonal form.
[out]Z
          Z is COMPLEX array of
                             dimension( LDU, max(NN) ).
          The unitary matrix of eigenvectors computed by CSTEQR,
          CPTEQR, and CSTEIN.
[out]WORK
          WORK is COMPLEX array of
                      dimension( LWORK )
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
          where Nmax = max( NN(j), 2 ) and lg = log base 2.
[out]IWORK
          IWORK is INTEGER array,
          Workspace.
[out]LIWORK
          LIWORK is INTEGER
          The number of entries in IWORK.  This must be at least
                  6 + 6*Nmax + 5 * Nmax * lg Nmax 
          where Nmax = max( NN(j), 2 ) and lg = log base 2.
[out]RWORK
          RWORK is REAL array
[in]LRWORK
          LRWORK is INTEGER
          The number of entries in LRWORK (dimension( ??? )
[out]RESULT
          RESULT is REAL array, dimension (26)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.
           -1: NSIZES < 0
           -2: Some NN(j) < 0
           -3: NTYPES < 0
           -5: THRESH < 0
           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
          -23: LDU < 1 or LDU < NMAX.
          -29: LWORK too small.
          If  CLATMR, CLATMS, CHETRD, CUNGTR, CSTEQR, SSTERF,
              or CUNMC2 returns an error code, the
              absolute value of it is returned.

-----------------------------------------------------------------------

       Some Local Variables and Parameters:
       ---- ----- --------- --- ----------
       ZERO, ONE       Real 0 and 1.
       MAXTYP          The number of types defined.
       NTEST           The number of tests performed, or which can
                       be performed so far, for the current matrix.
       NTESTT          The total number of tests performed so far.
       NBLOCK          Blocksize as returned by ENVIR.
       NMAX            Largest value in NN.
       NMATS           The number of matrices generated so far.
       NERRS           The number of tests which have exceeded THRESH
                       so far.
       COND, IMODE     Values to be passed to the matrix generators.
       ANORM           Norm of A; passed to matrix generators.

       OVFL, UNFL      Overflow and underflow thresholds.
       ULP, ULPINV     Finest relative precision and its inverse.
       RTOVFL, RTUNFL  Square roots of the previous 2 values.
               The following four arrays decode JTYPE:
       KTYPE(j)        The general type (1-10) for type "j".
       KMODE(j)        The MODE value to be passed to the matrix
                       generator for type "j".
       KMAGN(j)        The order of magnitude ( O(1),
                       O(overflow^(1/2) ), O(underflow^(1/2) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 606 of file cchkst.f.

606 *
607 * -- LAPACK test routine (version 3.4.0) --
608 * -- LAPACK is a software package provided by Univ. of Tennessee, --
609 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
610 * November 2011
611 *
612 * .. Scalar Arguments ..
613  INTEGER info, lda, ldu, liwork, lrwork, lwork, nounit,
614  $ nsizes, ntypes
615  REAL thresh
616 * ..
617 * .. Array Arguments ..
618  LOGICAL dotype( * )
619  INTEGER iseed( 4 ), iwork( * ), nn( * )
620  REAL d1( * ), d2( * ), d3( * ), d4( * ), d5( * ),
621  $ result( * ), rwork( * ), sd( * ), se( * ),
622  $ wa1( * ), wa2( * ), wa3( * ), wr( * )
623  COMPLEX a( lda, * ), ap( * ), tau( * ), u( ldu, * ),
624  $ v( ldu, * ), vp( * ), work( * ), z( ldu, * )
625 * ..
626 *
627 * =====================================================================
628 *
629 * .. Parameters ..
630  REAL zero, one, two, eight, ten, hun
631  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
632  $ eight = 8.0e0, ten = 10.0e0, hun = 100.0e0 )
633  COMPLEX czero, cone
634  parameter( czero = ( 0.0e+0, 0.0e+0 ),
635  $ cone = ( 1.0e+0, 0.0e+0 ) )
636  REAL half
637  parameter( half = one / two )
638  INTEGER maxtyp
639  parameter( maxtyp = 21 )
640  LOGICAL crange
641  parameter( crange = .false. )
642  LOGICAL crel
643  parameter( crel = .false. )
644 * ..
645 * .. Local Scalars ..
646  LOGICAL badnn, tryrac
647  INTEGER i, iinfo, il, imode, inde, indrwk, itemp,
648  $ itype, iu, j, jc, jr, jsize, jtype, lgn,
649  $ liwedc, log2ui, lrwedc, lwedc, m, m2, m3,
650  $ mtypes, n, nap, nblock, nerrs, nmats, nmax,
651  $ nsplit, ntest, ntestt
652  REAL abstol, aninv, anorm, cond, ovfl, rtovfl,
653  $ rtunfl, temp1, temp2, temp3, temp4, ulp,
654  $ ulpinv, unfl, vl, vu
655 * ..
656 * .. Local Arrays ..
657  INTEGER idumma( 1 ), ioldsd( 4 ), iseed2( 4 ),
658  $ kmagn( maxtyp ), kmode( maxtyp ),
659  $ ktype( maxtyp )
660  REAL dumma( 1 )
661 * ..
662 * .. External Functions ..
663  INTEGER ilaenv
664  REAL slamch, slarnd, ssxt1
665  EXTERNAL ilaenv, slamch, slarnd, ssxt1
666 * ..
667 * .. External Subroutines ..
668  EXTERNAL ccopy, chet21, chetrd, chpt21, chptrd, clacpy,
672  $ xerbla
673 * ..
674 * .. Intrinsic Functions ..
675  INTRINSIC abs, conjg, int, log, max, min, REAL, sqrt
676 * ..
677 * .. Data statements ..
678  DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
679  $ 8, 8, 9, 9, 9, 9, 9, 10 /
680  DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
681  $ 2, 3, 1, 1, 1, 2, 3, 1 /
682  DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
683  $ 0, 0, 4, 3, 1, 4, 4, 3 /
684 * ..
685 * .. Executable Statements ..
686 *
687 * Keep ftnchek happy
688  idumma( 1 ) = 1
689 *
690 * Check for errors
691 *
692  ntestt = 0
693  info = 0
694 *
695 * Important constants
696 *
697  badnn = .false.
698  tryrac = .true.
699  nmax = 1
700  DO 10 j = 1, nsizes
701  nmax = max( nmax, nn( j ) )
702  IF( nn( j ).LT.0 )
703  $ badnn = .true.
704  10 CONTINUE
705 *
706  nblock = ilaenv( 1, 'CHETRD', 'L', nmax, -1, -1, -1 )
707  nblock = min( nmax, max( 1, nblock ) )
708 *
709 * Check for errors
710 *
711  IF( nsizes.LT.0 ) THEN
712  info = -1
713  ELSE IF( badnn ) THEN
714  info = -2
715  ELSE IF( ntypes.LT.0 ) THEN
716  info = -3
717  ELSE IF( lda.LT.nmax ) THEN
718  info = -9
719  ELSE IF( ldu.LT.nmax ) THEN
720  info = -23
721  ELSE IF( 2*max( 2, nmax )**2.GT.lwork ) THEN
722  info = -29
723  END IF
724 *
725  IF( info.NE.0 ) THEN
726  CALL xerbla( 'CCHKST', -info )
727  RETURN
728  END IF
729 *
730 * Quick return if possible
731 *
732  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
733  $ RETURN
734 *
735 * More Important constants
736 *
737  unfl = slamch( 'Safe minimum' )
738  ovfl = one / unfl
739  CALL slabad( unfl, ovfl )
740  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
741  ulpinv = one / ulp
742  log2ui = int( log( ulpinv ) / log( two ) )
743  rtunfl = sqrt( unfl )
744  rtovfl = sqrt( ovfl )
745 *
746 * Loop over sizes, types
747 *
748  DO 20 i = 1, 4
749  iseed2( i ) = iseed( i )
750  20 CONTINUE
751  nerrs = 0
752  nmats = 0
753 *
754  DO 310 jsize = 1, nsizes
755  n = nn( jsize )
756  IF( n.GT.0 ) THEN
757  lgn = int( log( REAL( N ) ) / log( two ) )
758  IF( 2**lgn.LT.n )
759  $ lgn = lgn + 1
760  IF( 2**lgn.LT.n )
761  $ lgn = lgn + 1
762  lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
763  lrwedc = 1 + 3*n + 2*n*lgn + 4*n**2
764  liwedc = 6 + 6*n + 5*n*lgn
765  ELSE
766  lwedc = 8
767  lrwedc = 7
768  liwedc = 12
769  END IF
770  nap = ( n*( n+1 ) ) / 2
771  aninv = one / REAL( MAX( 1, N ) )
772 *
773  IF( nsizes.NE.1 ) THEN
774  mtypes = min( maxtyp, ntypes )
775  ELSE
776  mtypes = min( maxtyp+1, ntypes )
777  END IF
778 *
779  DO 300 jtype = 1, mtypes
780  IF( .NOT.dotype( jtype ) )
781  $ GO TO 300
782  nmats = nmats + 1
783  ntest = 0
784 *
785  DO 30 j = 1, 4
786  ioldsd( j ) = iseed( j )
787  30 CONTINUE
788 *
789 * Compute "A"
790 *
791 * Control parameters:
792 *
793 * KMAGN KMODE KTYPE
794 * =1 O(1) clustered 1 zero
795 * =2 large clustered 2 identity
796 * =3 small exponential (none)
797 * =4 arithmetic diagonal, (w/ eigenvalues)
798 * =5 random log Hermitian, w/ eigenvalues
799 * =6 random (none)
800 * =7 random diagonal
801 * =8 random Hermitian
802 * =9 positive definite
803 * =10 diagonally dominant tridiagonal
804 *
805  IF( mtypes.GT.maxtyp )
806  $ GO TO 100
807 *
808  itype = ktype( jtype )
809  imode = kmode( jtype )
810 *
811 * Compute norm
812 *
813  GO TO ( 40, 50, 60 )kmagn( jtype )
814 *
815  40 CONTINUE
816  anorm = one
817  GO TO 70
818 *
819  50 CONTINUE
820  anorm = ( rtovfl*ulp )*aninv
821  GO TO 70
822 *
823  60 CONTINUE
824  anorm = rtunfl*n*ulpinv
825  GO TO 70
826 *
827  70 CONTINUE
828 *
829  CALL claset( 'Full', lda, n, czero, czero, a, lda )
830  iinfo = 0
831  IF( jtype.LE.15 ) THEN
832  cond = ulpinv
833  ELSE
834  cond = ulpinv*aninv / ten
835  END IF
836 *
837 * Special Matrices -- Identity & Jordan block
838 *
839 * Zero
840 *
841  IF( itype.EQ.1 ) THEN
842  iinfo = 0
843 *
844  ELSE IF( itype.EQ.2 ) THEN
845 *
846 * Identity
847 *
848  DO 80 jc = 1, n
849  a( jc, jc ) = anorm
850  80 CONTINUE
851 *
852  ELSE IF( itype.EQ.4 ) THEN
853 *
854 * Diagonal Matrix, [Eigen]values Specified
855 *
856  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
857  $ anorm, 0, 0, 'N', a, lda, work, iinfo )
858 *
859 *
860  ELSE IF( itype.EQ.5 ) THEN
861 *
862 * Hermitian, eigenvalues specified
863 *
864  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
865  $ anorm, n, n, 'N', a, lda, work, iinfo )
866 *
867  ELSE IF( itype.EQ.7 ) THEN
868 *
869 * Diagonal, random eigenvalues
870 *
871  CALL clatmr( n, n, 'S', iseed, 'H', work, 6, one, cone,
872  $ 'T', 'N', work( n+1 ), 1, one,
873  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
874  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
875 *
876  ELSE IF( itype.EQ.8 ) THEN
877 *
878 * Hermitian, random eigenvalues
879 *
880  CALL clatmr( n, n, 'S', iseed, 'H', work, 6, one, cone,
881  $ 'T', 'N', work( n+1 ), 1, one,
882  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
883  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
884 *
885  ELSE IF( itype.EQ.9 ) THEN
886 *
887 * Positive definite, eigenvalues specified.
888 *
889  CALL clatms( n, n, 'S', iseed, 'P', rwork, imode, cond,
890  $ anorm, n, n, 'N', a, lda, work, iinfo )
891 *
892  ELSE IF( itype.EQ.10 ) THEN
893 *
894 * Positive definite tridiagonal, eigenvalues specified.
895 *
896  CALL clatms( n, n, 'S', iseed, 'P', rwork, imode, cond,
897  $ anorm, 1, 1, 'N', a, lda, work, iinfo )
898  DO 90 i = 2, n
899  temp1 = abs( a( i-1, i ) )
900  temp2 = sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
901  IF( temp1.GT.half*temp2 ) THEN
902  a( i-1, i ) = a( i-1, i )*
903  $ ( half*temp2 / ( unfl+temp1 ) )
904  a( i, i-1 ) = conjg( a( i-1, i ) )
905  END IF
906  90 CONTINUE
907 *
908  ELSE
909 *
910  iinfo = 1
911  END IF
912 *
913  IF( iinfo.NE.0 ) THEN
914  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
915  $ ioldsd
916  info = abs( iinfo )
917  RETURN
918  END IF
919 *
920  100 CONTINUE
921 *
922 * Call CHETRD and CUNGTR to compute S and U from
923 * upper triangle.
924 *
925  CALL clacpy( 'U', n, n, a, lda, v, ldu )
926 *
927  ntest = 1
928  CALL chetrd( 'U', n, v, ldu, sd, se, tau, work, lwork,
929  $ iinfo )
930 *
931  IF( iinfo.NE.0 ) THEN
932  WRITE( nounit, fmt = 9999 )'CHETRD(U)', iinfo, n, jtype,
933  $ ioldsd
934  info = abs( iinfo )
935  IF( iinfo.LT.0 ) THEN
936  RETURN
937  ELSE
938  result( 1 ) = ulpinv
939  GO TO 280
940  END IF
941  END IF
942 *
943  CALL clacpy( 'U', n, n, v, ldu, u, ldu )
944 *
945  ntest = 2
946  CALL cungtr( 'U', n, u, ldu, tau, work, lwork, iinfo )
947  IF( iinfo.NE.0 ) THEN
948  WRITE( nounit, fmt = 9999 )'CUNGTR(U)', iinfo, n, jtype,
949  $ ioldsd
950  info = abs( iinfo )
951  IF( iinfo.LT.0 ) THEN
952  RETURN
953  ELSE
954  result( 2 ) = ulpinv
955  GO TO 280
956  END IF
957  END IF
958 *
959 * Do tests 1 and 2
960 *
961  CALL chet21( 2, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
962  $ ldu, tau, work, rwork, result( 1 ) )
963  CALL chet21( 3, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
964  $ ldu, tau, work, rwork, result( 2 ) )
965 *
966 * Call CHETRD and CUNGTR to compute S and U from
967 * lower triangle, do tests.
968 *
969  CALL clacpy( 'L', n, n, a, lda, v, ldu )
970 *
971  ntest = 3
972  CALL chetrd( 'L', n, v, ldu, sd, se, tau, work, lwork,
973  $ iinfo )
974 *
975  IF( iinfo.NE.0 ) THEN
976  WRITE( nounit, fmt = 9999 )'CHETRD(L)', iinfo, n, jtype,
977  $ ioldsd
978  info = abs( iinfo )
979  IF( iinfo.LT.0 ) THEN
980  RETURN
981  ELSE
982  result( 3 ) = ulpinv
983  GO TO 280
984  END IF
985  END IF
986 *
987  CALL clacpy( 'L', n, n, v, ldu, u, ldu )
988 *
989  ntest = 4
990  CALL cungtr( 'L', n, u, ldu, tau, work, lwork, iinfo )
991  IF( iinfo.NE.0 ) THEN
992  WRITE( nounit, fmt = 9999 )'CUNGTR(L)', iinfo, n, jtype,
993  $ ioldsd
994  info = abs( iinfo )
995  IF( iinfo.LT.0 ) THEN
996  RETURN
997  ELSE
998  result( 4 ) = ulpinv
999  GO TO 280
1000  END IF
1001  END IF
1002 *
1003  CALL chet21( 2, 'Lower', n, 1, a, lda, sd, se, u, ldu, v,
1004  $ ldu, tau, work, rwork, result( 3 ) )
1005  CALL chet21( 3, 'Lower', n, 1, a, lda, sd, se, u, ldu, v,
1006  $ ldu, tau, work, rwork, result( 4 ) )
1007 *
1008 * Store the upper triangle of A in AP
1009 *
1010  i = 0
1011  DO 120 jc = 1, n
1012  DO 110 jr = 1, jc
1013  i = i + 1
1014  ap( i ) = a( jr, jc )
1015  110 CONTINUE
1016  120 CONTINUE
1017 *
1018 * Call CHPTRD and CUPGTR to compute S and U from AP
1019 *
1020  CALL ccopy( nap, ap, 1, vp, 1 )
1021 *
1022  ntest = 5
1023  CALL chptrd( 'U', n, vp, sd, se, tau, iinfo )
1024 *
1025  IF( iinfo.NE.0 ) THEN
1026  WRITE( nounit, fmt = 9999 )'CHPTRD(U)', iinfo, n, jtype,
1027  $ ioldsd
1028  info = abs( iinfo )
1029  IF( iinfo.LT.0 ) THEN
1030  RETURN
1031  ELSE
1032  result( 5 ) = ulpinv
1033  GO TO 280
1034  END IF
1035  END IF
1036 *
1037  ntest = 6
1038  CALL cupgtr( 'U', n, vp, tau, u, ldu, work, iinfo )
1039  IF( iinfo.NE.0 ) THEN
1040  WRITE( nounit, fmt = 9999 )'CUPGTR(U)', iinfo, n, jtype,
1041  $ ioldsd
1042  info = abs( iinfo )
1043  IF( iinfo.LT.0 ) THEN
1044  RETURN
1045  ELSE
1046  result( 6 ) = ulpinv
1047  GO TO 280
1048  END IF
1049  END IF
1050 *
1051 * Do tests 5 and 6
1052 *
1053  CALL chpt21( 2, 'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1054  $ work, rwork, result( 5 ) )
1055  CALL chpt21( 3, 'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1056  $ work, rwork, result( 6 ) )
1057 *
1058 * Store the lower triangle of A in AP
1059 *
1060  i = 0
1061  DO 140 jc = 1, n
1062  DO 130 jr = jc, n
1063  i = i + 1
1064  ap( i ) = a( jr, jc )
1065  130 CONTINUE
1066  140 CONTINUE
1067 *
1068 * Call CHPTRD and CUPGTR to compute S and U from AP
1069 *
1070  CALL ccopy( nap, ap, 1, vp, 1 )
1071 *
1072  ntest = 7
1073  CALL chptrd( 'L', n, vp, sd, se, tau, iinfo )
1074 *
1075  IF( iinfo.NE.0 ) THEN
1076  WRITE( nounit, fmt = 9999 )'CHPTRD(L)', iinfo, n, jtype,
1077  $ ioldsd
1078  info = abs( iinfo )
1079  IF( iinfo.LT.0 ) THEN
1080  RETURN
1081  ELSE
1082  result( 7 ) = ulpinv
1083  GO TO 280
1084  END IF
1085  END IF
1086 *
1087  ntest = 8
1088  CALL cupgtr( 'L', n, vp, tau, u, ldu, work, iinfo )
1089  IF( iinfo.NE.0 ) THEN
1090  WRITE( nounit, fmt = 9999 )'CUPGTR(L)', iinfo, n, jtype,
1091  $ ioldsd
1092  info = abs( iinfo )
1093  IF( iinfo.LT.0 ) THEN
1094  RETURN
1095  ELSE
1096  result( 8 ) = ulpinv
1097  GO TO 280
1098  END IF
1099  END IF
1100 *
1101  CALL chpt21( 2, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1102  $ work, rwork, result( 7 ) )
1103  CALL chpt21( 3, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1104  $ work, rwork, result( 8 ) )
1105 *
1106 * Call CSTEQR to compute D1, D2, and Z, do tests.
1107 *
1108 * Compute D1 and Z
1109 *
1110  CALL scopy( n, sd, 1, d1, 1 )
1111  IF( n.GT.0 )
1112  $ CALL scopy( n-1, se, 1, rwork, 1 )
1113  CALL claset( 'Full', n, n, czero, cone, z, ldu )
1114 *
1115  ntest = 9
1116  CALL csteqr( 'V', n, d1, rwork, z, ldu, rwork( n+1 ),
1117  $ iinfo )
1118  IF( iinfo.NE.0 ) THEN
1119  WRITE( nounit, fmt = 9999 )'CSTEQR(V)', iinfo, n, jtype,
1120  $ ioldsd
1121  info = abs( iinfo )
1122  IF( iinfo.LT.0 ) THEN
1123  RETURN
1124  ELSE
1125  result( 9 ) = ulpinv
1126  GO TO 280
1127  END IF
1128  END IF
1129 *
1130 * Compute D2
1131 *
1132  CALL scopy( n, sd, 1, d2, 1 )
1133  IF( n.GT.0 )
1134  $ CALL scopy( n-1, se, 1, rwork, 1 )
1135 *
1136  ntest = 11
1137  CALL csteqr( 'N', n, d2, rwork, work, ldu, rwork( n+1 ),
1138  $ iinfo )
1139  IF( iinfo.NE.0 ) THEN
1140  WRITE( nounit, fmt = 9999 )'CSTEQR(N)', iinfo, n, jtype,
1141  $ ioldsd
1142  info = abs( iinfo )
1143  IF( iinfo.LT.0 ) THEN
1144  RETURN
1145  ELSE
1146  result( 11 ) = ulpinv
1147  GO TO 280
1148  END IF
1149  END IF
1150 *
1151 * Compute D3 (using PWK method)
1152 *
1153  CALL scopy( n, sd, 1, d3, 1 )
1154  IF( n.GT.0 )
1155  $ CALL scopy( n-1, se, 1, rwork, 1 )
1156 *
1157  ntest = 12
1158  CALL ssterf( n, d3, rwork, iinfo )
1159  IF( iinfo.NE.0 ) THEN
1160  WRITE( nounit, fmt = 9999 )'SSTERF', iinfo, n, jtype,
1161  $ ioldsd
1162  info = abs( iinfo )
1163  IF( iinfo.LT.0 ) THEN
1164  RETURN
1165  ELSE
1166  result( 12 ) = ulpinv
1167  GO TO 280
1168  END IF
1169  END IF
1170 *
1171 * Do Tests 9 and 10
1172 *
1173  CALL cstt21( n, 0, sd, se, d1, dumma, z, ldu, work, rwork,
1174  $ result( 9 ) )
1175 *
1176 * Do Tests 11 and 12
1177 *
1178  temp1 = zero
1179  temp2 = zero
1180  temp3 = zero
1181  temp4 = zero
1182 *
1183  DO 150 j = 1, n
1184  temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1185  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1186  temp3 = max( temp3, abs( d1( j ) ), abs( d3( j ) ) )
1187  temp4 = max( temp4, abs( d1( j )-d3( j ) ) )
1188  150 CONTINUE
1189 *
1190  result( 11 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1191  result( 12 ) = temp4 / max( unfl, ulp*max( temp3, temp4 ) )
1192 *
1193 * Do Test 13 -- Sturm Sequence Test of Eigenvalues
1194 * Go up by factors of two until it succeeds
1195 *
1196  ntest = 13
1197  temp1 = thresh*( half-ulp )
1198 *
1199  DO 160 j = 0, log2ui
1200  CALL sstech( n, sd, se, d1, temp1, rwork, iinfo )
1201  IF( iinfo.EQ.0 )
1202  $ GO TO 170
1203  temp1 = temp1*two
1204  160 CONTINUE
1205 *
1206  170 CONTINUE
1207  result( 13 ) = temp1
1208 *
1209 * For positive definite matrices ( JTYPE.GT.15 ) call CPTEQR
1210 * and do tests 14, 15, and 16 .
1211 *
1212  IF( jtype.GT.15 ) THEN
1213 *
1214 * Compute D4 and Z4
1215 *
1216  CALL scopy( n, sd, 1, d4, 1 )
1217  IF( n.GT.0 )
1218  $ CALL scopy( n-1, se, 1, rwork, 1 )
1219  CALL claset( 'Full', n, n, czero, cone, z, ldu )
1220 *
1221  ntest = 14
1222  CALL cpteqr( 'V', n, d4, rwork, z, ldu, rwork( n+1 ),
1223  $ iinfo )
1224  IF( iinfo.NE.0 ) THEN
1225  WRITE( nounit, fmt = 9999 )'CPTEQR(V)', iinfo, n,
1226  $ jtype, ioldsd
1227  info = abs( iinfo )
1228  IF( iinfo.LT.0 ) THEN
1229  RETURN
1230  ELSE
1231  result( 14 ) = ulpinv
1232  GO TO 280
1233  END IF
1234  END IF
1235 *
1236 * Do Tests 14 and 15
1237 *
1238  CALL cstt21( n, 0, sd, se, d4, dumma, z, ldu, work,
1239  $ rwork, result( 14 ) )
1240 *
1241 * Compute D5
1242 *
1243  CALL scopy( n, sd, 1, d5, 1 )
1244  IF( n.GT.0 )
1245  $ CALL scopy( n-1, se, 1, rwork, 1 )
1246 *
1247  ntest = 16
1248  CALL cpteqr( 'N', n, d5, rwork, z, ldu, rwork( n+1 ),
1249  $ iinfo )
1250  IF( iinfo.NE.0 ) THEN
1251  WRITE( nounit, fmt = 9999 )'CPTEQR(N)', iinfo, n,
1252  $ jtype, ioldsd
1253  info = abs( iinfo )
1254  IF( iinfo.LT.0 ) THEN
1255  RETURN
1256  ELSE
1257  result( 16 ) = ulpinv
1258  GO TO 280
1259  END IF
1260  END IF
1261 *
1262 * Do Test 16
1263 *
1264  temp1 = zero
1265  temp2 = zero
1266  DO 180 j = 1, n
1267  temp1 = max( temp1, abs( d4( j ) ), abs( d5( j ) ) )
1268  temp2 = max( temp2, abs( d4( j )-d5( j ) ) )
1269  180 CONTINUE
1270 *
1271  result( 16 ) = temp2 / max( unfl,
1272  $ hun*ulp*max( temp1, temp2 ) )
1273  ELSE
1274  result( 14 ) = zero
1275  result( 15 ) = zero
1276  result( 16 ) = zero
1277  END IF
1278 *
1279 * Call SSTEBZ with different options and do tests 17-18.
128