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

Functions

subroutine zbdt01 (M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
 ZBDT01 More...
 
subroutine zbdt02 (M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
 ZBDT02 More...
 
subroutine zbdt03 (UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
 ZBDT03 More...
 
subroutine zchkbb (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)
 ZCHKBB More...
 
subroutine zchkbd (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)
 ZCHKBD More...
 
subroutine zchkbk (NIN, NOUT)
 ZCHKBK More...
 
subroutine zchkbl (NIN, NOUT)
 ZCHKBL More...
 
subroutine zchkec (THRESH, TSTERR, NIN, NOUT)
 ZCHKEC More...
 
program zchkee
 ZCHKEE More...
 
subroutine zchkgg (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)
 ZCHKGG More...
 
subroutine zchkgk (NIN, NOUT)
 ZCHKGK More...
 
subroutine zchkgl (NIN, NOUT)
 ZCHKGL More...
 
subroutine zchkhb (NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK, LWORK, RWORK, RESULT, INFO)
 ZCHKHB More...
 
subroutine zchkhs (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)
 ZCHKHS More...
 
subroutine zchkst (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)
 ZCHKST More...
 
subroutine zckcsd (NM, MVAL, PVAL, QVAL, NMATS, ISEED, THRESH, MMAX, X, XF, U1, U2, V1T, V2T, THETA, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 ZCKCSD More...
 
subroutine zckglm (NN, NVAL, MVAL, PVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 ZCKGLM More...
 
subroutine zckgqr (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)
 ZCKGQR More...
 
subroutine zckgsv (NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 ZCKGSV More...
 
subroutine zcklse (NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 ZCKLSE More...
 
subroutine zcsdts (M, P, Q, X, XF, LDX, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, THETA, IWORK, WORK, LWORK, RWORK, RESULT)
 ZCSDTS More...
 
subroutine zdrges (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO)
 ZDRGES More...
 
subroutine zdrges3 (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO)
 ZDRGES3 More...
 
subroutine zdrgev (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)
 ZDRGEV More...
 
subroutine zdrgev3 (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)
 ZDRGEV3 More...
 
subroutine zdrgsx (NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, BI, Z, Q, ALPHA, BETA, C, LDC, S, WORK, LWORK, RWORK, IWORK, LIWORK, BWORK, INFO)
 ZDRGSX More...
 
subroutine zdrgvx (NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI, ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE, S, DTRU, DIF, DIFTRU, WORK, LWORK, RWORK, IWORK, LIWORK, RESULT, BWORK, INFO)
 ZDRGVX More...
 
subroutine zdrvbd (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)
 ZDRVBD More...
 
subroutine zdrves (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT, WORK, NWORK, RWORK, IWORK, BWORK, INFO)
 ZDRVES More...
 
subroutine zdrvev (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK, INFO)
 ZDRVEV More...
 
subroutine zdrvsg (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)
 ZDRVSG More...
 
subroutine zdrvst (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)
 ZDRVST More...
 
subroutine zdrvsx (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NIUNIT, NOUNIT, A, LDA, H, HT, W, WT, WTMP, VS, LDVS, VS1, RESULT, WORK, LWORK, RWORK, BWORK, INFO)
 ZDRVSX More...
 
subroutine zdrvvx (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)
 ZDRVVX More...
 
subroutine zerrbd (PATH, NUNIT)
 ZERRBD More...
 
subroutine zerrec (PATH, NUNIT)
 ZERREC More...
 
subroutine zerred (PATH, NUNIT)
 ZERRED More...
 
subroutine zerrgg (PATH, NUNIT)
 ZERRGG More...
 
subroutine zerrhs (PATH, NUNIT)
 ZERRHS More...
 
subroutine zerrst (PATH, NUNIT)
 ZERRST More...
 
subroutine zget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZGET02 More...
 
subroutine zget10 (M, N, A, LDA, B, LDB, WORK, RWORK, RESULT)
 ZGET10 More...
 
subroutine zget22 (TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
 ZGET22 More...
 
subroutine zget23 (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)
 ZGET23 More...
 
subroutine zget24 (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)
 ZGET24 More...
 
subroutine zget35 (RMAX, LMAX, NINFO, KNT, NIN)
 ZGET35 More...
 
subroutine zget36 (RMAX, LMAX, NINFO, KNT, NIN)
 ZGET36 More...
 
subroutine zget37 (RMAX, LMAX, NINFO, KNT, NIN)
 ZGET37 More...
 
subroutine zget38 (RMAX, LMAX, NINFO, KNT, NIN)
 ZGET38 More...
 
subroutine zget51 (ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
 ZGET51 More...
 
subroutine zget52 (LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
 ZGET52 More...
 
subroutine zget54 (N, A, LDA, B, LDB, S, LDS, T, LDT, U, LDU, V, LDV, WORK, RESULT)
 ZGET54 More...
 
subroutine zglmts (N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
 ZGLMTS More...
 
subroutine zgqrts (N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 ZGQRTS More...
 
subroutine zgrqts (M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 ZGRQTS More...
 
subroutine zgsvts3 (M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V, LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK, LWORK, RWORK, RESULT)
 ZGSVTS3 More...
 
subroutine zhbt21 (UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RWORK, RESULT)
 ZHBT21 More...
 
subroutine zhet21 (ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
 ZHET21 More...
 
subroutine zhet22 (ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RWORK, RESULT)
 ZHET22 More...
 
subroutine zhpt21 (ITYPE, UPLO, N, KBAND, AP, D, E, U, LDU, VP, TAU, WORK, RWORK, RESULT)
 ZHPT21 More...
 
subroutine zhst01 (N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
 ZHST01 More...
 
subroutine zlarfy (UPLO, N, V, INCV, TAU, C, LDC, WORK)
 ZLARFY More...
 
subroutine zlarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 ZLARHS More...
 
subroutine zlatm4 (ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
 ZLATM4 More...
 
logical function zlctes (Z, D)
 ZLCTES More...
 
logical function zlctsx (ALPHA, BETA)
 ZLCTSX More...
 
subroutine zlsets (M, P, N, A, AF, LDA, B, BF, LDB, C, CF, D, DF, X, WORK, LWORK, RWORK, RESULT)
 ZLSETS More...
 
subroutine zsbmv (UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
 ZSBMV More...
 
subroutine zsgt01 (ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
 ZSGT01 More...
 
logical function zslect (Z)
 ZSLECT More...
 
subroutine zstt21 (N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RWORK, RESULT)
 ZSTT21 More...
 
subroutine zstt22 (N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RWORK, RESULT)
 ZSTT22 More...
 
subroutine zunt01 (ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
 ZUNT01 More...
 
subroutine zunt03 (RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RWORK, RESULT, INFO)
 ZUNT03 More...
 

Detailed Description

This is the group of complex16 LAPACK TESTING EIG routines.

Function Documentation

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

ZBDT01

Purpose:
 ZBDT01 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*16 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*16 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 DOUBLE PRECISION array, dimension (min(M,N))
          The diagonal elements of the bidiagonal matrix B.
[in]E
          E is DOUBLE PRECISION 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*16 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*16 array, dimension (M+N)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (M)
[out]RESID
          RESID is DOUBLE PRECISION
          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 zbdt01.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  DOUBLE PRECISION resid
157 * ..
158 * .. Array Arguments ..
159  DOUBLE PRECISION d( * ), e( * ), rwork( * )
160  COMPLEX*16 a( lda, * ), pt( ldpt, * ), q( ldq, * ),
161  $ work( * )
162 * ..
163 *
164 * =====================================================================
165 *
166 * .. Parameters ..
167  DOUBLE PRECISION zero, one
168  parameter( zero = 0.0d+0, one = 1.0d+0 )
169 * ..
170 * .. Local Scalars ..
171  INTEGER i, j
172  DOUBLE PRECISION anorm, eps
173 * ..
174 * .. External Functions ..
175  DOUBLE PRECISION dlamch, dzasum, zlange
176  EXTERNAL dlamch, dzasum, zlange
177 * ..
178 * .. External Subroutines ..
179  EXTERNAL zcopy, zgemv
180 * ..
181 * .. Intrinsic Functions ..
182  INTRINSIC dble, dcmplx, max, min
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 zcopy( 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 zgemv( 'No transpose', m, n, -dcmplx( one ), q, ldq,
211  $ work( m+1 ), 1, dcmplx( one ), work, 1 )
212  resid = max( resid, dzasum( 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 zcopy( 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 zgemv( 'No transpose', m, m, -dcmplx( one ), q, ldq,
225  $ work( m+1 ), 1, dcmplx( one ), work, 1 )
226  resid = max( resid, dzasum( m, work, 1 ) )
227  40 CONTINUE
228  ELSE
229 *
230 * B is lower bidiagonal.
231 *
232  DO 60 j = 1, n
233  CALL zcopy( 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 zgemv( 'No transpose', m, m, -dcmplx( one ), q, ldq,
240  $ work( m+1 ), 1, dcmplx( one ), work, 1 )
241  resid = max( resid, dzasum( 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 zcopy( 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 zgemv( 'No transpose', m, n, -dcmplx( one ), q, ldq,
255  $ work( m+1 ), 1, dcmplx( one ), work, 1 )
256  resid = max( resid, dzasum( m, work, 1 ) )
257  80 CONTINUE
258  ELSE
259  DO 100 j = 1, n
260  CALL zcopy( 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 zgemv( 'No transpose', m, m, -dcmplx( one ), q, ldq,
265  $ work( m+1 ), 1, dcmplx( one ), work, 1 )
266  resid = max( resid, dzasum( 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 = zlange( '1', m, n, a, lda, rwork )
274  eps = dlamch( '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 ) / ( dble( n )*eps )
282  ELSE
283  IF( anorm.LT.one ) THEN
284  resid = ( min( resid, dble( n )*anorm ) / anorm ) /
285  $ ( dble( n )*eps )
286  ELSE
287  resid = min( resid / anorm, dble( n ) ) /
288  $ ( dble( n )*eps )
289  END IF
290  END IF
291  END IF
292 *
293  RETURN
294 *
295 * End of ZBDT01
296 *
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:54
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
Definition: zgemv.f:160
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zbdt02 ( integer  M,
integer  N,
complex*16, dimension( ldb, * )  B,
integer  LDB,
complex*16, dimension( ldc, * )  C,
integer  LDC,
complex*16, dimension( ldu, * )  U,
integer  LDU,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
double precision  RESID 
)

ZBDT02

Purpose:
 ZBDT02 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*16 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*16 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*16 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*16 array, dimension (M)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (M)
[out]RESID
          RESID is DOUBLE PRECISION
          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 zbdt02.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  DOUBLE PRECISION resid
130 * ..
131 * .. Array Arguments ..
132  DOUBLE PRECISION rwork( * )
133  COMPLEX*16 b( ldb, * ), c( ldc, * ), u( ldu, * ),
134  $ work( * )
135 * ..
136 *
137 * ======================================================================
138 *
139 * .. Parameters ..
140  DOUBLE PRECISION zero, one
141  parameter( zero = 0.0d+0, one = 1.0d+0 )
142 * ..
143 * .. Local Scalars ..
144  INTEGER j
145  DOUBLE PRECISION bnorm, eps, realmn
146 * ..
147 * .. External Functions ..
148  DOUBLE PRECISION dlamch, dzasum, zlange
149  EXTERNAL dlamch, dzasum, zlange
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL zcopy, zgemv
153 * ..
154 * .. Intrinsic Functions ..
155  INTRINSIC dble, dcmplx, max, min
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 = dble( max( m, n ) )
165  eps = dlamch( 'Precision' )
166 *
167 * Compute norm( B - U * C )
168 *
169  DO 10 j = 1, n
170  CALL zcopy( m, b( 1, j ), 1, work, 1 )
171  CALL zgemv( 'No transpose', m, m, -dcmplx( one ), u, ldu,
172  $ c( 1, j ), 1, dcmplx( one ), work, 1 )
173  resid = max( resid, dzasum( m, work, 1 ) )
174  10 CONTINUE
175 *
176 * Compute norm of B.
177 *
178  bnorm = zlange( '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 ZBDT02
198 *
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:54
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
Definition: zgemv.f:160
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zbdt03 ( character  UPLO,
integer  N,
integer  KD,
double precision, dimension( * )  D,
double precision, dimension( * )  E,
complex*16, dimension( ldu, * )  U,
integer  LDU,
double precision, dimension( * )  S,
complex*16, dimension( ldvt, * )  VT,
integer  LDVT,
complex*16, dimension( * )  WORK,
double precision  RESID 
)

ZBDT03

Purpose:
 ZBDT03 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 DOUBLE PRECISION array, dimension (N)
          The n diagonal elements of the bidiagonal matrix B.
[in]E
          E is DOUBLE PRECISION 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*16 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 DOUBLE PRECISION array, dimension (N)
          The singular values from the SVD of B, sorted in decreasing
          order.
[in]VT
          VT is COMPLEX*16 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*16 array, dimension (2*N)
[out]RESID
          RESID is DOUBLE PRECISION
          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 zbdt03.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  DOUBLE PRECISION resid
147 * ..
148 * .. Array Arguments ..
149  DOUBLE PRECISION d( * ), e( * ), s( * )
150  COMPLEX*16 u( ldu, * ), vt( ldvt, * ), work( * )
151 * ..
152 *
153 * ======================================================================
154 *
155 * .. Parameters ..
156  DOUBLE PRECISION zero, one
157  parameter( zero = 0.0d+0, one = 1.0d+0 )
158 * ..
159 * .. Local Scalars ..
160  INTEGER i, j
161  DOUBLE PRECISION bnorm, eps
162 * ..
163 * .. External Functions ..
164  LOGICAL lsame
165  INTEGER idamax
166  DOUBLE PRECISION dlamch, dzasum
167  EXTERNAL lsame, idamax, dlamch, dzasum
168 * ..
169 * .. External Subroutines ..
170  EXTERNAL zgemv
171 * ..
172 * .. Intrinsic Functions ..
173  INTRINSIC abs, dble, dcmplx, max, min
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 zgemv( 'No transpose', n, n, -dcmplx( one ), u, ldu,
199  $ work( n+1 ), 1, dcmplx( 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, dzasum( 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 zgemv( 'No transpose', n, n, -dcmplx( one ), u, ldu,
218  $ work( n+1 ), 1, dcmplx( 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, dzasum( 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 zgemv( 'No transpose', n, n, -dcmplx( one ), u, ldu,
238  $ work( n+1 ), 1, dcmplx( zero ), work, 1 )
239  work( j ) = work( j ) + d( j )
240  resid = max( resid, dzasum( n, work, 1 ) )
241  60 CONTINUE
242  j = idamax( 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 = dlamch( '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 ) / ( dble( n )*eps )
256  ELSE
257  IF( bnorm.LT.one ) THEN
258  resid = ( min( resid, dble( n )*bnorm ) / bnorm ) /
259  $ ( dble( n )*eps )
260  ELSE
261  resid = min( resid / bnorm, dble( n ) ) /
262  $ ( dble( n )*eps )
263  END IF
264  END IF
265  END IF
266 *
267  RETURN
268 *
269 * End of ZBDT03
270 *
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:54
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
Definition: zgemv.f:160
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:53

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKBB

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

 ZGBBRD factors a general band matrix A as  Q B P* , where * means
 conjugate transpose, B is upper bidiagonal, and Q and P are unitary;
 ZGBBRD 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, ZCHKBB 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,
          ZCHKBB 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, ZCHKBB
          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 ZCHKBB to continue the same random number
          sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (max(NN))
          Used to hold the diagonal of the bidiagonal matrix computed
          by ZGBBRD.
[out]BE
          BE is DOUBLE PRECISION array, dimension (max(NN))
          Used to hold the off-diagonal of the bidiagonal matrix
          computed by ZGBBRD.
[out]Q
          Q is COMPLEX*16 array, dimension (LDQ, max(NN))
          Used to hold the unitary matrix Q computed by ZGBBRD.
[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*16 array, dimension (LDP, max(NN))
          Used to hold the unitary matrix P computed by ZGBBRD.
[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*16 array, dimension (LDC, max(NN))
          Used to hold the matrix C updated by ZGBBRD.
[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*16 array, dimension (LDC, max(NN))
          Used to hold a copy of the matrix C.
[out]WORK
          WORK is COMPLEX*16 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 DOUBLE PRECISION array, dimension (max(NN))
[out]RESULT
          RESULT is DOUBLE PRECISION 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 zchkbb.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  DOUBLE PRECISION thresh
373 * ..
374 * .. Array Arguments ..
375  LOGICAL dotype( * )
376  INTEGER iseed( 4 ), kk( * ), mval( * ), nval( * )
377  DOUBLE PRECISION bd( * ), be( * ), result( * ), rwork( * )
378  COMPLEX*16 a( lda, * ), ab( ldab, * ), c( ldc, * ),
379  $ cc( ldc, * ), p( ldp, * ), q( ldq, * ),
380  $ work( * )
381 * ..
382 *
383 * =====================================================================
384 *
385 * .. Parameters ..
386  COMPLEX*16 czero, cone
387  parameter( czero = ( 0.0d+0, 0.0d+0 ),
388  $ cone = ( 1.0d+0, 0.0d+0 ) )
389  DOUBLE PRECISION zero, one
390  parameter( zero = 0.0d+0, one = 1.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION dlamch
409  EXTERNAL dlamch
410 * ..
411 * .. External Subroutines ..
412  EXTERNAL dlahd2, dlasum, xerbla, zbdt01, zbdt02, zgbbrd,
414 * ..
415 * .. Intrinsic Functions ..
416  INTRINSIC abs, dble, max, min, 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( 'ZCHKBB', -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 = dlamch( 'Safe minimum' )
499  ovfl = one / unfl
500  ulp = dlamch( 'Epsilon' )*dlamch( '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 / dble( 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 zlaset( 'Full', lda, n, czero, czero, a, lda )
579  CALL zlaset( '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 zlatms( 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 zlatms( 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 zlatmr( 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 zlatmr( 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 zlacpy( 'Full', m, nrhs, c, ldc, cc, ldc )
656 *
657 * Call ZGBBRD to compute B, Q and P, and to update C.
658 *
659  CALL zgbbrd( '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 )'ZGBBRD', 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 zbdt01( m, n, -1, a, lda, q, ldq, bd, be, p, ldp,
681  $ work, rwork, result( 1 ) )
682  CALL zunt01( 'Columns', m, m, q, ldq, work, lwork, rwork,
683  $ result( 2 ) )
684  CALL zunt01( 'Rows', n, n, p, ldp, work, lwork, rwork,
685  $ result( 3 ) )
686  CALL zbdt02( 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 dlahd2( nounit, 'ZBB' )
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 dlasum( 'ZBB', nounit, nerrs, ntestt )
714  RETURN
715 *
716  9999 FORMAT( ' ZCHKBB: ', 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 ZCHKBB
723 *
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zgbbrd(VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, LDQ, PT, LDPT, C, LDC, WORK, RWORK, INFO)
ZGBBRD
Definition: zgbbrd.f:195
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
Definition: zunt01.f:128
subroutine zlatmr(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)
ZLATMR
Definition: zlatmr.f:492
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine dlahd2(IOUNIT, PATH)
DLAHD2
Definition: dlahd2.f:67
subroutine zbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
ZBDT02
Definition: zbdt02.f:121
subroutine zbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
ZBDT01
Definition: zbdt01.f:148
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKBD

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

 ZGEBRD 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.

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

 ZBDSQR 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, ZBDSQR 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 ZGEBRD and ZUNGBR

 (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 ZBDSQR 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
       DSVDCH)

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

 Test ZBDSQR 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) ZGEBRD 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, ZCHKBD
          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 ZBDSQR.  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 ZCHKBD to continue the same random
          number sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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*16 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 DOUBLE PRECISION array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]BE
          BE is DOUBLE PRECISION array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S1
          S1 is DOUBLE PRECISION array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S2
          S2 is DOUBLE PRECISION array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]X
          X is COMPLEX*16 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*16 array, dimension (LDX,NRHS)
[out]Z
          Z is COMPLEX*16 array, dimension (LDX,NRHS)
[out]Q
          Q is COMPLEX*16 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*16 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*16 array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]VT
          VT is COMPLEX*16 array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]WORK
          WORK is COMPLEX*16 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 DOUBLE PRECISION 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  ZLATMR, CLATMS, ZGEBRD, ZUNGBR, or ZBDSQR,
              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 zchkbd.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  DOUBLE PRECISION thresh
427 * ..
428 * .. Array Arguments ..
429  LOGICAL dotype( * )
430  INTEGER iseed( 4 ), mval( * ), nval( * )
431  DOUBLE PRECISION bd( * ), be( * ), rwork( * ), s1( * ), s2( * )
432  COMPLEX*16 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  DOUBLE PRECISION zero, one, two, half
441  parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
442  $ half = 0.5d0 )
443  COMPLEX*16 czero, cone
444  parameter( czero = ( 0.0d+0, 0.0d+0 ),
445  $ cone = ( 1.0d+0, 0.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION dumma( 1 ), result( 14 )
463 * ..
464 * .. External Functions ..
465  DOUBLE PRECISION dlamch, dlarnd
466  EXTERNAL dlamch, dlarnd
467 * ..
468 * .. External Subroutines ..
469  EXTERNAL alasum, dcopy, dlabad, dlahd2, dsvdch, xerbla,
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( 'ZCHKBD', -info )
542  RETURN
543  END IF
544 *
545 * Initialize constants
546 *
547  path( 1: 1 ) = 'Zomplex precision'
548  path( 2: 3 ) = 'BD'
549  nfail = 0
550  ntest = 0
551  unfl = dlamch( 'Safe minimum' )
552  ovfl = dlamch( 'Overflow' )
553  CALL dlabad( unfl, ovfl )
554  ulp = dlamch( '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 zlaset( '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 zlatms( 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 zlatms( 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 zlatms( 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 zlatmr( 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 zlatmr( 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 zlatmr( 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*dlarnd( 2, iseed ) )
705  IF( j.LT.mnmin )
706  $ be( j ) = exp( temp1*dlarnd( 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 zlatmr( 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 zlatmr( 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 ZGEBRD and ZUNGBR 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 zlacpy( ' ', m, n, a, lda, q, ldq )
758  CALL zgebrd( 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 ZGEBRD.
762 *
763  IF( iinfo.NE.0 ) THEN
764  WRITE( nout, fmt = 9998 )'ZGEBRD', iinfo, m, n,
765  $ jtype, ioldsd
766  info = abs( iinfo )
767  RETURN
768  END IF
769 *
770  CALL zlacpy( ' ', 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 zungbr( 'Q', m, mq, n, q, ldq, work,
783  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
784 *
785 * Check error code from ZUNGBR.
786 *
787  IF( iinfo.NE.0 ) THEN
788  WRITE( nout, fmt = 9998 )'ZUNGBR(Q)', iinfo, m, n,
789  $ jtype, ioldsd
790  info = abs( iinfo )
791  RETURN
792  END IF
793 *
794 * Generate P'
795 *
796  CALL zungbr( 'P', mnmin, n, m, pt, ldpt, work( mnmin+1 ),
797  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
798 *
799 * Check error code from ZUNGBR.
800 *
801  IF( iinfo.NE.0 ) THEN
802  WRITE( nout, fmt = 9998 )'ZUNGBR(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 zgemm( '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 zbdt01( m, n, 1, a, lda, q, ldq, bd, be, pt, ldpt,
819  $ work, rwork, result( 1 ) )
820  CALL zunt01( 'Columns', m, mq, q, ldq, work, lwork,
821  $ rwork, result( 2 ) )
822  CALL zunt01( 'Rows', mnmin, n, pt, ldpt, work, lwork,
823  $ rwork, result( 3 ) )
824  END IF
825 *
826 * Use ZBDSQR to form the SVD of the bidiagonal matrix B:
827 * B := U * S1 * VT, and compute Z = U' * Y.
828 *
829  CALL dcopy( mnmin, bd, 1, s1, 1 )
830  IF( mnmin.GT.0 )
831  $ CALL dcopy( mnmin-1, be, 1, rwork, 1 )
832  CALL zlacpy( ' ', m, nrhs, y, ldx, z, ldx )
833  CALL zlaset( 'Full', mnmin, mnmin, czero, cone, u, ldpt )
834  CALL zlaset( 'Full', mnmin, mnmin, czero, cone, vt, ldpt )
835 *
836  CALL zbdsqr( 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 ZBDSQR.
841 *
842  IF( iinfo.NE.0 ) THEN
843  WRITE( nout, fmt = 9998 )'ZBDSQR(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 ZBDSQR to compute only the singular values of the
855 * bidiagonal matrix B; U, VT, and Z should not be modified.
856 *
857  CALL dcopy( mnmin, bd, 1, s2, 1 )
858  IF( mnmin.GT.0 )
859  $ CALL dcopy( mnmin-1, be, 1, rwork, 1 )
860 *
861  CALL zbdsqr( uplo, mnmin, 0, 0, 0, s2, rwork, vt, ldpt, u,
862  $ ldpt, z, ldx, rwork( mnmin+1 ), iinfo )
863 *
864 * Check error code from ZBDSQR.
865 *
866  IF( iinfo.NE.0 ) THEN
867  WRITE( nout, fmt = 9998 )'ZBDSQR(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 zbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
884  $ work, result( 4 ) )
885  CALL zbdt02( mnmin, nrhs, y, ldx, z, ldx, u, ldpt, work,
886  $ rwork, result( 5 ) )
887  CALL zunt01( 'Columns', mnmin, mnmin, u, ldpt, work, lwork,
888  $ rwork, result( 6 ) )
889  CALL zunt01( '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 ZBDSQR 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 dsvdch( 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 ZBDSQR 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 dcopy( mnmin, bd, 1, s2, 1 )
940  IF( mnmin.GT.0 )
941  $ CALL dcopy( mnmin-1, be, 1, rwork, 1 )
942 *
943  CALL zbdsqr( 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 zbdt01( m, n, 0, a, lda, q, ldq, s2, dumma, pt,
953  $ ldpt, work, rwork, result( 11 ) )
954  CALL zbdt02( m, nrhs, x, ldx, y, ldx, q, ldq, work,
955  $ rwork, result( 12 ) )
956  CALL zunt01( 'Columns', m, mq, q, ldq, work, lwork,
957  $ rwork, result( 13 ) )
958  CALL zunt01( '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 dlahd2( 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 ZCHKBD
990 *
991  9999 FORMAT( ' M=', i5, ', N=', i5, ', type ', i2, ', seed=',
992  $ 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
993  9998 FORMAT( ' ZCHKBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
994  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
995  $ i5, ')' )
996 *
subroutine zbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
ZBDSQR
Definition: zbdsqr.f:224
double precision function dlarnd(IDIST, ISEED)
DLARND
Definition: dlarnd.f:75
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine zbdt03(UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
ZBDT03
Definition: zbdt03.f:137
subroutine zgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
ZGEBRD
Definition: zgebrd.f:207
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
subroutine zungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGBR
Definition: zungbr.f:159
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
Definition: zunt01.f:128
subroutine zlatmr(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)
ZLATMR
Definition: zlatmr.f:492
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine dlahd2(IOUNIT, PATH)
DLAHD2
Definition: dlahd2.f:67
subroutine zbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
ZBDT02
Definition: zbdt02.f:121
subroutine zbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
ZBDT01
Definition: zbdt01.f:148
subroutine dsvdch(N, S, E, SVD, TOL, INFO)
DSVDCH
Definition: dsvdch.f:99
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:53

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zchkbk ( integer  NIN,
integer  NOUT 
)

ZCHKBK

Purpose:
 ZCHKBK tests ZGEBAK, a routine for backward transformation of
 the computed right or left eigenvectors if the orginal matrix
 was preprocessed by balance subroutine ZGEBAL.
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 zchkbk.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  DOUBLE PRECISION zero
73  parameter( zero = 0.0d0 )
74 * ..
75 * .. Local Scalars ..
76  INTEGER i, ihi, ilo, info, j, knt, n, ninfo
77  DOUBLE PRECISION eps, rmax, safmin, vmax, x
78  COMPLEX*16 cdum
79 * ..
80 * .. Local Arrays ..
81  INTEGER lmax( 2 )
82  DOUBLE PRECISION scale( lde )
83  COMPLEX*16 e( lde, lde ), ein( lde, lde )
84 * ..
85 * .. External Functions ..
86  DOUBLE PRECISION dlamch
87  EXTERNAL dlamch
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL zgebak
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, dble, dimag, max
94 * ..
95 * .. Statement Functions ..
96  DOUBLE PRECISION cabs1
97 * ..
98 * .. Statement Function definitions ..
99  cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( 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 = dlamch( 'E' )
109  safmin = dlamch( '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 zgebak( '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 ZGEBAK .. ' )
155 *
156  WRITE( nout, fmt = 9998 )rmax
157  9998 FORMAT( 1x, 'value of largest test error = ', d12.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 ZCHKBK
170 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lde(RI, RJ, LR)
Definition: dblat2.f:2945
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
Definition: zgebak.f:133

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zchkbl ( integer  NIN,
integer  NOUT 
)

ZCHKBL

Purpose:
 ZCHKBL tests ZGEBAL, 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 zchkbl.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  DOUBLE PRECISION zero
72  parameter( zero = 0.0d+0 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
76  $ ninfo
77  DOUBLE PRECISION anorm, meps, rmax, sfmin, temp, vmax
78  COMPLEX*16 cdum
79 * ..
80 * .. Local Arrays ..
81  INTEGER lmax( 3 )
82  DOUBLE PRECISION dummy( 1 ), scale( lda ), scalin( lda )
83  COMPLEX*16 a( lda, lda ), ain( lda, lda )
84 * ..
85 * .. External Functions ..
86  DOUBLE PRECISION dlamch, zlange
87  EXTERNAL dlamch, zlange
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL zgebal
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, dble, dimag, max
94 * ..
95 * .. Statement Functions ..
96  DOUBLE PRECISION cabs1
97 * ..
98 * .. Statement Function definitions ..
99  cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( 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 = dlamch( 'S' )
111  meps = dlamch( '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 = zlange( 'M', n, n, a, lda, dummy )
129  knt = knt + 1
130  CALL zgebal( '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 ZGEBAL .. ' )
167 *
168  WRITE( nout, fmt = 9998 )rmax
169  9998 FORMAT( 1x, 'value of largest test error = ', d12.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 ZCHKBL
184 *
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zchkec ( double precision  THRESH,
logical  TSTERR,
integer  NIN,
integer  NOUT 
)

ZCHKEC

Purpose:
 ZCHKEC tests eigen- condition estimation routines
        ZTRSYL, 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, ZTRSNA 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 DOUBLE PRECISION
          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
September 2012

Definition at line 77 of file zchkec.f.

77 *
78 * -- LAPACK test routine (version 3.4.2) --
79 * -- LAPACK is a software package provided by Univ. of Tennessee, --
80 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
81 * September 2012
82 *
83 * .. Scalar Arguments ..
84  LOGICAL tsterr
85  INTEGER nin, nout
86  DOUBLE PRECISION 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  DOUBLE PRECISION eps, rtrexc, rtrsyl, sfmin
97 * ..
98 * .. Local Arrays ..
99  INTEGER ltrsen( 3 ), ltrsna( 3 ), ntrsen( 3 ),
100  $ ntrsna( 3 )
101  DOUBLE PRECISION rtrsen( 3 ), rtrsna( 3 )
102 * ..
103 * .. External Subroutines ..
104  EXTERNAL zerrec, zget35, zget36, zget37, zget38
105 * ..
106 * .. External Functions ..
107  DOUBLE PRECISION dlamch
108  EXTERNAL dlamch
109 * ..
110 * .. Executable Statements ..
111 *
112  path( 1: 1 ) = 'Zomplex precision'
113  path( 2: 3 ) = 'EC'
114  eps = dlamch( 'P' )
115  sfmin = dlamch( '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 zerrec( path, nout )
124 *
125  ok = .true.
126  CALL zget35( 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 zget36( 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 zget37( 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 zget38( 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 ZTRSYL: RMAX =', d12.3, / ' LMAX = ', i8,
159  $ ' NINFO=', i8, ' KNT=', i8 )
160  9998 FORMAT( ' Error in ZTREXC: RMAX =', d12.3, / ' LMAX = ', i8,
161  $ ' NINFO=', i8, ' KNT=', i8 )
162  9997 FORMAT( ' Error in ZTRSNA: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
163  $ ' NINFO=', 3i8, ' KNT=', i8 )
164  9996 FORMAT( ' Error in ZTRSEN: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
165  $ ' 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', / ' ZTRSYL, ZTREXC, ZTRSNA, ZTRSEN',
170  $ / )
171  9993 FORMAT( ' Relative machine precision (EPS) = ', d16.6,
172  $ / ' Safe minimum (SFMIN) = ', d16.6, / )
173  9992 FORMAT( ' Routines pass computational tests if test ratio is ',
174  $ 'less than', f8.2, / / )
175  RETURN
176 *
177 * End of ZCHKEC
178 *
subroutine zget37(RMAX, LMAX, NINFO, KNT, NIN)
ZGET37
Definition: zget37.f:92
subroutine zget35(RMAX, LMAX, NINFO, KNT, NIN)
ZGET35
Definition: zget35.f:86
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zerrec(PATH, NUNIT)
ZERREC
Definition: zerrec.f:58
subroutine zget36(RMAX, LMAX, NINFO, KNT, NIN)
ZGET36
Definition: zget36.f:87
subroutine zget38(RMAX, LMAX, NINFO, KNT, NIN)
ZGET38
Definition: zget38.f:93

Here is the call graph for this function:

Here is the caller graph for this function:

program zchkee ( )

ZCHKEE

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

 NEP (Nonsymmetric Eigenvalue Problem):
     Test ZGEHRD, ZUNGHR, ZHSEQR, ZTREVC, ZHSEIN, and ZUNMHR

 SEP (Hermitian Eigenvalue Problem):
     Test ZHETRD, ZUNGTR, ZSTEQR, ZSTERF, ZSTEIN, ZSTEDC,
     and drivers ZHEEV(X), ZHBEV(X), ZHPEV(X),
                 ZHEEVD,   ZHBEVD,   ZHPEVD

 SVD (Singular Value Decomposition):
     Test ZGEBRD, ZUNGBR, and ZBDSQR
     and the drivers ZGESVD, ZGESDD

 ZEV (Nonsymmetric Eigenvalue/eigenvector Driver):
     Test ZGEEV

 ZES (Nonsymmetric Schur form Driver):
     Test ZGEES

 ZVX (Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test ZGEEVX

 ZSX (Nonsymmetric Schur form Expert Driver):
     Test ZGEESX

 ZGG (Generalized Nonsymmetric Eigenvalue Problem):
     Test ZGGHD3, ZGGBAL, ZGGBAK, ZHGEQZ, and ZTGEVC

 ZGS (Generalized Nonsymmetric Schur form Driver):
     Test ZGGES

 ZGV (Generalized Nonsymmetric Eigenvalue/eigenvector Driver):
     Test ZGGEV

 ZGX (Generalized Nonsymmetric Schur form Expert Driver):
     Test ZGGESX

 ZXV (Generalized Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test ZGGEVX

 ZSG (Hermitian Generalized Eigenvalue Problem):
     Test ZHEGST, ZHEGV, ZHEGVD, ZHEGVX, ZHPGST, ZHPGV, ZHPGVD,
     ZHPGVX, ZHBGST, ZHBGV, ZHBGVD, and ZHBGVX

 ZHB (Hermitian Band Eigenvalue Problem):
     Test ZHBTRD

 ZBB (Band Singular Value Decomposition):
     Test ZGBBRD

 ZEC (Eigencondition estimation):
     Test ZTRSYL, ZTREXC, ZTRSNA, and ZTRSEN

 ZBL (Balancing a general matrix)
     Test ZGEBAL

 ZBK (Back transformation on a balanced matrix)
     Test ZGEBAK

 ZGL (Balancing a matrix pair)
     Test ZGGBAL

 ZGK (Back transformation on a matrix pair)
     Test ZGGBAK

 GLM (Generalized Linear Regression Model):
     Tests ZGGGLM

 GQR (Generalized QR and RQ factorizations):
     Tests ZGGQRF and ZGGRQF

 GSV (Generalized Singular Value Decomposition):
     Tests ZGGSVD, ZGGSVP, ZTGSJA, ZLAGS2, ZLAPLL, and ZLAPMT

 CSD (CS decomposition):
     Tests ZUNCSD

 LSE (Constrained Linear Least Squares):
     Tests ZGGLSE

 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

 ZHS or NEP      21     ZCHKHS
 ZST or SEP      21     ZCHKST (routines)
                 18     ZDRVST (drivers)
 ZBD or SVD      16     ZCHKBD (routines)
                  5     ZDRVBD (drivers)
 ZEV             21     ZDRVEV
 ZES             21     ZDRVES
 ZVX             21     ZDRVVX
 ZSX             21     ZDRVSX
 ZGG             26     ZCHKGG (routines)
 ZGS             26     ZDRGES
 ZGX              5     ZDRGSX
 ZGV             26     ZDRGEV
 ZXV              2     ZDRGVX
 ZSG             21     ZDRVSG
 ZHB             15     ZCHKHB
 ZBB             15     ZCHKBB
 ZEC              -     ZCHKEC
 ZBL              -     ZCHKBL
 ZBK              -     ZCHKBK
 ZGL              -     ZCHKGL
 ZGK              -     ZCHKGK
 GLM              8     ZCKGLM
 GQR              8     ZCKGQR
 GSV              8     ZCKGSV
 CSD              3     ZCKCSD
 LSE              8     ZCKLSE

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

 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 'ZHS' for the
          nonsymmetric eigenvalue routines.

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

 SEP or ZSG 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 'ZST' for the
          Hermitian eigenvalue routines and driver routines, and
          'ZSG' 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 'ZBD' for both the
          SVD routines and the SVD driver routines.

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

 ZEV and ZES data files:

 line 1:  'ZEV' or 'ZES' 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 'ZEV' to test CGEEV, or
          'ZES' to test CGEES.

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

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

 line 1:  'ZVX' 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 'ZVX' 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 ZSX data is like ZVX. The first part is identical to ZEV, and the
 second part consists of test matrices with precomputed solutions.

 line 1:  'ZSX' 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 'ZSX' 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.

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

 ZGG 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 'ZGG' for the generalized
          eigenvalue problem routines and driver routines.

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

 ZGS and ZGV input files:

 line 1:  'ZGS' or 'ZGV' 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 'ZGS' for the generalized
          eigenvalue problem routines and driver routines.

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

 ZGX input file:
 line 1:  'ZGX' 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.

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

 ZXV input files:
 line 1:  'ZXV' 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.

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

 ZHB 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 'ZHB'.

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

 ZBB 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 'ZBB'.

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

 ZEC 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.

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

 ZBL and ZBK input files:

 line 1:  'ZBL' in columns 1-3 to test CGEBAL, or 'ZBK' in
          columns 1-3 to test CGEBAK.

 The remaining lines consist of specially constructed test cases.

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

 ZGL and ZGK input files:

 line 1:  'ZGL' in columns 1-3 to test ZGGBAL, or 'ZGK' in
          columns 1-3 to test ZGGBAK.

 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 ZGG.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 1035 of file zchkee.f.

Here is the call graph for this function:

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

ZCHKGG

Purpose:
 ZCHKGG  checks the nonsymmetric generalized eigenvalue problem
 routines.
                                H          H        H
 ZGGHRD 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
 ZHGEQZ 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

 ZTGEVC 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 ZCHKGG 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
       DTGEVC 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
       DTGEVC 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,
          ZCHKGG 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, ZCHKGG
          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 ZCHKGG to continue the same random number
          sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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 DOUBLE PRECISION
          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*16 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*16 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*16 array, dimension (LDA, max(NN))
          The upper Hessenberg matrix computed from A by ZGGHRD.
[out]T
          T is COMPLEX*16 array, dimension (LDA, max(NN))
          The upper triangular matrix computed from B by ZGGHRD.
[out]S1
          S1 is COMPLEX*16 array, dimension (LDA, max(NN))
          The Schur (upper triangular) matrix computed from H by ZHGEQZ
          when Q and Z are also computed.
[out]S2
          S2 is COMPLEX*16 array, dimension (LDA, max(NN))
          The Schur (upper triangular) matrix computed from H by ZHGEQZ
          when Q and Z are not computed.
[out]P1
          P1 is COMPLEX*16 array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by ZHGEQZ
          when Q and Z are also computed.
[out]P2
          P2 is COMPLEX*16 array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by ZHGEQZ
          when Q and Z are not computed.
[out]U
          U is COMPLEX*16 array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by ZGGHRD.
[in]LDU
          LDU is INTEGER
          The leading dimension of U, V, Q, Z, EVECTL, and EVEZTR.  It
          must be at least 1 and at least max( NN ).
[out]V
          V is COMPLEX*16 array, dimension (LDU, max(NN))
          The (right) unitary matrix computed by ZGGHRD.
[out]Q
          Q is COMPLEX*16 array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by ZHGEQZ.
[out]Z
          Z is COMPLEX*16 array, dimension (LDU, max(NN))
          The (left) unitary matrix computed by ZHGEQZ.
[out]ALPHA1
          ALPHA1 is COMPLEX*16 array, dimension (max(NN))
[out]BETA1
          BETA1 is COMPLEX*16 array, dimension (max(NN))
          The generalized eigenvalues of (A,B) computed by ZHGEQZ
          when Q, Z, and the full Schur matrices are computed.
[out]ALPHA3
          ALPHA3 is COMPLEX*16 array, dimension (max(NN))
[out]BETA3
          BETA3 is COMPLEX*16 array, dimension (max(NN))
          The generalized eigenvalues of (A,B) computed by ZHGEQZ
          when neither Q, Z, nor the Schur matrices are computed.
[out]EVECTL
          EVECTL is COMPLEX*16 array, dimension (LDU, max(NN))
          The (lower triangular) left eigenvector matrix for the
          matrices in S1 and P1.
[out]EVECTR
          EVECTR is COMPLEX*16 array, dimension (LDU, max(NN))
          The (upper triangular) right eigenvector matrix for the
          matrices in S1 and P1.
[out]WORK
          WORK is COMPLEX*16 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 DOUBLE PRECISION array, dimension (2*max(NN))
[out]LLWORK
          LLWORK is LOGICAL array, dimension (max(NN))
[out]RESULT
          RESULT is DOUBLE PRECISION 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 zchkgg.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  DOUBLE PRECISION thresh, thrshn
515 * ..
516 * .. Array Arguments ..
517  LOGICAL dotype( * ), llwork( * )
518  INTEGER iseed( 4 ), nn( * )
519  DOUBLE PRECISION result( 15 ), rwork( * )
520  COMPLEX*16 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  DOUBLE PRECISION zero, one
533  parameter( zero = 0.0d+0, one = 1.0d+0 )
534  COMPLEX*16 czero, cone
535  parameter( czero = ( 0.0d+0, 0.0d+0 ),
536  $ cone = ( 1.0d+0, 0.0d+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  DOUBLE PRECISION anorm, bnorm, safmax, safmin, temp1, temp2,
546  $ ulp, ulpinv
547  COMPLEX*16 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  DOUBLE PRECISION dumma( 4 ), rmagn( 0: 3 )
557  COMPLEX*16 cdumma( 4 )
558 * ..
559 * .. External Functions ..
560  DOUBLE PRECISION dlamch, zlange
561  COMPLEX*16 zlarnd
562  EXTERNAL dlamch, zlange, zlarnd
563 * ..
564 * .. External Subroutines ..
565  EXTERNAL dlabad, dlasum, xerbla, zgeqr2, zget51, zget52,
567  $ ztgevc, zunm2r
568 * ..
569 * .. Intrinsic Functions ..
570  INTRINSIC abs, dble, dconjg, max, min, 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( 'ZCHKGG', -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 = dlamch( 'Safe minimum' )
642  ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
643  safmin = safmin / ulp
644  safmax = one / safmin
645  CALL dlabad( 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 / dble( 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 * KZLASS: =1 means w/o rotation, =2 means w/ rotation,
694 * =3 means random.
695 * KATYPE: the "type" to be passed to ZLATM4 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 zlaset( 'Full', n, n, czero, czero, a, lda )
721  ELSE
722  in = n
723  END IF
724  CALL zlatm4( 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 zlaset( 'Full', n, n, czero, czero, b, lda )
739  ELSE
740  in = n
741  END IF
742  CALL zlatm4( 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 ZLARFG 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 ) = zlarnd( 3, iseed )
762  v( jr, jc ) = zlarnd( 3, iseed )
763  40 CONTINUE
764  CALL zlarfg( n+1-jc, u( jc, jc ), u( jc+1, jc ), 1,
765  $ work( jc ) )
766  work( 2*n+jc ) = sign( one, dble( u( jc, jc ) ) )
767  u( jc, jc ) = cone
768  CALL zlarfg( n+1-jc, v( jc, jc ), v( jc+1, jc ), 1,
769  $ work( n+jc ) )
770  work( 3*n+jc ) = sign( one, dble( v( jc, jc ) ) )
771  v( jc, jc ) = cone
772  50 CONTINUE
773  ctemp = zlarnd( 3, iseed )
774  u( n, n ) = cone
775  work( n ) = czero
776  work( 3*n ) = ctemp / abs( ctemp )
777  ctemp = zlarnd( 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  $ dconjg( work( 3*n+jc ) )*
788  $ a( jr, jc )
789  b( jr, jc ) = work( 2*n+jr )*
790  $ dconjg( work( 3*n+jc ) )*
791  $ b( jr, jc )
792  60 CONTINUE
793  70 CONTINUE
794  CALL zunm2r( '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 zunm2r( '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 zunm2r( '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 zunm2r( '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  $ zlarnd( 4, iseed )
819  b( jr, jc ) = rmagn( kbmagn( jtype ) )*
820  $ zlarnd( 4, iseed )
821  80 CONTINUE
822  90 CONTINUE
823  END IF
824 *
825  anorm = zlange( '1', n, n, a, lda, rwork )
826  bnorm = zlange( '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 ZGEQR2, ZUNM2R, and ZGGHRD to compute H, T, U, and V
840 *
841  CALL zlacpy( ' ', n, n, a, lda, h, lda )
842  CALL zlacpy( ' ', n, n, b, lda, t, lda )
843  ntest = 1
844  result( 1 ) = ulpinv
845 *
846  CALL zgeqr2( n, n, t, lda, work, work( n+1 ), iinfo )
847  IF( iinfo.NE.0 ) THEN
848  WRITE( nounit, fmt = 9999 )'ZGEQR2', iinfo, n, jtype,
849  $ ioldsd
850  info = abs( iinfo )
851  GO TO 210
852  END IF
853 *
854  CALL zunm2r( '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 )'ZUNM2R', iinfo, n, jtype,
858  $ ioldsd
859  info = abs( iinfo )
860  GO TO 210
861  END IF
862 *
863  CALL zlaset( 'Full', n, n, czero, cone, u, ldu )
864  CALL zunm2r( '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 )'ZUNM2R', iinfo, n, jtype,
868  $ ioldsd
869  info = abs( iinfo )
870  GO TO 210
871  END IF
872 *
873  CALL zgghrd( '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 )'ZGGHRD', 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 zget51( 1, n, a, lda, h, lda, u, ldu, v, ldu, work,
886  $ rwork, result( 1 ) )
887  CALL zget51( 1, n, b, lda, t, lda, u, ldu, v, ldu, work,
888  $ rwork, result( 2 ) )
889  CALL zget51( 3, n, b, lda, t, lda, u, ldu, u, ldu, work,
890  $ rwork, result( 3 ) )
891  CALL zget51( 3, n, b, lda, t, lda, v, ldu, v, ldu, work,
892  $ rwork, result( 4 ) )
893 *
894 * Call ZHGEQZ to compute S1, P1, S2, P2, Q, and Z, do tests.
895 *
896 * Compute T1 and UZ
897 *
898 * Eigenvalues only
899 *
900  CALL zlacpy( ' ', n, n, h, lda, s2, lda )
901  CALL zlacpy( ' ', n, n, t, lda, p2, lda )
902  ntest = 5
903  result( 5 ) = ulpinv
904 *
905  CALL zhgeqz( '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 )'ZHGEQZ(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 zlacpy( ' ', n, n, h, lda, s2, lda )
918  CALL zlacpy( ' ', n, n, t, lda, p2, lda )
919 *
920  CALL zhgeqz( '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 )'ZHGEQZ(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 zlacpy( ' ', n, n, h, lda, s1, lda )
933  CALL zlacpy( ' ', n, n, t, lda, p1, lda )
934 *
935  CALL zhgeqz( '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 )'ZHGEQZ(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 zget51( 1, n, h, lda, s1, lda, q, ldu, z, ldu, work,
950  $ rwork, result( 5 ) )
951  CALL zget51( 1, n, t, lda, p1, lda, q, ldu, z, ldu, work,
952  $ rwork, result( 6 ) )
953  CALL zget51( 3, n, t, lda, p1, lda, q, ldu, q, ldu, work,
954  $ rwork, result( 7 ) )
955  CALL zget51( 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 ztgevc( '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 )'ZTGEVC(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 ztgevc( '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 )'ZTGEVC(L,S2)', iinfo, n,
999  $ jtype, ioldsd
1000  info = abs( iinfo )
1001  GO TO 210
1002  END IF
1003 *
1004  CALL zget52( .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', 'ZTGEVC(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 zlacpy( 'F', n, n, q, ldu, evectl, ldu )
1018  CALL ztgevc( '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 )'ZTGEVC(L,B)', iinfo, n,
1022  $ jtype, ioldsd
1023  info = abs( iinfo )
1024  GO TO 210
1025  END IF
1026 *
1027  CALL zget52( .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', 'ZTGEVC(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 ztgevc( '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 )'ZTGEVC(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 ztgevc( '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 )'ZTGEVC(R,S2)', iinfo, n,
1074  $ jtype, ioldsd
1075  info = abs( iinfo )
1076  GO TO 210
1077  END IF
1078 *
1079  CALL zget52( .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', 'ZTGEVC(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 zlacpy( 'F', n, n, z, ldu, evectr, ldu )
1093  CALL ztgevc( '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 )'ZTGEVC(R,B)', iinfo, n,
1097  $ jtype, ioldsd
1098  info = abs( iinfo )
1099  GO TO 210
1100  END IF
1101 *
1102  CALL zget52( .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', 'ZTGEVC(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 zget51( 2, n, s1, lda, s2, lda, q, ldu, z, ldu,
1117  $ work, rwork, result( 13 ) )
1118  CALL zget51( 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 )'ZGG'
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.0d0 ) 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 dlasum( 'ZGG', nounit, nerrs, ntestt )
1187  RETURN
1188 *
1189  9999 FORMAT( ' ZCHKGG: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1190  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1191 *
1192  9998 FORMAT( ' ZCHKGG: ', 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 ZCHKGG 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, d10.3 )
1241 *
1242 * End of ZCHKGG
1243 *
subroutine zlatm4(ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
ZLATM4
Definition: zlatm4.f:173
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
Definition: zlarnd.f:77
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zgeqr2(M, N, A, LDA, TAU, WORK, INFO)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
Definition: zgeqr2.f:123
subroutine zunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition: zunm2r.f:161
subroutine zget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
ZGET52
Definition: zget52.f:164
subroutine zgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
ZGGHRD
Definition: zgghrd.f:206
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine ztgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTGEVC
Definition: ztgevc.f:221
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine zget51(ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
ZGET51
Definition: zget51.f:156
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
Definition: zlarfg.f:108
subroutine zhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
ZHGEQZ
Definition: zhgeqz.f:286

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zchkgk ( integer  NIN,
integer  NOUT 
)

ZCHKGK

Purpose:
 ZCHKGK tests ZGGBAK, 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 zchkgk.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  DOUBLE PRECISION zero
75  parameter( zero = 0.0d+0 )
76  COMPLEX*16 czero, cone
77  parameter( czero = ( 0.0d+0, 0.0d+0 ),
78  $ cone = ( 1.0d+0, 0.0d+0 ) )
79 * ..
80 * .. Local Scalars ..
81  INTEGER i, ihi, ilo, info, j, knt, m, n, ninfo
82  DOUBLE PRECISION anorm, bnorm, eps, rmax, vmax
83  COMPLEX*16 cdum
84 * ..
85 * .. Local Arrays ..
86  INTEGER lmax( 4 )
87  DOUBLE PRECISION lscale( lda ), rscale( lda ), rwork( lrwork )
88  COMPLEX*16 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  DOUBLE PRECISION dlamch, zlange
96  EXTERNAL dlamch, zlange
97 * ..
98 * .. External Subroutines ..
99  EXTERNAL zgemm, zggbak, zggbal, zlacpy
100 * ..
101 * .. Intrinsic Functions ..
102  INTRINSIC abs, dble, dimag, max
103 * ..
104 * .. Statement Functions ..
105  DOUBLE PRECISION cabs1
106 * ..
107 * .. Statement Function definitions ..
108  cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( 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 = dlamch( '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 = zlange( 'M', n, n, a, lda, rwork )
146  bnorm = zlange( 'M', n, n, b, ldb, rwork )
147 *
148  CALL zlacpy( 'FULL', n, n, a, lda, af, lda )
149  CALL zlacpy( 'FULL', n, n, b, ldb, bf, ldb )
150 *
151  CALL zggbal( '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 zlacpy( 'FULL', n, m, vl, ldvl, vlf, ldvl )
159  CALL zlacpy( 'FULL', n, m, vr, ldvr, vrf, ldvr )
160 *
161  CALL zggbak( '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 zggbak( '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 ZGGBAK
176 *
177 * Check tilde(VL)'*A*tilde(VR) - VL'*tilde(A)*VR
178 * where tilde(A) denotes the transformed matrix.
179 *
180  CALL zgemm( 'N', 'N', n, m, n, cone, af, lda, vr, ldvr, czero,
181  $ work, ldwork )
182  CALL zgemm( 'C', 'N', m, m, n, cone, vl, ldvl, work, ldwork,
183  $ czero, e, lde )
184 *
185  CALL zgemm( 'N', 'N', n, m, n, cone, a, lda, vrf, ldvr, czero,
186  $ work, ldwork )
187  CALL zgemm( '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 zgemm( 'N', 'N', n, m, n, cone, bf, ldb, vr, ldvr, czero,
205  $ work, ldwork )
206  CALL zgemm( 'C', 'N', m, m, n, cone, vl, ldvl, work, ldwork,
207  $ czero, e, lde )
208 *
209  CALL zgemm( 'n', 'n', n, m, n, cone, b, ldb, vrf, ldvr, czero,
210  $ work, ldwork )
211  CALL zgemm( '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 ZGGBAK .. ' )
232 *
233  WRITE( nout, fmt = 9998 )rmax
234  9998 FORMAT( ' value of largest test error =', d12.3 )
235  WRITE( nout, fmt = 9997 )lmax( 1 )
236  9997 FORMAT( ' example number where ZGGBAL info is not 0 =', i4 )
237  WRITE( nout, fmt = 9996 )lmax( 2 )
238  9996 FORMAT( ' example number where ZGGBAK(L) info is not 0 =', i4 )
239  WRITE( nout, fmt = 9995 )lmax( 3 )
240  9995 FORMAT( ' example number where ZGGBAK(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 ZCHKGK
251 *
subroutine zggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
ZGGBAL
Definition: zggbal.f:179
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
ZGGBAK
Definition: zggbak.f:150
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
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 zchkgl ( integer  NIN,
integer  NOUT 
)

ZCHKGL

Purpose:
 ZCHKGL tests ZGGBAL, 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 zchkgl.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  DOUBLE PRECISION zero
71  parameter( zero = 0.0d+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
75  $ ninfo
76  DOUBLE PRECISION anorm, bnorm, eps, rmax, vmax
77 * ..
78 * .. Local Arrays ..
79  INTEGER lmax( 3 )
80  DOUBLE PRECISION lscale( lda ), lsclin( lda ), rscale( lda ),
81  $ rsclin( lda ), work( lwork )
82  COMPLEX*16 a( lda, lda ), ain( lda, lda ), b( ldb, ldb ),
83  $ bin( ldb, ldb )
84 * ..
85 * .. External Functions ..
86  DOUBLE PRECISION dlamch, zlange
87  EXTERNAL dlamch, zlange
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL zggbal
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 = dlamch( '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 = zlange( 'M', n, n, a, lda, work )
131  bnorm = zlange( 'M', n, n, b, ldb, work )
132 *
133  knt = knt + 1
134 *
135  CALL zggbal( '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 ZGGBAL .. ' )
174 *
175  WRITE( nout, fmt = 9998 )rmax
176  9998 FORMAT( ' ratio of largest test error = ', d12.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 ZCHKGL
191 *
subroutine zggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
ZGGBAL
Definition: zggbal.f:179
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKHB

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

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

 When ZCHKHB 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 ZHBTRD with
                                         UPLO='U'

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

 (3)     | A - V S V* | / ( |A| n ulp )  computed by ZHBTRD 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,
          ZCHKHB 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,
          ZCHKHB 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, ZCHKHB
          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 ZCHKHB to continue the same random number
          sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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*16 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 DOUBLE PRECISION array, dimension (max(NN))
          Used to hold the diagonal of the tridiagonal matrix computed
          by ZHBTRD.
[out]SE
          SE is DOUBLE PRECISION array, dimension (max(NN))
          Used to hold the off-diagonal of the tridiagonal matrix
          computed by ZHBTRD.
[out]U
          U is COMPLEX*16 array, dimension (LDU, max(NN))
          Used to hold the unitary matrix computed by ZHBTRD.
[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*16 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 DOUBLE PRECISION array
[out]RESULT
          RESULT is DOUBLE PRECISION 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 zchkhb.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  DOUBLE PRECISION thresh
310 * ..
311 * .. Array Arguments ..
312  LOGICAL dotype( * )
313  INTEGER iseed( 4 ), kk( * ), nn( * )
314  DOUBLE PRECISION result( * ), rwork( * ), sd( * ), se( * )
315  COMPLEX*16 a( lda, * ), u( ldu, * ), work( * )
316 * ..
317 *
318 * =====================================================================
319 *
320 * .. Parameters ..
321  COMPLEX*16 czero, cone
322  parameter( czero = ( 0.0d+0, 0.0d+0 ),
323  $ cone = ( 1.0d+0, 0.0d+0 ) )
324  DOUBLE PRECISION zero, one, two, ten
325  parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0,
326  $ ten = 10.0d+0 )
327  DOUBLE PRECISION 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  DOUBLE PRECISION 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  DOUBLE PRECISION dlamch
346  EXTERNAL dlamch
347 * ..
348 * .. External Subroutines ..
349  EXTERNAL dlasum, xerbla, zhbt21, zhbtrd, zlacpy, zlaset,
350  $ zlatmr, zlatms
351 * ..
352 * .. Intrinsic Functions ..
353  INTRINSIC abs, dble, dconjg, max, min, 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( 'ZCHKHB', -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 = dlamch( 'Safe minimum' )
421  ovfl = one / unfl
422  ulp = dlamch( 'Epsilon' )*dlamch( '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 / dble( 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 zlaset( '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 zlatms( 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 zlatms( 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 zlatmr( 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 zlatmr( 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 zlatms( 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 zlatms( 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 ZHBTRD to compute S and U from upper triangle.
598 *
599  CALL zlacpy( ' ', k+1, n, a, lda, work, lda )
600 *
601  ntest = 1
602  CALL zhbtrd( '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 )'ZHBTRD(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 zhbt21( '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 ) = dconjg( 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 ZHBTRD to compute S and U from lower triangle
637 *
638  CALL zlacpy( ' ', k+1, n, a, lda, work, lda )
639 *
640  ntest = 3
641  CALL zhbtrd( '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 )'ZHBTRD(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 zhbt21( '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 )'ZHB'
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 dlasum( 'ZHB', nounit, nerrs, ntestt )
696  RETURN
697 *
698  9999 FORMAT( ' ZCHKHB: ', 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 DCHK23 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 ZCHKHB
733 *
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zhbt21(UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RWORK, RESULT)
ZHBT21
Definition: zhbt21.f:152
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zlatmr(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)
ZLATMR
Definition: zlatmr.f:492
subroutine zhbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
ZHBTRD
Definition: zhbtrd.f:165
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKHS

Purpose:
    ZCHKHS  checks the nonsymmetric eigenvalue problem routines.

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

            ZUNGHR generates the unitary matrix U.

            ZUNMHR multiplies a matrix by the unitary matrix U.

            ZHSEQR 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.

            ZTREVC 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.

            ZHSEIN 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 ZCHKHS 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,
           ZCHKHS 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, ZCHKHS
           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 ZCHKHS to continue the same random number
           sequence.
           Modified.

  THRESH - DOUBLE PRECISION
           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*16 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*16 array, dimension (LDA,max(NN))
           The upper hessenberg matrix computed by ZGEHRD.  On exit,
           H contains the Hessenberg form of the matrix in A.
           Modified.

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

  T2     - COMPLEX*16 array, dimension (LDA,max(NN))
           The Schur matrix computed by ZHSEQR 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*16 array, dimension (LDU,max(NN))
           The unitary matrix computed by ZGEHRD.
           Modified.

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

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

  W1     - COMPLEX*16 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*16 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 ZHSEIN.
           Modified.

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

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

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

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

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

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

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

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

  RWORK  - DOUBLE PRECISION 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 - DOUBLE PRECISION 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  ZLATMR, CLATMS, or CLATME returns an error code, the
               absolute value of it is returned.
           If 1, then ZHSEQR 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 DLAFTS).
     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 zchkhs.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  DOUBLE PRECISION thresh
423 * ..
424 * .. Array Arguments ..
425  LOGICAL dotype( * ), select( * )
426  INTEGER iseed( 4 ), iwork( * ), nn( * )
427  DOUBLE PRECISION result( 14 ), rwork( * )
428  COMPLEX*16 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  DOUBLE PRECISION zero, one
440  parameter( zero = 0.0d+0, one = 1.0d+0 )
441  COMPLEX*16 czero, cone
442  parameter( czero = ( 0.0d+0, 0.0d+0 ),
443  $ cone = ( 1.0d+0, 0.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION dumma( 4 )
460  COMPLEX*16 cdumma( 4 )
461 * ..
462 * .. External Functions ..
463  DOUBLE PRECISION dlamch
464  EXTERNAL dlamch
465 * ..
466 * .. External Subroutines ..
467  EXTERNAL dlabad, dlafts, dlasum, xerbla, zcopy, zgehrd,
470  $ zunghr, zunmhr
471 * ..
472 * .. Intrinsic Functions ..
473  INTRINSIC abs, dble, max, min, 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( 'ZCHKHS', -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 = dlamch( 'Safe minimum' )
529  ovfl = dlamch( 'Overflow' )
530  CALL dlabad( unfl, ovfl )
531  ulp = dlamch( 'Epsilon' )*dlamch( '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 / dble( 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 zlaset( '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 zlatmr( 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 zlatms( 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 zlatme( 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 zlatmr( 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 zlatmr( 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 zlatmr( 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 zlatmr( 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 ZGEHRD to compute H and U, do tests.
726 *
727  CALL zlacpy( ' ', n, n, a, lda, h, lda )
728  ntest = 1
729 *
730  ilo = 1
731  ihi = n
732 *
733  CALL zgehrd( 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 )'ZGEHRD', 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 zcopy( n-1, work, 1, tau, 1 )
753  CALL zunghr( n, ilo, ihi, u, ldu, work, work( n+1 ),
754  $ nwork-n, iinfo )
755  ntest = 2
756 *
757  CALL zhst01( n, ilo, ihi, a, lda, h, lda, u, ldu, work,
758  $ nwork, rwork, result( 1 ) )
759 *
760 * Call ZHSEQR to compute T1, T2 and Z, do tests.
761 *
762 * Eigenvalues only (W3)
763 *
764  CALL zlacpy( ' ', n, n, h, lda, t2, lda )
765  ntest = 3
766  result( 3 ) = ulpinv
767 *
768  CALL zhseqr( '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 )'ZHSEQR(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 zlacpy( ' ', n, n, h, lda, t2, lda )
782 *
783  CALL zhseqr( '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 )'ZHSEQR(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 zlacpy( ' ', n, n, h, lda, t1, lda )
795  CALL zlacpy( ' ', n, n, u, ldu, uz, ldu )
796 *
797  CALL zhseqr( '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 )'ZHSEQR(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 zgemm( '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 zhst01( 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 zhst01( 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 zget10( 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 ztrevc( '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 )'ZTREVC(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 zget22( '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', 'ZTREVC',
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 ztrevc( '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 )'ZTREVC(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', 'ZTREVC', n, jtype,
902  $ ioldsd
903 *
904 * Compute the Left eigenvector Matrix:
905 *
906  ntest = 10
907  result( 10 ) = ulpinv
908  CALL ztrevc( '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 )'ZTREVC(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 zget22( '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', 'ZTREVC', 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 ztrevc( '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 )'ZTREVC(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', 'ZTREVC', n, jtype,
955  $ ioldsd
956 *
957 * Call ZHSEIN 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 zhsein( '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 )'ZHSEIN(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 zget22( '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', 'ZHSEIN',
986  $ dumma( 2 ), n, jtype, ioldsd
987  END IF
988  END IF
989 *
990 * Call ZHSEIN 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 zhsein( '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 )'ZHSEIN(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 zget22( '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', 'ZHSEIN',
1019  $ dumma( 4 ), n, jtype, ioldsd
1020  END IF
1021  END IF
1022 *
1023 * Call ZUNMHR for Right eigenvectors of A, do test 13
1024 *
1025  ntest = 13
1026  result( 13 ) = ulpinv
1027 *
1028  CALL zunmhr( '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 )'ZUNMHR(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 zget22( '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 ZUNMHR for Left eigenvectors of A, do test 14
1049 *
1050  ntest = 14
1051  result( 14 ) = ulpinv
1052 *
1053  CALL zunmhr( '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 )'ZUNMHR(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 zget22( '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 dlafts( 'ZHS', n, n, jtype, ntest, result, ioldsd,
1079  $ thresh, nounit, nerrs )
1080 *
1081  250 CONTINUE
1082  260 CONTINUE
1083 *
1084 * Summary
1085 *
1086  CALL dlasum( 'ZHS', nounit, nerrs, ntestt )
1087 *
1088  RETURN
1089 *
1090  9999 FORMAT( ' ZCHKHS: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1091  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1092  9998 FORMAT( ' ZCHKHS: ', 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( ' ZCHKHS: 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 ZCHKHS
1101 *
subroutine zlatme(N, DIST, ISEED, D, MODE, COND, DMAX, RSIGN, UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, A, LDA, WORK, INFO)
ZLATME
Definition: zlatme.f:303
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine zget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
ZGET22
Definition: zget22.f:145
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine zget10(M, N, A, LDA, B, LDB, WORK, RWORK, RESULT)
ZGET10
Definition: zget10.f:101
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
Definition: zgehrd.f:169
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
Definition: ztrevc.f:220
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
Definition: zhseqr.f:301
subroutine zlatmr(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)
ZLATMR
Definition: zlatmr.f:492
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:128
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine zhst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
ZHST01
Definition: zhst01.f:142
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
Definition: dlafts.f:101
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
Definition: zhsein.f:247
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
Definition: dlasum.f:45
subroutine zunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMHR
Definition: zunmhr.f:180
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKST

Purpose:
 ZCHKST  checks the Hermitian eigenvalue problem routines.

    ZHETRD factors A as  U S U* , where * means conjugate transpose,
    S is real symmetric tridiagonal, and U is unitary.
    ZHETRD can use either just the lower or just the upper triangle
    of A; ZCHKST 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.

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

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

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

    ZSTEQR 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.

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

    ZPTEQR 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.

    DSTEBZ 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.

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

    ZSTEDC 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 ZHETRD/ZUNGTR or ZHPTRD/ZUPGTR ('V' option). It may
    also just compute eigenvalues ('N' option).

    ZSTEMR 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).  ZSTEMR
    uses the Relatively Robust Representation whenever possible.

 When ZCHKST 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 ) ZHETRD( UPLO='U', ... )

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

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

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

 (5-8)   Same as 1-4, but for ZHPTRD and ZUPGTR.

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

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

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

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

 (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
         DSTECH)

 For S positive definite,

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

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

 (16)    | D4 - D5 | / ( 100 |D4| ulp )       ZPTEQR('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
                                              DSTEBZ( 'A', 'E', ...)

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

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

 (20)    | S - Y WA1 Y* | / ( |S| n ulp )  DSTEBZ, ZSTEIN

 (21)    | I - Y Y* | / ( n ulp )          DSTEBZ, ZSTEIN

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

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

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

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

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

 Test 27 is disabled at the moment because ZSTEMR 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
                                              ZSTEMR('V', 'A')

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

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

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

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

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

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

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

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

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

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

 (37)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         ZSTEMR('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,
          ZCHKST 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, ZCHKST
          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 ZCHKST to continue the same random number
          sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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*16 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*16 array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix A stored in packed format.
[out]SD
          SD is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The diagonal of the tridiagonal matrix computed by ZHETRD.
          On exit, SD and SE contain the tridiagonal form of the
          matrix in A.
[out]SE
          SE is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The off-diagonal of the tridiagonal matrix computed by
          ZHETRD.  On exit, SD and SE contain the tridiagonal form of
          the matrix in A.
[out]D1
          D1 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by ZSTEQR simlutaneously
          with Z.  On exit, the eigenvalues in D1 correspond with the
          matrix in A.
[out]D2
          D2 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by ZSTEQR if Z is not
          computed.  On exit, the eigenvalues in D2 correspond with
          the matrix in A.
[out]D3
          D3 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by DSTERF.  On exit, the
          eigenvalues in D3 correspond with the matrix in A.
[out]D4
          D4 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by ZPTEQR(V).
          ZPTEQR factors S as  Z4 D4 Z4*
          On exit, the eigenvalues in D4 correspond with the matrix in A.
[out]D5
          D5 is DOUBLE PRECISION 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 DOUBLE PRECISION array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by DSTEBZ.
[out]WA2
          WA2 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by DSTEBZ.
          Choose random values for IL and IU, and ask for the
          IL-th through IU-th eigenvalues.
[out]WA3
          WA3 is DOUBLE PRECISION array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by DSTEBZ.
          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*16 array of
                             dimension( LDU, max(NN) ).
          The unitary matrix computed by ZHETRD + ZUNGTR.
[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*16 array of
                             dimension( LDU, max(NN) ).
          The Housholder vectors computed by ZHETRD 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 ZHETRD, 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 ZUNGTR, set those entries to
          1 before using them, and then restore them later.)
[out]VP
          VP is COMPLEX*16 array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix V stored in packed format.
[out]TAU
          TAU is COMPLEX*16 array of
                             dimension( max(NN) )
          The Householder factors computed by ZHETRD in reducing A
          to tridiagonal form.
[out]Z
          Z is COMPLEX*16 array of
                             dimension( LDU, max(NN) ).
          The unitary matrix of eigenvectors computed by ZSTEQR,
          ZPTEQR, and ZSTEIN.
[out]WORK
          WORK is COMPLEX*16 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 DOUBLE PRECISION array
[in]LRWORK
          LRWORK is INTEGER
          The number of entries in LRWORK (dimension( ??? )
[out]RESULT
          RESULT is DOUBLE PRECISION 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  ZLATMR, CLATMS, ZHETRD, ZUNGTR, ZSTEQR, DSTERF,
              or ZUNMC2 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 zchkst.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  DOUBLE PRECISION thresh
616 * ..
617 * .. Array Arguments ..
618  LOGICAL dotype( * )
619  INTEGER iseed( 4 ), iwork( * ), nn( * )
620  DOUBLE PRECISION d1( * ), d2( * ), d3( * ), d4( * ), d5( * ),
621  $ result( * ), rwork( * ), sd( * ), se( * ),
622  $ wa1( * ), wa2( * ), wa3( * ), wr( * )
623  COMPLEX*16 a( lda, * ), ap( * ), tau( * ), u( ldu, * ),
624  $ v( ldu, * ), vp( * ), work( * ), z( ldu, * )
625 * ..
626 *
627 * =====================================================================
628 *
629 * .. Parameters ..
630  DOUBLE PRECISION zero, one, two, eight, ten, hun
631  parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
632  $ eight = 8.0d0, ten = 10.0d0, hun = 100.0d0 )
633  COMPLEX*16 czero, cone
634  parameter( czero = ( 0.0d+0, 0.0d+0 ),
635  $ cone = ( 1.0d+0, 0.0d+0 ) )
636  DOUBLE PRECISION 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  DOUBLE PRECISION 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  DOUBLE PRECISION dumma( 1 )
661 * ..
662 * .. External Functions ..
663  INTEGER ilaenv
664  DOUBLE PRECISION dlamch, dlarnd, dsxt1
665  EXTERNAL ilaenv, dlamch, dlarnd, dsxt1
666 * ..
667 * .. External Subroutines ..
668  EXTERNAL dcopy, dlabad, dlasum, dstebz, dstech, dsterf,
672  $ zupgtr
673 * ..
674 * .. Intrinsic Functions ..
675  INTRINSIC abs, dble, dconjg, int, log, max, min, 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, 'ZHETRD', '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( 'ZCHKST', -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 = dlamch( 'Safe minimum' )
738  ovfl = one / unfl
739  CALL dlabad( unfl, ovfl )
740  ulp = dlamch( 'Epsilon' )*dlamch( '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( dble( 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 / dble( 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 zlaset( '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 zlatms( 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 zlatms( 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 zlatmr( 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 zlatmr( 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 zlatms( 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 zlatms( 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 ) = dconjg( 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 ZHETRD and ZUNGTR to compute S and U from
923 * upper triangle.
924 *
925  CALL zlacpy( 'U', n, n, a, lda, v, ldu )
926 *
927  ntest = 1
928  CALL zhetrd( 'U', n, v, ldu, sd, se, tau, work, lwork,
929  $ iinfo )
930 *
931  IF( iinfo.NE.0 ) THEN
932  WRITE( nounit, fmt = 9999 )'ZHETRD(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 zlacpy( 'U', n, n, v, ldu, u, ldu )
944 *
945  ntest = 2
946  CALL zungtr( 'U', n, u, ldu, tau, work, lwork, iinfo )
947  IF( iinfo.NE.0 ) THEN
948  WRITE( nounit, fmt = 9999 )'ZUNGTR(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 zhet21( 2, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
962  $ ldu, tau, work, rwork, result( 1 ) )
963  CALL zhet21( 3, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
964  $ ldu, tau, work, rwork, result( 2 ) )
965 *
966 * Call ZHETRD and ZUNGTR to compute S and U from
967 * lower triangle, do tests.
968 *
969  CALL zlacpy( 'L', n, n, a, lda, v, ldu )
970 *
971  ntest = 3
972  CALL zhetrd( 'L', n, v, ldu, sd, se, tau, work, lwork,
973  $ iinfo )
974 *
975  IF( iinfo.NE.0 ) THEN
976  WRITE( nounit, fmt = 9999 )'ZHETRD(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 zlacpy( 'L', n, n, v, ldu, u, ldu )
988 *
989  ntest = 4
990  CALL zungtr( 'L', n, u, ldu, tau, work, lwork, iinfo )
991  IF( iinfo.NE.0 ) THEN
992  WRITE( nounit, fmt = 9999 )'ZUNGTR(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 zhet21( 2, 'Lower', n, 1, a, lda, sd, se, u, ldu, v,
1004  $ ldu, tau, work, rwork, result( 3 ) )
1005  CALL zhet21( 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 ZHPTRD and ZUPGTR to compute S and U from AP
1019 *
1020  CALL zcopy( nap, ap, 1, vp, 1 )
1021 *
1022  ntest = 5
1023  CALL zhptrd( 'U', n, vp, sd, se, tau, iinfo )
1024 *
1025  IF( iinfo.NE.0 ) THEN
1026  WRITE( nounit, fmt = 9999 )'ZHPTRD(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 zupgtr( 'U', n, vp, tau, u, ldu, work, iinfo )
1039  IF( iinfo.NE.0 ) THEN
1040  WRITE( nounit, fmt = 9999 )'ZUPGTR(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 zhpt21( 2, 'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1054  $ work, rwork, result( 5 ) )
1055  CALL zhpt21( 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 ZHPTRD and ZUPGTR to compute S and U from AP
1069 *
1070  CALL zcopy( nap, ap, 1, vp, 1 )
1071 *
1072  ntest = 7
1073  CALL zhptrd( 'L', n, vp, sd, se, tau, iinfo )
1074 *
1075  IF( iinfo.NE.0 ) THEN
1076  WRITE( nounit, fmt = 9999 )'ZHPTRD(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 zupgtr( 'L', n, vp, tau, u, ldu, work, iinfo )
1089  IF( iinfo.NE.0 ) THEN
1090  WRITE( nounit, fmt = 9999 )'ZUPGTR(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 zhpt21( 2, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1102  $ work, rwork, result( 7 ) )
1103  CALL zhpt21( 3, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1104  $ work, rwork, result( 8 ) )
1105 *
1106 * Call ZSTEQR to compute D1, D2, and Z, do tests.
1107 *
1108 * Compute D1 and Z
1109 *
1110  CALL dcopy( n, sd, 1, d1, 1 )
1111  IF( n.GT.0 )
1112  $ CALL dcopy( n-1, se, 1, rwork, 1 )
1113  CALL zlaset( 'Full', n, n, czero, cone, z, ldu )
1114 *
1115  ntest = 9
1116  CALL zsteqr( 'V', n, d1, rwork, z, ldu, rwork( n+1 ),
1117  $ iinfo )
1118  IF( iinfo.NE.0 ) THEN
1119  WRITE( nounit, fmt = 9999 )'ZSTEQR(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 dcopy( n, sd, 1, d2, 1 )
1133  IF( n.GT.0 )
1134  $ CALL dcopy( n-1, se, 1, rwork, 1 )
1135 *
1136  ntest = 11
1137  CALL zsteqr( 'N', n, d2, rwork, work, ldu, rwork( n+1 ),
1138  $ iinfo )
1139  IF( iinfo.NE.0 ) THEN
1140  WRITE( nounit, fmt = 9999 )'ZSTEQR(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 dcopy( n, sd, 1, d3, 1 )
1154  IF( n.GT.0 )
1155  $ CALL dcopy( n-1, se, 1, rwork, 1 )
1156 *
1157  ntest = 12
1158  CALL dsterf( n, d3, rwork, iinfo )
1159  IF( iinfo.NE.0 ) THEN
1160  WRITE( nounit, fmt = 9999 )'DSTERF', 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 zstt21( 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 dstech( 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 ZPTEQR
1210 * and do tests 14, 15, and 16 .
1211 *
1212  IF( jtype.GT.15 ) THEN
1213 *
1214 * Compute D4 and Z4
1215 *
1216  CALL dcopy( n, sd, 1, d4, 1 )
1217  IF( n.GT.0 )
1218  $ CALL dcopy( n-1, se, 1, rwork, 1 )
1219  CALL zlaset( 'Full', n, n, czero, cone, z, ldu )
1220 *
1221  ntest = 14
1222  CALL zpteqr( 'V', n, d4, rwork, z, ldu, rwork( n+1 ),
1223  $ iinfo )
1224  IF( iinfo.NE.0 ) THEN
1225  WRITE( nounit, fmt = 9999 )'ZPTEQR(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 zstt21( n, 0, sd, se, d4, dumma, z, ldu, work,
1239  $ rwork, result( 14 ) )
1240 *
1241 * Compute D5
1242 *
1243  CALL dcopy( n, sd, 1, d5, 1 )
1244  IF( n.GT.0 )
1245  $ CALL dcopy( n-1, se, 1, rwork, 1 )
1246 *
1247  ntest = 16
1248  CALL zpteqr( 'N', n, d5, rwork, z, ldu, rwork( n+1 ),
1249  $ iinfo )
1250  IF( iinfo.NE.0 ) THEN
1251  WRITE( nounit, fmt = 9999 )'ZPTEQR(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 DSTEBZ with different options and do tests 17-18.
1280 *
1281 * If S is positive definite and diagonally dominant,
1282 * ask for all eigenvalues with high relative accuracy.
1283 *
1284  vl = zero
1285  vu = zero
1286  il = 0
1287  iu = 0
1288  IF( jtype.EQ.21 ) THEN
1289  ntest = 17
1290  abstol = unfl + unfl
1291  CALL dstebz( 'A', 'E', n, vl, vu, il, iu, abstol, sd, se,
1292  $ m, nsplit, wr, iwork( 1 ), iwork( n+1 ),
1293  $ rwork, iwork( 2*n+1 ), iinfo )
1294  IF( iinfo.NE.0 ) THEN
1295  WRITE( nounit, fmt = 9999 )'DSTEBZ(A,rel)', iinfo, n,
1296  $ jtype, ioldsd
1297  info = abs( iinfo )
1298  IF( iinfo.LT.0 ) THEN
1299  RETURN
1300  ELSE