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

Functions

subroutine sbdt01 (M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
 SBDT01 More...
 
subroutine sbdt02 (M, N, B, LDB, C, LDC, U, LDU, WORK, RESID)
 SBDT02 More...
 
subroutine sbdt03 (UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
 SBDT03 More...
 
subroutine schkbb (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, RESULT, INFO)
 SCHKBB More...
 
subroutine schkbd (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, IWORK, NOUT, INFO)
 SCHKBD More...
 
subroutine schkbk (NIN, NOUT)
 SCHKBK More...
 
subroutine schkbl (NIN, NOUT)
 SCHKBL More...
 
subroutine schkec (THRESH, TSTERR, NIN, NOUT)
 SCHKEC More...
 
program schkee
 SCHKEE More...
 
subroutine schkgg (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, TSTDIF, THRSHN, NOUNIT, A, LDA, B, H, T, S1, S2, P1, P2, U, LDU, V, Q, Z, ALPHR1, ALPHI1, BETA1, ALPHR3, ALPHI3, BETA3, EVECTL, EVECTR, WORK, LWORK, LLWORK, RESULT, INFO)
 SCHKGG More...
 
subroutine schkgk (NIN, NOUT)
 SCHKGK More...
 
subroutine schkgl (NIN, NOUT)
 SCHKGL More...
 
subroutine schkhs (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, WR1, WI1, WR2, WI2, WR3, WI3, EVECTL, EVECTR, EVECTY, EVECTX, UU, TAU, WORK, NWORK, IWORK, SELECT, RESULT, INFO)
 SCHKHS More...
 
subroutine schksb (NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK, LWORK, RESULT, INFO)
 SCHKSB More...
 
subroutine schkst (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, IWORK, LIWORK, RESULT, INFO)
 SCHKST More...
 
subroutine sckcsd (NM, MVAL, PVAL, QVAL, NMATS, ISEED, THRESH, MMAX, X, XF, U1, U2, V1T, V2T, THETA, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 SCKCSD More...
 
subroutine sckglm (NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 SCKGLM More...
 
subroutine sckgqr (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)
 SCKGQR More...
 
subroutine sckgsv (NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, IWORK, WORK, RWORK, NIN, NOUT, INFO)
 SCKGSV More...
 
subroutine scklse (NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, INFO)
 SCKLSE More...
 
subroutine scsdts (M, P, Q, X, XF, LDX, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, THETA, IWORK, WORK, LWORK, RWORK, RESULT)
 SCSDTS More...
 
subroutine sdrges (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHAR, ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, INFO)
 SDRGES More...
 
subroutine sdrges3 (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHAR, ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, INFO)
 SDRGES3 More...
 
subroutine sdrgev (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, QE, LDQE, ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, WORK, LWORK, RESULT, INFO)
 SDRGEV More...
 
subroutine sdrgev3 (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, QE, LDQE, ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, WORK, LWORK, RESULT, INFO)
 SDRGEV3 More...
 
subroutine sdrgsx (NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, BI, Z, Q, ALPHAR, ALPHAI, BETA, C, LDC, S, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
 SDRGSX More...
 
subroutine sdrgvx (NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI, ALPHAR, ALPHAI, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE, S, STRU, DIF, DIFTRU, WORK, LWORK, IWORK, LIWORK, RESULT, BWORK, INFO)
 SDRGVX More...
 
subroutine sdrvbd (NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, SSAV, E, WORK, LWORK, IWORK, NOUT, INFO)
 SDRVBD More...
 
subroutine sdrves (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, HT, WR, WI, WRT, WIT, VS, LDVS, RESULT, WORK, NWORK, IWORK, BWORK, INFO)
 SDRVES More...
 
subroutine sdrvev (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, WR, WI, WR1, WI1, VL, LDVL, VR, LDVR, LRE, LDLRE, RESULT, WORK, NWORK, IWORK, INFO)
 SDRVEV More...
 
subroutine sdrvsg (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP, BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO)
 SDRVSG More...
 
subroutine sdrvst (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1, WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK, IWORK, LIWORK, RESULT, INFO)
 SDRVST More...
 
subroutine sdrvsx (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NIUNIT, NOUNIT, A, LDA, H, HT, WR, WI, WRT, WIT, WRTMP, WITMP, VS, LDVS, VS1, RESULT, WORK, LWORK, IWORK, BWORK, INFO)
 SDRVSX More...
 
subroutine sdrvvx (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NIUNIT, NOUNIT, A, LDA, H, WR, WI, WR1, WI1, VL, LDVL, VR, LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, WORK, NWORK, IWORK, INFO)
 SDRVVX More...
 
subroutine serrbd (PATH, NUNIT)
 SERRBD More...
 
subroutine serrec (PATH, NUNIT)
 SERREC More...
 
subroutine serred (PATH, NUNIT)
 SERRED More...
 
subroutine serrgg (PATH, NUNIT)
 SERRGG More...
 
subroutine serrhs (PATH, NUNIT)
 SERRHS More...
 
subroutine serrst (PATH, NUNIT)
 SERRST More...
 
subroutine sget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 SGET02 More...
 
subroutine sget10 (M, N, A, LDA, B, LDB, WORK, RESULT)
 SGET10 More...
 
subroutine sget22 (TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, WR, WI, WORK, RESULT)
 SGET22 More...
 
subroutine sget23 (COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, A, LDA, H, WR, WI, WR1, WI1, VL, LDVL, VR, LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, WORK, LWORK, IWORK, INFO)
 SGET23 More...
 
subroutine sget24 (COMP, JTYPE, THRESH, ISEED, NOUNIT, N, A, LDA, H, HT, WR, WI, WRT, WIT, WRTMP, WITMP, VS, LDVS, VS1, RCDEIN, RCDVIN, NSLCT, ISLCT, RESULT, WORK, LWORK, IWORK, BWORK, INFO)
 SGET24 More...
 
subroutine sget31 (RMAX, LMAX, NINFO, KNT)
 SGET31 More...
 
subroutine sget32 (RMAX, LMAX, NINFO, KNT)
 SGET32 More...
 
subroutine sget33 (RMAX, LMAX, NINFO, KNT)
 SGET33 More...
 
subroutine sget34 (RMAX, LMAX, NINFO, KNT)
 SGET34 More...
 
subroutine sget35 (RMAX, LMAX, NINFO, KNT)
 SGET35 More...
 
subroutine sget36 (RMAX, LMAX, NINFO, KNT, NIN)
 SGET36 More...
 
subroutine sget37 (RMAX, LMAX, NINFO, KNT, NIN)
 SGET37 More...
 
subroutine sget38 (RMAX, LMAX, NINFO, KNT, NIN)
 SGET38 More...
 
subroutine sget39 (RMAX, LMAX, NINFO, KNT)
 SGET39 More...
 
subroutine sget51 (ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RESULT)
 SGET51 More...
 
subroutine sget52 (LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, ALPHAI, BETA, WORK, RESULT)
 SGET52 More...
 
subroutine sget53 (A, LDA, B, LDB, SCALE, WR, WI, RESULT, INFO)
 SGET53 More...
 
subroutine sget54 (N, A, LDA, B, LDB, S, LDS, T, LDT, U, LDU, V, LDV, WORK, RESULT)
 SGET54 More...
 
subroutine sglmts (N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
 SGLMTS More...
 
subroutine sgqrts (N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 SGQRTS More...
 
subroutine sgrqts (M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
 SGRQTS More...
 
subroutine sgsvts3 (M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V, LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK, LWORK, RWORK, RESULT)
 SGSVTS3 More...
 
subroutine shst01 (N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RESULT)
 SHST01 More...
 
subroutine slafts (TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
 SLAFTS More...
 
subroutine slahd2 (IOUNIT, PATH)
 SLAHD2 More...
 
subroutine slarfy (UPLO, N, V, INCV, TAU, C, LDC, WORK)
 SLARFY More...
 
subroutine slarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 SLARHS More...
 
subroutine slatb9 (PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
 SLATB9 More...
 
subroutine slatm4 (ITYPE, N, NZ1, NZ2, ISIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
 SLATM4 More...
 
logical function slctes (ZR, ZI, D)
 SLCTES More...
 
logical function slctsx (AR, AI, BETA)
 SLCTSX More...
 
subroutine slsets (M, P, N, A, AF, LDA, B, BF, LDB, C, CF, D, DF, X, WORK, LWORK, RWORK, RESULT)
 SLSETS More...
 
subroutine sort01 (ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
 SORT01 More...
 
subroutine sort03 (RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
 SORT03 More...
 
subroutine ssbt21 (UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RESULT)
 SSBT21 More...
 
subroutine ssgt01 (ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
 SSGT01 More...
 
logical function sslect (ZR, ZI)
 SSLECT More...
 
subroutine sspt21 (ITYPE, UPLO, N, KBAND, AP, D, E, U, LDU, VP, TAU, WORK, RESULT)
 SSPT21 More...
 
subroutine sstech (N, A, B, EIG, TOL, WORK, INFO)
 SSTECH More...
 
subroutine sstect (N, A, B, SHIFT, NUM)
 SSTECT More...
 
subroutine sstt21 (N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
 SSTT21 More...
 
subroutine sstt22 (N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
 SSTT22 More...
 
subroutine ssvdch (N, S, E, SVD, TOL, INFO)
 SSVDCH More...
 
subroutine ssvdct (N, S, E, SHIFT, NUM)
 SSVDCT More...
 
real function ssxt1 (IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
 SSXT1 More...
 
subroutine ssyt21 (ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
 SSYT21 More...
 
subroutine ssyt22 (ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
 SSYT22 More...
 

Detailed Description

This is the group of real LAPACK TESTING EIG routines.

Function Documentation

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

SBDT01

Purpose:
 SBDT01 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 orthogonal
 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 REAL 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 REAL array, dimension (LDQ,N)
          The m by min(m,n) orthogonal matrix Q in the reduction
          A = Q * B * P'.
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.  LDQ >= max(1,M).
[in]D
          D is REAL array, dimension (min(M,N))
          The diagonal elements of the bidiagonal matrix B.
[in]E
          E is REAL array, dimension (min(M,N)-1)
          The superdiagonal elements of the bidiagonal matrix B if
          m >= n, or the subdiagonal elements of B if m < n.
[in]PT
          PT is REAL array, dimension (LDPT,N)
          The min(m,n) by n orthogonal 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 REAL array, dimension (M+N)
[out]RESID
          RESID is REAL
          The test ratio:  norm(A - Q * B * P') / ( n * norm(A) * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 142 of file sbdt01.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

SBDT02

Purpose:
 SBDT02 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (M)
[out]RESID
          RESID is REAL
          RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 113 of file sbdt02.f.

113 *
114 * -- LAPACK test routine (version 3.4.0) --
115 * -- LAPACK is a software package provided by Univ. of Tennessee, --
116 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
117 * November 2011
118 *
119 * .. Scalar Arguments ..
120  INTEGER ldb, ldc, ldu, m, n
121  REAL resid
122 * ..
123 * .. Array Arguments ..
124  REAL b( ldb, * ), c( ldc, * ), u( ldu, * ),
125  $ work( * )
126 * ..
127 *
128 * ======================================================================
129 *
130 * .. Parameters ..
131  REAL zero, one
132  parameter( zero = 0.0e+0, one = 1.0e+0 )
133 * ..
134 * .. Local Scalars ..
135  INTEGER j
136  REAL bnorm, eps, realmn
137 * ..
138 * .. External Functions ..
139  REAL sasum, slamch, slange
140  EXTERNAL sasum, slamch, slange
141 * ..
142 * .. External Subroutines ..
143  EXTERNAL scopy, sgemv
144 * ..
145 * .. Intrinsic Functions ..
146  INTRINSIC max, min, real
147 * ..
148 * .. Executable Statements ..
149 *
150 * Quick return if possible
151 *
152  resid = zero
153  IF( m.LE.0 .OR. n.LE.0 )
154  $ RETURN
155  realmn = REAL( MAX( M, N ) )
156  eps = slamch( 'Precision' )
157 *
158 * Compute norm( B - U * C )
159 *
160  DO 10 j = 1, n
161  CALL scopy( m, b( 1, j ), 1, work, 1 )
162  CALL sgemv( 'No transpose', m, m, -one, u, ldu, c( 1, j ), 1,
163  $ one, work, 1 )
164  resid = max( resid, sasum( m, work, 1 ) )
165  10 CONTINUE
166 *
167 * Compute norm of B.
168 *
169  bnorm = slange( '1', m, n, b, ldb, work )
170 *
171  IF( bnorm.LE.zero ) THEN
172  IF( resid.NE.zero )
173  $ resid = one / eps
174  ELSE
175  IF( bnorm.GE.resid ) THEN
176  resid = ( resid / bnorm ) / ( realmn*eps )
177  ELSE
178  IF( bnorm.LT.one ) THEN
179  resid = ( min( resid, realmn*bnorm ) / bnorm ) /
180  $ ( realmn*eps )
181  ELSE
182  resid = min( resid / bnorm, realmn ) / ( realmn*eps )
183  END IF
184  END IF
185  END IF
186  RETURN
187 *
188 * End of SBDT02
189 *
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:158
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:54
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116

Here is the call graph for this function:

Here is the caller graph for this function:

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

SBDT03

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

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

Definition at line 137 of file sbdt03.f.

137 *
138 * -- LAPACK test routine (version 3.4.0) --
139 * -- LAPACK is a software package provided by Univ. of Tennessee, --
140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141 * November 2011
142 *
143 * .. Scalar Arguments ..
144  CHARACTER uplo
145  INTEGER kd, ldu, ldvt, n
146  REAL resid
147 * ..
148 * .. Array Arguments ..
149  REAL d( * ), e( * ), s( * ), u( ldu, * ),
150  $ vt( ldvt, * ), work( * )
151 * ..
152 *
153 * ======================================================================
154 *
155 * .. Parameters ..
156  REAL zero, one
157  parameter( zero = 0.0e+0, one = 1.0e+0 )
158 * ..
159 * .. Local Scalars ..
160  INTEGER i, j
161  REAL bnorm, eps
162 * ..
163 * .. External Functions ..
164  LOGICAL lsame
165  INTEGER isamax
166  REAL sasum, slamch
167  EXTERNAL lsame, isamax, sasum, slamch
168 * ..
169 * .. External Subroutines ..
170  EXTERNAL sgemv
171 * ..
172 * .. Intrinsic Functions ..
173  INTRINSIC abs, max, min, real
174 * ..
175 * .. Executable Statements ..
176 *
177 * Quick return if possible
178 *
179  resid = zero
180  IF( n.LE.0 )
181  $ RETURN
182 *
183 * Compute B - U * S * V' one column at a time.
184 *
185  bnorm = zero
186  IF( kd.GE.1 ) THEN
187 *
188 * B is bidiagonal.
189 *
190  IF( lsame( uplo, 'U' ) ) THEN
191 *
192 * B is upper bidiagonal.
193 *
194  DO 20 j = 1, n
195  DO 10 i = 1, n
196  work( n+i ) = s( i )*vt( i, j )
197  10 CONTINUE
198  CALL sgemv( 'No transpose', n, n, -one, u, ldu,
199  $ work( n+1 ), 1, 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, sasum( 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 sgemv( 'No transpose', n, n, -one, u, ldu,
218  $ work( n+1 ), 1, 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, sasum( 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 sgemv( 'No transpose', n, n, -one, u, ldu, work( n+1 ),
238  $ 1, zero, work, 1 )
239  work( j ) = work( j ) + d( j )
240  resid = max( resid, sasum( n, work, 1 ) )
241  60 CONTINUE
242  j = isamax( n, d, 1 )
243  bnorm = abs( d( j ) )
244  END IF
245 *
246 * Compute norm(B - U * S * V') / ( n * norm(B) * EPS )
247 *
248  eps = slamch( 'Precision' )
249 *
250  IF( bnorm.LE.zero ) THEN
251  IF( resid.NE.zero )
252  $ resid = one / eps
253  ELSE
254  IF( bnorm.GE.resid ) THEN
255  resid = ( resid / bnorm ) / ( REAL( n )*eps )
256  ELSE
257  IF( bnorm.LT.one ) THEN
258  resid = ( min( resid, REAL( n )*bnorm ) / bnorm ) /
259  $ ( REAL( n )*eps )
260  ELSE
261  resid = min( resid / bnorm, REAL( N ) ) /
262  $ ( REAL( n )*eps )
263  END IF
264  END IF
265  END IF
266 *
267  RETURN
268 *
269 * End of SBDT03
270 *
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:158
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:54
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

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

SCHKBB

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

 SGBBRD factors a general band matrix A as  Q B P* , where * means
 transpose, B is upper bidiagonal, and Q and P are orthogonal;
 SGBBRD 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, SCHKBB 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,
          SCHKBB 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, SCHKBB
          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 SCHKBB to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL array, dimension
                            (LDA, max(NN))
          Used to hold the matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at least 1
          and at least max( NN ).
[out]AB
          AB is REAL array, dimension (LDAB, max(NN))
          Used to hold A in band storage format.
[in]LDAB
          LDAB is INTEGER
          The leading dimension of AB.  It must be at least 2 (not 1!)
          and at least max( KK )+1.
[out]BD
          BD is REAL array, dimension (max(NN))
          Used to hold the diagonal of the bidiagonal matrix computed
          by SGBBRD.
[out]BE
          BE is REAL array, dimension (max(NN))
          Used to hold the off-diagonal of the bidiagonal matrix
          computed by SGBBRD.
[out]Q
          Q is REAL array, dimension (LDQ, max(NN))
          Used to hold the orthogonal matrix Q computed by SGBBRD.
[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 REAL array, dimension (LDP, max(NN))
          Used to hold the orthogonal matrix P computed by SGBBRD.
[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 REAL array, dimension (LDC, max(NN))
          Used to hold the matrix C updated by SGBBRD.
[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 REAL array, dimension (LDC, max(NN))
          Used to hold a copy of the matrix C.
[out]WORK
          WORK is REAL 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]RESULT
          RESULT is REAL array, dimension (4)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.

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

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

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

Definition at line 357 of file schkbb.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

SCHKBD

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

 SGEBRD reduces a real general m by n matrix A to upper or lower
 bidiagonal form B 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.

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

 SBDSQR 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, SBDSQR has an option to apply the left orthogonal matrix
 U to a matrix X, useful in least squares applications.

 SBDSDC computes the singular value decomposition of the bidiagonal
 matrix B as B = U S V' using divide-and-conquer. It is called twice
 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.

  SBDSVDX computes the singular value decomposition of the bidiagonal
  matrix B as B = U S V' using bisection and inverse iteration. It is 
  called six times to compute
     1) B = U S1 V', RANGE='A', 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) B = U S1 V', RANGE='I', with 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
     4) Same as 3), but the singular values are stored in S2 and the
         singular vectors are not computed.
     5) B = U S1 V', RANGE='V', with 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
     6) Same as 5), but the singular values are stored in S2 and the
         singular vectors are not computed.

 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 SGEBRD and SORGBR

 (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 SBDSQR 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)   | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                   computing U and V.

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

 Test SBDSQR 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 )

 Test SBDSDC on bidiagonal matrix B

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

 (16)  | I - U' U | / ( min(M,N) ulp )

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

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

 (19)  | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                   computing U and V.
  Test SBDSVDX on bidiagonal matrix B
 
  (20)  | B - U S1 VT | / ( |B| min(M,N) ulp ), VT = V'
 
  (21)  | I - U' U | / ( min(M,N) ulp )
 
  (22)  | I - VT VT' | / ( min(M,N) ulp )
 
  (23)  S1 contains min(M,N) nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)
 
  (24)  | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                    computing U and V.
 
  (25)  | S1 - U' B VT' | / ( |S| n ulp )    SBDSVDX('V', 'I')
 
  (26)  | I - U' U | / ( min(M,N) ulp )
 
  (27)  | I - VT VT' | / ( min(M,N) ulp )

  (28)  S1 contains min(M,N) nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)
 
  (29)  | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                    computing U and V.
 
  (30)  | S1 - U' B VT' | / ( |S1| n ulp )   SBDSVDX('V', 'V')
 
  (31)  | I - U' U | / ( min(M,N) ulp )
 
  (32)  | I - VT VT' | / ( min(M,N) ulp )

  (33)  S1 contains min(M,N) nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)
 
  (34)  | S1 - S2 | / ( |S1| ulp ), where S2 is computed without
                                    computing U and V.
 
 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) SGEBRD 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, SCHKBD
          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 SBDSQR.  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 SCHKBD to continue the same random
          number sequence.
[in]THRESH
          THRESH is REAL
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.  Note that the
          expected value of the test ratios is O(1), so THRESH should
          be a reasonably small multiple of 1, e.g., 10 or 100.
[out]A
          A is REAL array, dimension (LDA,NMAX)
          where NMAX is the maximum value of N in NVAL.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,MMAX),
          where MMAX is the maximum value of M in MVAL.
[out]BD
          BD is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]BE
          BE is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S1
          S1 is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]S2
          S2 is REAL array, dimension
                      (max(min(MVAL(j),NVAL(j))))
[out]X
          X is REAL 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 REAL array, dimension (LDX,NRHS)
[out]Z
          Z is REAL array, dimension (LDX,NRHS)
[out]Q
          Q is REAL array, dimension (LDQ,MMAX)
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.  LDQ >= max(1,MMAX).
[out]PT
          PT is REAL 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 REAL array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]VT
          VT is REAL array, dimension
                      (LDPT,max(min(MVAL(j),NVAL(j))))
[out]WORK
          WORK is REAL 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]IWORK
          IWORK is INTEGER array, dimension at least 8*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: LDPT< 1 or LDPT< MNMAX.
          -27: LWORK too small.
          If  SLATMR, SLATMS, SGEBRD, SORGBR, or SBDSQR,
              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 2015

Definition at line 495 of file schkbd.f.

495 *
496 * -- LAPACK test routine (version 3.6.0) --
497 * -- LAPACK is a software package provided by Univ. of Tennessee, --
498 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
499 * November 2015
500 *
501 * .. Scalar Arguments ..
502  INTEGER info, lda, ldpt, ldq, ldx, lwork, nout, nrhs,
503  $ nsizes, ntypes
504  REAL thresh
505 * ..
506 * .. Array Arguments ..
507  LOGICAL dotype( * )
508  INTEGER iseed( 4 ), iwork( * ), mval( * ), nval( * )
509  REAL a( lda, * ), bd( * ), be( * ), pt( ldpt, * ),
510  $ q( ldq, * ), s1( * ), s2( * ), u( ldpt, * ),
511  $ vt( ldpt, * ), work( * ), x( ldx, * ),
512  $ y( ldx, * ), z( ldx, * )
513 * ..
514 *
515 * ======================================================================
516 *
517 * .. Parameters ..
518  REAL zero, one, two, half
519  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
520  $ half = 0.5e0 )
521  INTEGER maxtyp
522  parameter( maxtyp = 16 )
523 * ..
524 * .. Local Scalars ..
525  LOGICAL badmm, badnn, bidiag
526  CHARACTER uplo
527  CHARACTER*3 path
528  INTEGER i, iinfo, il, imode, itemp, itype, iu, iwbd,
529  $ iwbe, iwbs, iwbz, iwwork, j, jcol, jsize,
530  $ jtype, log2ui, m, minwrk, mmax, mnmax, mnmin,
531  $ mnmin2, mq, mtypes, n, nfail, nmax,
532  $ ns1, ns2, ntest
533  REAL abstol, amninv, anorm, cond, ovfl, rtovfl,
534  $ rtunfl, temp1, temp2, temp3, ulp, ulpinv,
535  $ unfl, vl, vu
536 * ..
537 * .. Local Arrays ..
538  INTEGER idum( 1 ), ioldsd( 4 ), iseed2( 4 ),
539  $ kmagn( maxtyp ), kmode( maxtyp ),
540  $ ktype( maxtyp )
541  REAL dum( 1 ), dumma( 1 ), result( 40 )
542 * ..
543 * .. External Functions ..
544  REAL slamch, slarnd, ssxt1
545  EXTERNAL slamch, slarnd, ssxt1
546 * ..
547 * .. External Subroutines ..
548  EXTERNAL alasum, sbdsdc, sbdsqr, sbdsvdx, sbdt01, sbdt02,
551  $ sorgbr, sort01, xerbla
552 * ..
553 * .. Intrinsic Functions ..
554  INTRINSIC abs, exp, int, log, max, min, sqrt
555 * ..
556 * .. Scalars in Common ..
557  LOGICAL lerr, ok
558  CHARACTER*32 srnamt
559  INTEGER infot, nunit
560 * ..
561 * .. Common blocks ..
562  COMMON / infoc / infot, nunit, ok, lerr
563  COMMON / srnamc / srnamt
564 * ..
565 * .. Data statements ..
566  DATA ktype / 1, 2, 5*4, 5*6, 3*9, 10 /
567  DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 /
568  DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
569  $ 0, 0, 0 /
570 * ..
571 * .. Executable Statements ..
572 *
573 * Check for errors
574 *
575  info = 0
576 *
577  badmm = .false.
578  badnn = .false.
579  mmax = 1
580  nmax = 1
581  mnmax = 1
582  minwrk = 1
583  DO 10 j = 1, nsizes
584  mmax = max( mmax, mval( j ) )
585  IF( mval( j ).LT.0 )
586  $ badmm = .true.
587  nmax = max( nmax, nval( j ) )
588  IF( nval( j ).LT.0 )
589  $ badnn = .true.
590  mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
591  minwrk = max( minwrk, 3*( mval( j )+nval( j ) ),
592  $ mval( j )*( mval( j )+max( mval( j ), nval( j ),
593  $ nrhs )+1 )+nval( j )*min( nval( j ), mval( j ) ) )
594  10 CONTINUE
595 *
596 * Check for errors
597 *
598  IF( nsizes.LT.0 ) THEN
599  info = -1
600  ELSE IF( badmm ) THEN
601  info = -2
602  ELSE IF( badnn ) THEN
603  info = -3
604  ELSE IF( ntypes.LT.0 ) THEN
605  info = -4
606  ELSE IF( nrhs.LT.0 ) THEN
607  info = -6
608  ELSE IF( lda.LT.mmax ) THEN
609  info = -11
610  ELSE IF( ldx.LT.mmax ) THEN
611  info = -17
612  ELSE IF( ldq.LT.mmax ) THEN
613  info = -21
614  ELSE IF( ldpt.LT.mnmax ) THEN
615  info = -23
616  ELSE IF( minwrk.GT.lwork ) THEN
617  info = -27
618  END IF
619 *
620  IF( info.NE.0 ) THEN
621  CALL xerbla( 'SCHKBD', -info )
622  RETURN
623  END IF
624 *
625 * Initialize constants
626 *
627  path( 1: 1 ) = 'Single precision'
628  path( 2: 3 ) = 'BD'
629  nfail = 0
630  ntest = 0
631  unfl = slamch( 'Safe minimum' )
632  ovfl = slamch( 'Overflow' )
633  CALL slabad( unfl, ovfl )
634  ulp = slamch( 'Precision' )
635  ulpinv = one / ulp
636  log2ui = int( log( ulpinv ) / log( two ) )
637  rtunfl = sqrt( unfl )
638  rtovfl = sqrt( ovfl )
639  infot = 0
640  abstol = 2*unfl
641 *
642 * Loop over sizes, types
643 *
644  DO 300 jsize = 1, nsizes
645  m = mval( jsize )
646  n = nval( jsize )
647  mnmin = min( m, n )
648  amninv = one / max( m, n, 1 )
649 *
650  IF( nsizes.NE.1 ) THEN
651  mtypes = min( maxtyp, ntypes )
652  ELSE
653  mtypes = min( maxtyp+1, ntypes )
654  END IF
655 *
656  DO 290 jtype = 1, mtypes
657  IF( .NOT.dotype( jtype ) )
658  $ GO TO 290
659 *
660  DO 20 j = 1, 4
661  ioldsd( j ) = iseed( j )
662  20 CONTINUE
663 *
664  DO 30 j = 1, 34
665  result( j ) = -one
666  30 CONTINUE
667 *
668  uplo = ' '
669 *
670 * Compute "A"
671 *
672 * Control parameters:
673 *
674 * KMAGN KMODE KTYPE
675 * =1 O(1) clustered 1 zero
676 * =2 large clustered 2 identity
677 * =3 small exponential (none)
678 * =4 arithmetic diagonal, (w/ eigenvalues)
679 * =5 random symmetric, w/ eigenvalues
680 * =6 nonsymmetric, w/ singular values
681 * =7 random diagonal
682 * =8 random symmetric
683 * =9 random nonsymmetric
684 * =10 random bidiagonal (log. distrib.)
685 *
686  IF( mtypes.GT.maxtyp )
687  $ GO TO 100
688 *
689  itype = ktype( jtype )
690  imode = kmode( jtype )
691 *
692 * Compute norm
693 *
694  GO TO ( 40, 50, 60 )kmagn( jtype )
695 *
696  40 CONTINUE
697  anorm = one
698  GO TO 70
699 *
700  50 CONTINUE
701  anorm = ( rtovfl*ulp )*amninv
702  GO TO 70
703 *
704  60 CONTINUE
705  anorm = rtunfl*max( m, n )*ulpinv
706  GO TO 70
707 *
708  70 CONTINUE
709 *
710  CALL slaset( 'Full', lda, n, zero, zero, a, lda )
711  iinfo = 0
712  cond = ulpinv
713 *
714  bidiag = .false.
715  IF( itype.EQ.1 ) THEN
716 *
717 * Zero matrix
718 *
719  iinfo = 0
720 *
721  ELSE IF( itype.EQ.2 ) THEN
722 *
723 * Identity
724 *
725  DO 80 jcol = 1, mnmin
726  a( jcol, jcol ) = anorm
727  80 CONTINUE
728 *
729  ELSE IF( itype.EQ.4 ) THEN
730 *
731 * Diagonal Matrix, [Eigen]values Specified
732 *
733  CALL slatms( mnmin, mnmin, 'S', iseed, 'N', work, imode,
734  $ cond, anorm, 0, 0, 'N', a, lda,
735  $ work( mnmin+1 ), iinfo )
736 *
737  ELSE IF( itype.EQ.5 ) THEN
738 *
739 * Symmetric, eigenvalues specified
740 *
741  CALL slatms( mnmin, mnmin, 'S', iseed, 'S', work, imode,
742  $ cond, anorm, m, n, 'N', a, lda,
743  $ work( mnmin+1 ), iinfo )
744 *
745  ELSE IF( itype.EQ.6 ) THEN
746 *
747 * Nonsymmetric, singular values specified
748 *
749  CALL slatms( m, n, 'S', iseed, 'N', work, imode, cond,
750  $ anorm, m, n, 'N', a, lda, work( mnmin+1 ),
751  $ iinfo )
752 *
753  ELSE IF( itype.EQ.7 ) THEN
754 *
755 * Diagonal, random entries
756 *
757  CALL slatmr( mnmin, mnmin, 'S', iseed, 'N', work, 6, one,
758  $ one, 'T', 'N', work( mnmin+1 ), 1, one,
759  $ work( 2*mnmin+1 ), 1, one, 'N', iwork, 0, 0,
760  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
761 *
762  ELSE IF( itype.EQ.8 ) THEN
763 *
764 * Symmetric, random entries
765 *
766  CALL slatmr( mnmin, mnmin, 'S', iseed, 'S', work, 6, one,
767  $ one, 'T', 'N', work( mnmin+1 ), 1, one,
768  $ work( m+mnmin+1 ), 1, one, 'N', iwork, m, n,
769  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
770 *
771  ELSE IF( itype.EQ.9 ) THEN
772 *
773 * Nonsymmetric, random entries
774 *
775  CALL slatmr( m, n, 'S', iseed, 'N', work, 6, one, one,
776  $ 'T', 'N', work( mnmin+1 ), 1, one,
777  $ work( m+mnmin+1 ), 1, one, 'N', iwork, m, n,
778  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
779 *
780  ELSE IF( itype.EQ.10 ) THEN
781 *
782 * Bidiagonal, random entries
783 *
784  temp1 = -two*log( ulp )
785  DO 90 j = 1, mnmin
786  bd( j ) = exp( temp1*slarnd( 2, iseed ) )
787  IF( j.LT.mnmin )
788  $ be( j ) = exp( temp1*slarnd( 2, iseed ) )
789  90 CONTINUE
790 *
791  iinfo = 0
792  bidiag = .true.
793  IF( m.GE.n ) THEN
794  uplo = 'U'
795  ELSE
796  uplo = 'L'
797  END IF
798  ELSE
799  iinfo = 1
800  END IF
801 *
802  IF( iinfo.EQ.0 ) THEN
803 *
804 * Generate Right-Hand Side
805 *
806  IF( bidiag ) THEN
807  CALL slatmr( mnmin, nrhs, 'S', iseed, 'N', work, 6,
808  $ one, one, 'T', 'N', work( mnmin+1 ), 1,
809  $ one, work( 2*mnmin+1 ), 1, one, 'N',
810  $ iwork, mnmin, nrhs, zero, one, 'NO', y,
811  $ ldx, iwork, iinfo )
812  ELSE
813  CALL slatmr( m, nrhs, 'S', iseed, 'N', work, 6, one,
814  $ one, 'T', 'N', work( m+1 ), 1, one,
815  $ work( 2*m+1 ), 1, one, 'N', iwork, m,
816  $ nrhs, zero, one, 'NO', x, ldx, iwork,
817  $ iinfo )
818  END IF
819  END IF
820 *
821 * Error Exit
822 *
823  IF( iinfo.NE.0 ) THEN
824  WRITE( nout, fmt = 9998 )'Generator', iinfo, m, n,
825  $ jtype, ioldsd
826  info = abs( iinfo )
827  RETURN
828  END IF
829 *
830  100 CONTINUE
831 *
832 * Call SGEBRD and SORGBR to compute B, Q, and P, do tests.
833 *
834  IF( .NOT.bidiag ) THEN
835 *
836 * Compute transformations to reduce A to bidiagonal form:
837 * B := Q' * A * P.
838 *
839  CALL slacpy( ' ', m, n, a, lda, q, ldq )
840  CALL sgebrd( m, n, q, ldq, bd, be, work, work( mnmin+1 ),
841  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
842 *
843 * Check error code from SGEBRD.
844 *
845  IF( iinfo.NE.0 ) THEN
846  WRITE( nout, fmt = 9998 )'SGEBRD', iinfo, m, n,
847  $ jtype, ioldsd
848  info = abs( iinfo )
849  RETURN
850  END IF
851 *
852  CALL slacpy( ' ', m, n, q, ldq, pt, ldpt )
853  IF( m.GE.n ) THEN
854  uplo = 'U'
855  ELSE
856  uplo = 'L'
857  END IF
858 *
859 * Generate Q
860 *
861  mq = m
862  IF( nrhs.LE.0 )
863  $ mq = mnmin
864  CALL sorgbr( 'Q', m, mq, n, q, ldq, work,
865  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
866 *
867 * Check error code from SORGBR.
868 *
869  IF( iinfo.NE.0 ) THEN
870  WRITE( nout, fmt = 9998 )'SORGBR(Q)', iinfo, m, n,
871  $ jtype, ioldsd
872  info = abs( iinfo )
873  RETURN
874  END IF
875 *
876 * Generate P'
877 *
878  CALL sorgbr( 'P', mnmin, n, m, pt, ldpt, work( mnmin+1 ),
879  $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
880 *
881 * Check error code from SORGBR.
882 *
883  IF( iinfo.NE.0 ) THEN
884  WRITE( nout, fmt = 9998 )'SORGBR(P)', iinfo, m, n,
885  $ jtype, ioldsd
886  info = abs( iinfo )
887  RETURN
888  END IF
889 *
890 * Apply Q' to an M by NRHS matrix X: Y := Q' * X.
891 *
892  CALL sgemm( 'Transpose', 'No transpose', m, nrhs, m, one,
893  $ q, ldq, x, ldx, zero, y, ldx )
894 *
895 * Test 1: Check the decomposition A := Q * B * PT
896 * 2: Check the orthogonality of Q
897 * 3: Check the orthogonality of PT
898 *
899  CALL sbdt01( m, n, 1, a, lda, q, ldq, bd, be, pt, ldpt,
900  $ work, result( 1 ) )
901  CALL sort01( 'Columns', m, mq, q, ldq, work, lwork,
902  $ result( 2 ) )
903  CALL sort01( 'Rows', mnmin, n, pt, ldpt, work, lwork,
904  $ result( 3 ) )
905  END IF
906 *
907 * Use SBDSQR to form the SVD of the bidiagonal matrix B:
908 * B := U * S1 * VT, and compute Z = U' * Y.
909 *
910  CALL scopy( mnmin, bd, 1, s1, 1 )
911  IF( mnmin.GT.0 )
912  $ CALL scopy( mnmin-1, be, 1, work, 1 )
913  CALL slacpy( ' ', m, nrhs, y, ldx, z, ldx )
914  CALL slaset( 'Full', mnmin, mnmin, zero, one, u, ldpt )
915  CALL slaset( 'Full', mnmin, mnmin, zero, one, vt, ldpt )
916 *
917  CALL sbdsqr( uplo, mnmin, mnmin, mnmin, nrhs, s1, work, vt,
918  $ ldpt, u, ldpt, z, ldx, work( mnmin+1 ), iinfo )
919 *
920 * Check error code from SBDSQR.
921 *
922  IF( iinfo.NE.0 ) THEN
923  WRITE( nout, fmt = 9998 )'SBDSQR(vects)', iinfo, m, n,
924  $ jtype, ioldsd
925  info = abs( iinfo )
926  IF( iinfo.LT.0 ) THEN
927  RETURN
928  ELSE
929  result( 4 ) = ulpinv
930  GO TO 270
931  END IF
932  END IF
933 *
934 * Use SBDSQR to compute only the singular values of the
935 * bidiagonal matrix B; U, VT, and Z should not be modified.
936 *
937  CALL scopy( mnmin, bd, 1, s2, 1 )
938  IF( mnmin.GT.0 )
939  $ CALL scopy( mnmin-1, be, 1, work, 1 )
940 *
941  CALL sbdsqr( uplo, mnmin, 0, 0, 0, s2, work, vt, ldpt, u,
942  $ ldpt, z, ldx, work( mnmin+1 ), iinfo )
943 *
944 * Check error code from SBDSQR.
945 *
946  IF( iinfo.NE.0 ) THEN
947  WRITE( nout, fmt = 9998 )'SBDSQR(values)', iinfo, m, n,
948  $ jtype, ioldsd
949  info = abs( iinfo )
950  IF( iinfo.LT.0 ) THEN
951  RETURN
952  ELSE
953  result( 9 ) = ulpinv
954  GO TO 270
955  END IF
956  END IF
957 *
958 * Test 4: Check the decomposition B := U * S1 * VT
959 * 5: Check the computation Z := U' * Y
960 * 6: Check the orthogonality of U
961 * 7: Check the orthogonality of VT
962 *
963  CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
964  $ work, result( 4 ) )
965  CALL sbdt02( mnmin, nrhs, y, ldx, z, ldx, u, ldpt, work,
966  $ result( 5 ) )
967  CALL sort01( 'Columns', mnmin, mnmin, u, ldpt, work, lwork,
968  $ result( 6 ) )
969  CALL sort01( 'Rows', mnmin, mnmin, vt, ldpt, work, lwork,
970  $ result( 7 ) )
971 *
972 * Test 8: Check that the singular values are sorted in
973 * non-increasing order and are non-negative
974 *
975  result( 8 ) = zero
976  DO 110 i = 1, mnmin - 1
977  IF( s1( i ).LT.s1( i+1 ) )
978  $ result( 8 ) = ulpinv
979  IF( s1( i ).LT.zero )
980  $ result( 8 ) = ulpinv
981  110 CONTINUE
982  IF( mnmin.GE.1 ) THEN
983  IF( s1( mnmin ).LT.zero )
984  $ result( 8 ) = ulpinv
985  END IF
986 *
987 * Test 9: Compare SBDSQR with and without singular vectors
988 *
989  temp2 = zero
990 *
991  DO 120 j = 1, mnmin
992  temp1 = abs( s1( j )-s2( j ) ) /
993  $ max( sqrt( unfl )*max( s1( 1 ), one ),
994  $ ulp*max( abs( s1( j ) ), abs( s2( j ) ) ) )
995  temp2 = max( temp1, temp2 )
996  120 CONTINUE
997 *
998  result( 9 ) = temp2
999 *
1000 * Test 10: Sturm sequence test of singular values
1001 * Go up by factors of two until it succeeds
1002 *
1003  temp1 = thresh*( half-ulp )
1004 *
1005  DO 130 j = 0, log2ui
1006 * CALL SSVDCH( MNMIN, BD, BE, S1, TEMP1, IINFO )
1007  IF( iinfo.EQ.0 )
1008  $ GO TO 140
1009  temp1 = temp1*two
1010  130 CONTINUE
1011 *
1012  140 CONTINUE
1013  result( 10 ) = temp1
1014 *
1015 * Use SBDSQR to form the decomposition A := (QU) S (VT PT)
1016 * from the bidiagonal form A := Q B PT.
1017 *
1018  IF( .NOT.bidiag ) THEN
1019  CALL scopy( mnmin, bd, 1, s2, 1 )
1020  IF( mnmin.GT.0 )
1021  $ CALL scopy( mnmin-1, be, 1, work, 1 )
1022 *
1023  CALL sbdsqr( uplo, mnmin, n, m, nrhs, s2, work, pt, ldpt,
1024  $ q, ldq, y, ldx, work( mnmin+1 ), iinfo )
1025 *
1026 * Test 11: Check the decomposition A := Q*U * S2 * VT*PT
1027 * 12: Check the computation Z := U' * Q' * X
1028 * 13: Check the orthogonality of Q*U
1029 * 14: Check the orthogonality of VT*PT
1030 *
1031  CALL sbdt01( m, n, 0, a, lda, q, ldq, s2, dumma, pt,
1032  $ ldpt, work, result( 11 ) )
1033  CALL sbdt02( m, nrhs, x, ldx, y, ldx, q, ldq, work,
1034  $ result( 12 ) )
1035  CALL sort01( 'Columns', m, mq, q, ldq, work, lwork,
1036  $ result( 13 ) )
1037  CALL sort01( 'Rows', mnmin, n, pt, ldpt, work, lwork,
1038  $ result( 14 ) )
1039  END IF
1040 *
1041 * Use SBDSDC to form the SVD of the bidiagonal matrix B:
1042 * B := U * S1 * VT
1043 *
1044  CALL scopy( mnmin, bd, 1, s1, 1 )
1045  IF( mnmin.GT.0 )
1046  $ CALL scopy( mnmin-1, be, 1, work, 1 )
1047  CALL slaset( 'Full', mnmin, mnmin, zero, one, u, ldpt )
1048  CALL slaset( 'Full', mnmin, mnmin, zero, one, vt, ldpt )
1049 *
1050  CALL sbdsdc( uplo, 'I', mnmin, s1, work, u, ldpt, vt, ldpt,
1051  $ dum, idum, work( mnmin+1 ), iwork, iinfo )
1052 *
1053 * Check error code from SBDSDC.
1054 *
1055  IF( iinfo.NE.0 ) THEN
1056  WRITE( nout, fmt = 9998 )'SBDSDC(vects)', iinfo, m, n,
1057  $ jtype, ioldsd
1058  info = abs( iinfo )
1059  IF( iinfo.LT.0 ) THEN
1060  RETURN
1061  ELSE
1062  result( 15 ) = ulpinv
1063  GO TO 270
1064  END IF
1065  END IF
1066 *
1067 * Use SBDSDC to compute only the singular values of the
1068 * bidiagonal matrix B; U and VT should not be modified.
1069 *
1070  CALL scopy( mnmin, bd, 1, s2, 1 )
1071  IF( mnmin.GT.0 )
1072  $ CALL scopy( mnmin-1, be, 1, work, 1 )
1073 *
1074  CALL sbdsdc( uplo, 'N', mnmin, s2, work, dum, 1, dum, 1,
1075  $ dum, idum, work( mnmin+1 ), iwork, iinfo )
1076 *
1077 * Check error code from SBDSDC.
1078 *
1079  IF( iinfo.NE.0 ) THEN
1080  WRITE( nout, fmt = 9998 )'SBDSDC(values)', iinfo, m, n,
1081  $ jtype, ioldsd
1082  info = abs( iinfo )
1083  IF( iinfo.LT.0 ) THEN
1084  RETURN
1085  ELSE
1086  result( 18 ) = ulpinv
1087  GO TO 270
1088  END IF
1089  END IF
1090 *
1091 * Test 15: Check the decomposition B := U * S1 * VT
1092 * 16: Check the orthogonality of U
1093 * 17: Check the orthogonality of VT
1094 *
1095  CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
1096  $ work, result( 15 ) )
1097  CALL sort01( 'Columns', mnmin, mnmin, u, ldpt, work, lwork,
1098  $ result( 16 ) )
1099  CALL sort01( 'Rows', mnmin, mnmin, vt, ldpt, work, lwork,
1100  $ result( 17 ) )
1101 *
1102 * Test 18: Check that the singular values are sorted in
1103 * non-increasing order and are non-negative
1104 *
1105  result( 18 ) = zero
1106  DO 150 i = 1, mnmin - 1
1107  IF( s1( i ).LT.s1( i+1 ) )
1108  $ result( 18 ) = ulpinv
1109  IF( s1( i ).LT.zero )
1110  $ result( 18 ) = ulpinv
1111  150 CONTINUE
1112  IF( mnmin.GE.1 ) THEN
1113  IF( s1( mnmin ).LT.zero )
1114  $ result( 18 ) = ulpinv
1115  END IF
1116 *
1117 * Test 19: Compare SBDSQR with and without singular vectors
1118 *
1119  temp2 = zero
1120 *
1121  DO 160 j = 1, mnmin
1122  temp1 = abs( s1( j )-s2( j ) ) /
1123  $ max( sqrt( unfl )*max( s1( 1 ), one ),
1124  $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1125  temp2 = max( temp1, temp2 )
1126  160 CONTINUE
1127 *
1128  result( 19 ) = temp2
1129 *
1130 *
1131 * Use SBDSVDX to compute the SVD of the bidiagonal matrix B:
1132 * B := U * S1 * VT
1133 *
1134  IF( jtype.EQ.10 .OR. jtype.EQ.16 ) THEN
1135 * =================================
1136 * Matrix types temporarily disabled
1137 * =================================
1138  result( 20:34 ) = zero
1139  GO TO 270
1140  END IF
1141 *
1142  iwbs = 1
1143  iwbd = iwbs + mnmin
1144  iwbe = iwbd + mnmin
1145  iwbz = iwbe + mnmin
1146  iwwork = iwbz + mnmin*(mnmin*2+1)
1147  mnmin2 = max( 1,mnmin*2 )
1148 *
1149  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1150  IF( mnmin.GT.0 )
1151  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1152 *
1153  CALL sbdsvdx( uplo, 'V', 'A', mnmin, work( iwbd ),
1154  $ work( iwbe ), zero, zero, 0, 0, ns1, s1,
1155  $ work( iwbz ), mnmin2, work( iwwork ),
1156  $ iwork, iinfo)
1157 *
1158 * Check error code from SBDSVDX.
1159 *
1160  IF( iinfo.NE.0 ) THEN
1161  WRITE( nout, fmt = 9998 )'SBDSVDX(vects,A)', iinfo, m, n,
1162  $ jtype, ioldsd
1163  info = abs( iinfo )
1164  IF( iinfo.LT.0 ) THEN
1165  RETURN
1166  ELSE
1167  result( 20 ) = ulpinv
1168  GO TO 270
1169  END IF
1170  END IF
1171 *
1172  j = iwbz
1173  DO 170 i = 1, ns1
1174  CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1175  j = j + mnmin
1176  CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1177  j = j + mnmin
1178  170 CONTINUE
1179 *
1180 * Use SBDSVDX to compute only the singular values of the
1181 * bidiagonal matrix B; U and VT should not be modified.
1182 *
1183  IF( jtype.EQ.9 ) THEN
1184 * =================================
1185 * Matrix types temporarily disabled
1186 * =================================
1187  result( 24 ) = zero
1188  GO TO 270
1189  END IF
1190 *
1191  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1192  IF( mnmin.GT.0 )
1193  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1194 *
1195  CALL sbdsvdx( uplo, 'N', 'A', mnmin, work( iwbd ),
1196  $ work( iwbe ), zero, zero, 0, 0, ns2, s2,
1197  $ work( iwbz ), mnmin2, work( iwwork ),
1198  $ iwork, iinfo )
1199 *
1200 * Check error code from SBDSVDX.
1201 *
1202  IF( iinfo.NE.0 ) THEN
1203  WRITE( nout, fmt = 9998 )'SBDSVDX(values,A)', iinfo,
1204  $ m, n, jtype, ioldsd
1205  info = abs( iinfo )
1206  IF( iinfo.LT.0 ) THEN
1207  RETURN
1208  ELSE
1209  result( 24 ) = ulpinv
1210  GO TO 270
1211  END IF
1212  END IF
1213 *
1214 * Save S1 for tests 30-34.
1215 *
1216  CALL scopy( mnmin, s1, 1, work( iwbs ), 1 )
1217 *
1218 * Test 20: Check the decomposition B := U * S1 * VT
1219 * 21: Check the orthogonality of U
1220 * 22: Check the orthogonality of VT
1221 * 23: Check that the singular values are sorted in
1222 * non-increasing order and are non-negative
1223 * 24: Compare SBDSVDX with and without singular vectors
1224 *
1225  CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt,
1226  $ ldpt, work( iwbs+mnmin ), result( 20 ) )
1227  CALL sort01( 'Columns', mnmin, mnmin, u, ldpt,
1228  $ work( iwbs+mnmin ), lwork-mnmin,
1229  $ result( 21 ) )
1230  CALL sort01( 'Rows', mnmin, mnmin, vt, ldpt,
1231  $ work( iwbs+mnmin ), lwork-mnmin,
1232  $ result( 22) )
1233 *
1234  result( 23 ) = zero
1235  DO 180 i = 1, mnmin - 1
1236  IF( s1( i ).LT.s1( i+1 ) )
1237  $ result( 23 ) = ulpinv
1238  IF( s1( i ).LT.zero )
1239  $ result( 23 ) = ulpinv
1240  180 CONTINUE
1241  IF( mnmin.GE.1 ) THEN
1242  IF( s1( mnmin ).LT.zero )
1243  $ result( 23 ) = ulpinv
1244  END IF
1245 *
1246  temp2 = zero
1247  DO 190 j = 1, mnmin
1248  temp1 = abs( s1( j )-s2( j ) ) /
1249  $ max( sqrt( unfl )*max( s1( 1 ), one ),
1250  $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1251  temp2 = max( temp1, temp2 )
1252  190 CONTINUE
1253  result( 24 ) = temp2
1254  anorm = s1( 1 )
1255 *
1256 * Use SBDSVDX with RANGE='I': choose random values for IL and
1257 * IU, and ask for the IL-th through IU-th singular values
1258 * and corresponding vectors.
1259 *
1260  DO 200 i = 1, 4
1261  iseed2( i ) = iseed( i )
1262  200 CONTINUE
1263  IF( mnmin.LE.1 ) THEN
1264  il = 1
1265  iu = mnmin
1266  ELSE
1267  il = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1268  iu = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1269  IF( iu.LT.il ) THEN
1270  itemp = iu
1271  iu = il
1272  il = itemp
1273  END IF
1274  END IF
1275 *
1276  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1277  IF( mnmin.GT.0 )
1278  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1279 *
1280  CALL sbdsvdx( uplo, 'V', 'I', mnmin, work( iwbd ),
1281  $ work( iwbe ), zero, zero, il, iu, ns1, s1,
1282  $ work( iwbz ), mnmin2, work( iwwork ),
1283  $ iwork, iinfo)
1284 *
1285 * Check error code from SBDSVDX.
1286 *
1287  IF( iinfo.NE.0 ) THEN
1288  WRITE( nout, fmt = 9998 )'SBDSVDX(vects,I)', iinfo,
1289  $ m, n, jtype, ioldsd
1290  info = abs( iinfo )
1291  IF( iinfo.LT.0 ) THEN
1292  RETURN
1293  ELSE
1294  result( 25 ) = ulpinv
1295  GO TO 270
1296  END IF
1297  END IF
1298 *
1299  j = iwbz
1300  DO 210 i = 1, ns1
1301  CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1302  j = j + mnmin
1303  CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1304  j = j + mnmin
1305  210 CONTINUE
1306 *
1307 * Use SBDSVDX to compute only the singular values of the
1308 * bidiagonal matrix B; U and VT should not be modified.
1309 *
1310  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1311  IF( mnmin.GT.0 )
1312  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1313 *
1314  CALL sbdsvdx( uplo, 'N', 'I', mnmin, work( iwbd ),
1315  $ work( iwbe ), zero, zero, il, iu, ns2, s2,
1316  $ work( iwbz ), mnmin2, work( iwwork ),
1317  $ iwork, iinfo )
1318 *
1319 * Check error code from SBDSVDX.
1320 *
1321  IF( iinfo.NE.0 ) THEN
1322  WRITE( nout, fmt = 9998 )'SBDSVDX(values,I)', iinfo,
1323  $ m, n, jtype, ioldsd
1324  info = abs( iinfo )
1325  IF( iinfo.LT.0 ) THEN
1326  RETURN
1327  ELSE
1328  result( 29 ) = ulpinv
1329  GO TO 270
1330  END IF
1331  END IF
1332 *
1333 * Test 25: Check S1 - U' * B * VT'
1334 * 26: Check the orthogonality of U
1335 * 27: Check the orthogonality of VT
1336 * 28: Check that the singular values are sorted in
1337 * non-increasing order and are non-negative
1338 * 29: Compare SBDSVDX with and without singular vectors
1339 *
1340  CALL sbdt04( uplo, mnmin, bd, be, s1, ns1, u,
1341  $ ldpt, vt, ldpt, work( iwbs+mnmin ),
1342  $ result( 25 ) )
1343  CALL sort01( 'Columns', mnmin, ns1, u, ldpt,
1344  $ work( iwbs+mnmin ), lwork-mnmin,
1345  $ result( 26 ) )
1346  CALL sort01( 'Rows', ns1, mnmin, vt, ldpt,
1347  $ work( iwbs+mnmin ), lwork-mnmin,
1348  $ result( 27 ) )
1349 *
1350  result( 28 ) = zero
1351  DO 220 i = 1, ns1 - 1
1352  IF( s1( i ).LT.s1( i+1 ) )
1353  $ result( 28 ) = ulpinv
1354  IF( s1( i ).LT.zero )
1355  $ result( 28 ) = ulpinv
1356  220 CONTINUE
1357  IF( ns1.GE.1 ) THEN
1358  IF( s1( ns1 ).LT.zero )
1359  $ result( 28 ) = ulpinv
1360  END IF
1361 *
1362  temp2 = zero
1363  DO 230 j = 1, ns1
1364  temp1 = abs( s1( j )-s2( j ) ) /
1365  $ max( sqrt( unfl )*max( s1( 1 ), one ),
1366  $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1367  temp2 = max( temp1, temp2 )
1368  230 CONTINUE
1369  result( 29 ) = temp2
1370 *
1371 * Use SBDSVDX with RANGE='V': determine the values VL and VU
1372 * of the IL-th and IU-th singular values and ask for all
1373 * singular values in this range.
1374 *
1375  CALL scopy( mnmin, work( iwbs ), 1, s1, 1 )
1376 *
1377  IF( mnmin.GT.0 ) THEN
1378  IF( il.NE.1 ) THEN
1379  vu = s1( il ) + max( half*abs( s1( il )-s1( il-1 ) ),
1380  $ ulp*anorm, two*rtunfl )
1381  ELSE
1382  vu = s1( 1 ) + max( half*abs( s1( mnmin )-s1( 1 ) ),
1383  $ ulp*anorm, two*rtunfl )
1384  END IF
1385  IF( iu.NE.ns1 ) THEN
1386  vl = s1( iu ) - max( ulp*anorm, two*rtunfl,
1387  $ half*abs( s1( iu+1 )-s1( iu ) ) )
1388  ELSE
1389  vl = s1( ns1 ) - max( ulp*anorm, two*rtunfl,
1390  $ half*abs( s1( mnmin )-s1( 1 ) ) )
1391  END IF
1392  vl = max( vl,zero )
1393  vu = max( vu,zero )
1394  IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1395  ELSE
1396  vl = zero
1397  vu = one
1398  END IF
1399 *
1400  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1401  IF( mnmin.GT.0 )
1402  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1403 *
1404  CALL sbdsvdx( uplo, 'V', 'V', mnmin, work( iwbd ),
1405  $ work( iwbe ), vl, vu, 0, 0, ns1, s1,
1406  $ work( iwbz ), mnmin2, work( iwwork ),
1407  $ iwork, iinfo )
1408 *
1409 * Check error code from SBDSVDX.
1410 *
1411  IF( iinfo.NE.0 ) THEN
1412  WRITE( nout, fmt = 9998 )'SBDSVDX(vects,V)', iinfo,
1413  $ m, n, jtype, ioldsd
1414  info = abs( iinfo )
1415  IF( iinfo.LT.0 ) THEN
1416  RETURN
1417  ELSE
1418  result( 30 ) = ulpinv
1419  GO TO 270
1420  END IF
1421  END IF
1422 *
1423  j = iwbz
1424  DO 240 i = 1, ns1
1425  CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1426  j = j + mnmin
1427  CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1428  j = j + mnmin
1429  240 CONTINUE
1430 *
1431 * Use SBDSVDX to compute only the singular values of the
1432 * bidiagonal matrix B; U and VT should not be modified.
1433 *
1434  CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1435  IF( mnmin.GT.0 )
1436  $ CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1437 *
1438  CALL sbdsvdx( uplo, 'N', 'V', mnmin, work( iwbd ),
1439  $ work( iwbe ), vl, vu, 0, 0, ns2, s2,
1440  $ work( iwbz ), mnmin2, work( iwwork ),
1441  $ iwork, iinfo )
1442 *
1443 * Check error code from SBDSVDX.
1444 *
1445  IF( iinfo.NE.0 ) THEN
1446  WRITE( nout, fmt = 9998 )'SBDSVDX(values,V)', iinfo,
1447  $ m, n, jtype, ioldsd
1448  info = abs( iinfo )
1449  IF( iinfo.LT.0 ) THEN
1450  RETURN
1451  ELSE
1452  result( 34 ) = ulpinv
1453  GO TO 270
1454  END IF
1455  END IF
1456 *
1457 * Test 30: Check S1 - U' * B * VT'
1458 * 31: Check the orthogonality of U
1459 * 32: Check the orthogonality of VT
1460 * 33: Check that the singular values are sorted in
1461 * non-increasing order and are non-negative
1462 * 34: Compare SBDSVDX with and without singular vectors
1463 *
1464  CALL sbdt04( uplo, mnmin, bd, be, s1, ns1, u,
1465  $ ldpt, vt, ldpt, work( iwbs+mnmin ),
1466  $ result( 30 ) )
1467  CALL sort01( 'Columns', mnmin, ns1, u, ldpt,
1468  $ work( iwbs+mnmin ), lwork-mnmin,
1469  $ result( 31 ) )
1470  CALL sort01( 'Rows', ns1, mnmin, vt, ldpt,
1471  $ work( iwbs+mnmin ), lwork-mnmin,
1472  $ result( 32 ) )
1473 *
1474  result( 33 ) = zero
1475  DO 250 i = 1, ns1 - 1
1476  IF( s1( i ).LT.s1( i+1 ) )
1477  $ result( 28 ) = ulpinv
1478  IF( s1( i ).LT.zero )
1479  $ result( 28 ) = ulpinv
1480  250 CONTINUE
1481  IF( ns1.GE.1 ) THEN
1482  IF( s1( ns1 ).LT.zero )
1483  $ result( 28 ) = ulpinv
1484  END IF
1485 *
1486  temp2 = zero
1487  DO 260 j = 1, ns1
1488  temp1 = abs( s1( j )-s2( j ) ) /
1489  $ max( sqrt( unfl )*max( s1( 1 ), one ),
1490  $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1491  temp2 = max( temp1, temp2 )
1492  260 CONTINUE
1493  result( 34 ) = temp2
1494 *
1495 * End of Loop -- Check for RESULT(j) > THRESH
1496 *
1497  270 CONTINUE
1498 *
1499  DO 280 j = 1, 34
1500  IF( result( j ).GE.thresh ) THEN
1501  IF( nfail.EQ.0 )
1502  $ CALL slahd2( nout, path )
1503  WRITE( nout, fmt = 9999 )m, n, jtype, ioldsd, j,
1504  $ result( j )
1505  nfail = nfail + 1
1506  END IF
1507  280 CONTINUE
1508  IF( .NOT.bidiag ) THEN
1509  ntest = ntest + 34
1510  ELSE
1511  ntest = ntest + 30
1512  END IF
1513 *
1514  290 CONTINUE
1515  300 CONTINUE
1516 *
1517 * Summary
1518 *
1519  CALL alasum( path, nout, nfail, ntest, 0 )
1520 *
1521  RETURN
1522 *
1523 * End of SCHKBD
1524 *
1525  9999 FORMAT( ' M=', i5, ', N=', i5, ', type ', i2, ', seed=',
1526  $ 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
1527  9998 FORMAT( ' SCHKBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1528  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
1529  $ i5, ')' )
1530 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
Definition: sgebrd.f:207
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
Definition: sbdsqr.f:232
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
SBDSVDX
Definition: sbdsvdx.f:219
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
Definition: sorgbr.f:159
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
Definition: sbdsdc.f:207
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine slatmr(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)
SLATMR
Definition: slatmr.f:473
subroutine sbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RESID)
SBDT02
Definition: sbdt02.f:113
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
Definition: sgemm.f:189
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
Definition: sort01.f:118
subroutine sbdt04(UPLO, N, D, E, S, NS, U, LDU, VT, LDVT, WORK, RESID)
Definition: sbdt04.f:132
subroutine sbdt03(UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
SBDT03
Definition: sbdt03.f:137
subroutine slahd2(IOUNIT, PATH)
SLAHD2
Definition: slahd2.f:67
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
SBDT01
Definition: sbdt01.f:142
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:75
real function ssxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
SSXT1
Definition: ssxt1.f:108

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkbk ( integer  NIN,
integer  NOUT 
)

SCHKBK

Purpose:
 SCHKBK tests SGEBAK, a routine for backward transformation of
 the computed right or left eigenvectors if the orginal matrix
 was preprocessed by balance subroutine SGEBAL.
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 schkbk.f.

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

SCHKBL

Purpose:
 SCHKBL tests SGEBAL, a routine for balancing a general real
 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 schkbl.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

SCHKEC

Purpose:
 SCHKEC tests eigen- condition estimation routines
        SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC,
        STRSYL, STREXC, STRSNA, STRSEN

 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, STREXC, STRSNA and STRSEN
 are tested by reading in precomputed examples from a file (on input
 unit NIN).  Output is written to output unit NOUT.
Parameters
[in]THRESH
          THRESH is REAL
          Threshold for residual tests.  A computed test ratio passes
          the threshold if it is less than THRESH.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NIN
          NIN is INTEGER
          The logical unit number for input.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 78 of file schkec.f.

78 *
79 * -- LAPACK test routine (version 3.4.0) --
80 * -- LAPACK is a software package provided by Univ. of Tennessee, --
81 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
82 * November 2011
83 *
84 * .. Scalar Arguments ..
85  LOGICAL tsterr
86  INTEGER nin, nout
87  REAL thresh
88 * ..
89 *
90 * =====================================================================
91 *
92 * .. Local Scalars ..
93  LOGICAL ok
94  CHARACTER*3 path
95  INTEGER klaexc, klaln2, klanv2, klaqtr, klasy2, ktrexc,
96  $ ktrsen, ktrsna, ktrsyl, llaexc, llaln2, llanv2,
97  $ llaqtr, llasy2, ltrexc, ltrsyl, nlanv2, nlaqtr,
98  $ nlasy2, ntests, ntrsyl
99  REAL eps, rlaexc, rlaln2, rlanv2, rlaqtr, rlasy2,
100  $ rtrexc, rtrsyl, sfmin
101 * ..
102 * .. Local Arrays ..
103  INTEGER ltrsen( 3 ), ltrsna( 3 ), nlaexc( 2 ),
104  $ nlaln2( 2 ), ntrexc( 3 ), ntrsen( 3 ),
105  $ ntrsna( 3 )
106  REAL rtrsen( 3 ), rtrsna( 3 )
107 * ..
108 * .. External Subroutines ..
109  EXTERNAL serrec, sget31, sget32, sget33, sget34, sget35,
111 * ..
112 * .. External Functions ..
113  REAL slamch
114  EXTERNAL slamch
115 * ..
116 * .. Executable Statements ..
117 *
118  path( 1: 1 ) = 'Single precision'
119  path( 2: 3 ) = 'EC'
120  eps = slamch( 'P' )
121  sfmin = slamch( 'S' )
122 *
123 * Print header information
124 *
125  WRITE( nout, fmt = 9989 )
126  WRITE( nout, fmt = 9988 )eps, sfmin
127  WRITE( nout, fmt = 9987 )thresh
128 *
129 * Test error exits if TSTERR is .TRUE.
130 *
131  IF( tsterr )
132  $ CALL serrec( path, nout )
133 *
134  ok = .true.
135  CALL sget31( rlaln2, llaln2, nlaln2, klaln2 )
136  IF( rlaln2.GT.thresh .OR. nlaln2( 1 ).NE.0 ) THEN
137  ok = .false.
138  WRITE( nout, fmt = 9999 )rlaln2, llaln2, nlaln2, klaln2
139  END IF
140 *
141  CALL sget32( rlasy2, llasy2, nlasy2, klasy2 )
142  IF( rlasy2.GT.thresh ) THEN
143  ok = .false.
144  WRITE( nout, fmt = 9998 )rlasy2, llasy2, nlasy2, klasy2
145  END IF
146 *
147  CALL sget33( rlanv2, llanv2, nlanv2, klanv2 )
148  IF( rlanv2.GT.thresh .OR. nlanv2.NE.0 ) THEN
149  ok = .false.
150  WRITE( nout, fmt = 9997 )rlanv2, llanv2, nlanv2, klanv2
151  END IF
152 *
153  CALL sget34( rlaexc, llaexc, nlaexc, klaexc )
154  IF( rlaexc.GT.thresh .OR. nlaexc( 2 ).NE.0 ) THEN
155  ok = .false.
156  WRITE( nout, fmt = 9996 )rlaexc, llaexc, nlaexc, klaexc
157  END IF
158 *
159  CALL sget35( rtrsyl, ltrsyl, ntrsyl, ktrsyl )
160  IF( rtrsyl.GT.thresh ) THEN
161  ok = .false.
162  WRITE( nout, fmt = 9995 )rtrsyl, ltrsyl, ntrsyl, ktrsyl
163  END IF
164 *
165  CALL sget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
166  IF( rtrexc.GT.thresh .OR. ntrexc( 3 ).GT.0 ) THEN
167  ok = .false.
168  WRITE( nout, fmt = 9994 )rtrexc, ltrexc, ntrexc, ktrexc
169  END IF
170 *
171  CALL sget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
172  IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
173  $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
174  $ THEN
175  ok = .false.
176  WRITE( nout, fmt = 9993 )rtrsna, ltrsna, ntrsna, ktrsna
177  END IF
178 *
179  CALL sget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
180  IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
181  $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
182  $ THEN
183  ok = .false.
184  WRITE( nout, fmt = 9992 )rtrsen, ltrsen, ntrsen, ktrsen
185  END IF
186 *
187  CALL sget39( rlaqtr, llaqtr, nlaqtr, klaqtr )
188  IF( rlaqtr.GT.thresh ) THEN
189  ok = .false.
190  WRITE( nout, fmt = 9991 )rlaqtr, llaqtr, nlaqtr, klaqtr
191  END IF
192 *
193  ntests = klaln2 + klasy2 + klanv2 + klaexc + ktrsyl + ktrexc +
194  $ ktrsna + ktrsen + klaqtr
195  IF( ok )
196  $ WRITE( nout, fmt = 9990 )path, ntests
197 *
198  RETURN
199  9999 FORMAT( ' Error in SLALN2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
200  $ 'INFO=', 2i8, ' KNT=', i8 )
201  9998 FORMAT( ' Error in SLASY2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
202  $ 'INFO=', i8, ' KNT=', i8 )
203  9997 FORMAT( ' Error in SLANV2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
204  $ 'INFO=', i8, ' KNT=', i8 )
205  9996 FORMAT( ' Error in SLAEXC: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
206  $ 'INFO=', 2i8, ' KNT=', i8 )
207  9995 FORMAT( ' Error in STRSYL: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
208  $ 'INFO=', i8, ' KNT=', i8 )
209  9994 FORMAT( ' Error in STREXC: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
210  $ 'INFO=', 3i8, ' KNT=', i8 )
211  9993 FORMAT( ' Error in STRSNA: RMAX =', 3e12.3, / ' LMAX = ', 3i8,
212  $ ' NINFO=', 3i8, ' KNT=', i8 )
213  9992 FORMAT( ' Error in STRSEN: RMAX =', 3e12.3, / ' LMAX = ', 3i8,
214  $ ' NINFO=', 3i8, ' KNT=', i8 )
215  9991 FORMAT( ' Error in SLAQTR: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
216  $ 'INFO=', i8, ' KNT=', i8 )
217  9990 FORMAT( / 1x, 'All tests for ', a3, ' routines passed the thresh',
218  $ 'old ( ', i6, ' tests run)' )
219  9989 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition estim',
220  $ 'ation routines', / ' SLALN2, SLASY2, SLANV2, SLAEXC, STRS',
221  $ 'YL, STREXC, STRSNA, STRSEN, SLAQTR', / )
222  9988 FORMAT( ' Relative machine precision (EPS) = ', e16.6, / ' Safe ',
223  $ 'minimum (SFMIN) = ', e16.6, / )
224  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
225  $ 's than', f8.2, / / )
226 *
227 * End of SCHKEC
228 *
subroutine sget35(RMAX, LMAX, NINFO, KNT)
SGET35
Definition: sget35.f:80
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sget38(RMAX, LMAX, NINFO, KNT, NIN)
SGET38
Definition: sget38.f:93
subroutine sget39(RMAX, LMAX, NINFO, KNT)
SGET39
Definition: sget39.f:105
subroutine serrec(PATH, NUNIT)
SERREC
Definition: serrec.f:58
subroutine sget34(RMAX, LMAX, NINFO, KNT)
SGET34
Definition: sget34.f:84
subroutine sget37(RMAX, LMAX, NINFO, KNT, NIN)
SGET37
Definition: sget37.f:92
subroutine sget32(RMAX, LMAX, NINFO, KNT)
SGET32
Definition: sget32.f:84
subroutine sget31(RMAX, LMAX, NINFO, KNT)
SGET31
Definition: sget31.f:93
subroutine sget33(RMAX, LMAX, NINFO, KNT)
SGET33
Definition: sget33.f:78
subroutine sget36(RMAX, LMAX, NINFO, KNT, NIN)
SGET36
Definition: sget36.f:90

Here is the call graph for this function:

Here is the caller graph for this function:

program schkee ( )

SCHKEE

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

 NEP (Nonsymmetric Eigenvalue Problem):
     Test SGEHRD, SORGHR, SHSEQR, STREVC, SHSEIN, and SORMHR

 SEP (Symmetric Eigenvalue Problem):
     Test SSYTRD, SORGTR, SSTEQR, SSTERF, SSTEIN, SSTEDC,
     and drivers SSYEV(X), SSBEV(X), SSPEV(X), SSTEV(X),
                 SSYEVD,   SSBEVD,   SSPEVD,   SSTEVD

 SVD (Singular Value Decomposition):
     Test SGEBRD, SORGBR, SBDSQR, SBDSDC
     and the drivers SGESVD, SGESDD

 SEV (Nonsymmetric Eigenvalue/eigenvector Driver):
     Test SGEEV

 SES (Nonsymmetric Schur form Driver):
     Test SGEES

 SVX (Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test SGEEVX

 SSX (Nonsymmetric Schur form Expert Driver):
     Test SGEESX

 SGG (Generalized Nonsymmetric Eigenvalue Problem):
     Test SGGHD3, SGGBAL, SGGBAK, SHGEQZ, and STGEVC

 SGS (Generalized Nonsymmetric Schur form Driver):
     Test SGGES

 SGV (Generalized Nonsymmetric Eigenvalue/eigenvector Driver):
     Test SGGEV

 SGX (Generalized Nonsymmetric Schur form Expert Driver):
     Test SGGESX

 SXV (Generalized Nonsymmetric Eigenvalue/eigenvector Expert Driver):
     Test SGGEVX

 SSG (Symmetric Generalized Eigenvalue Problem):
     Test SSYGST, SSYGV, SSYGVD, SSYGVX, SSPGST, SSPGV, SSPGVD,
     SSPGVX, SSBGST, SSBGV, SSBGVD, and SSBGVX

 SSB (Symmetric Band Eigenvalue Problem):
     Test SSBTRD

 SBB (Band Singular Value Decomposition):
     Test SGBBRD

 SEC (Eigencondition estimation):
     Test SLALN2, SLASY2, SLAEQU, SLAEXC, STRSYL, STREXC, STRSNA,
     STRSEN, and SLAQTR

 SBL (Balancing a general matrix)
     Test SGEBAL

 SBK (Back transformation on a balanced matrix)
     Test SGEBAK

 SGL (Balancing a matrix pair)
     Test SGGBAL

 SGK (Back transformation on a matrix pair)
     Test SGGBAK

 GLM (Generalized Linear Regression Model):
     Tests SGGGLM

 GQR (Generalized QR and RQ factorizations):
     Tests SGGQRF and SGGRQF

 GSV (Generalized Singular Value Decomposition):
     Tests SGGSVD, SGGSVP, STGSJA, SLAGS2, SLAPLL, and SLAPMT

 CSD (CS decomposition):
     Tests SORCSD

 LSE (Constrained Linear Least Squares):
     Tests SGGLSE

 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

 SHS or NEP      21     SCHKHS
 SST or SEP      21     SCHKST (routines)
                 18     SDRVST (drivers)
 SBD or SVD      16     SCHKBD (routines)
                  5     SDRVBD (drivers)
 SEV             21     SDRVEV
 SES             21     SDRVES
 SVX             21     SDRVVX
 SSX             21     SDRVSX
 SGG             26     SCHKGG (routines)
 SGS             26     SDRGES
 SGX              5     SDRGSX
 SGV             26     SDRGEV
 SXV              2     SDRGVX
 SSG             21     SDRVSG
 SSB             15     SCHKSB
 SBB             15     SCHKBB
 SEC              -     SCHKEC
 SBL              -     SCHKBL
 SBK              -     SCHKBK
 SGL              -     SCHKGL
 SGK              -     SCHKGK
 GLM              8     SCKGLM
 GQR              8     SCKGQR
 GSV              8     SCKGSV
 CSD              3     SCKCSD
 LSE              8     SCKLSE

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

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

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

 SEP or SSG 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 3-character path names are 'SEP' or 'SST' for the
          symmetric eigenvalue routines and driver routines, and
          'SSG' for the routines for the symmetric 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 'SBD' for both the
          SVD routines and the SVD driver routines.

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

 SEV and SES data files:

 line 1:  'SEV' or 'SES' 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:  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 7 was 2:

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

 lines 9 and following:  Lines specifying matrix types, as for NEP.
          The 3-character path name is 'SEV' to test SGEEV, or
          'SES' to test SGEES.

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

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

 line 1:  'SVX' 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:  TSTERR, LOGICAL

 line 7:  NEWSD, INTEGER

 If line 7 was 2:

 line 8:  INTEGER array, dimension (4)

 lines 9 and following: The first line contains 'SVX' 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+2*N lines, where N is
          its dimension. The first line contains the dimension (a
          single integer). The next N lines contain the matrix, one
          row 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 eigenvalue, the imaginary
          part of the eigenvalue, the reciprocal condition number of
          the eigenvalues, and the reciprocal condition number of the
          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 SSX data is like SVX. The first part is identical to SEV, and the
 second part consists of test matrices with precomputed solutions.

 line 1:  'SSX' 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:  TSTERR, LOGICAL

 line 7:  NEWSD, INTEGER

 If line 7 was 2:

 line 8:  INTEGER array, dimension (4)

 lines 9 and following: The first line contains 'SSX' 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 lines, where N is its
          dimension. The first line contains the dimension N and the
          dimension M of an invariant subspace. 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). The next N
          lines contain the matrix. 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 is
          indicated by a line containing N=0 and M=0. Even if no data
          is to be tested, there must be at least one line containing
          N=0 and M=0.

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

 SGG 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, NS, MAXB, and
          NBCOL.

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

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

 SGS and SGV input files:

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

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

 SXV input files:

 line 1:  'SXV' 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 lines, where N is
          its dimension. The first line contains the dimension (a
          single integer). The next N lines contain the matrix A, one
          row per line. The next 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.

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

 SGX input files:

 line 1:  'SGX' 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 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
          lines contain the matrix A, one row per line.  The next 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.

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

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

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

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

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

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

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

 SBL and SBK input files:

 line 1:  'SBL' in columns 1-3 to test SGEBAL, or 'SBK' in
          columns 1-3 to test SGEBAK.

 The remaining lines consist of specially constructed test cases.

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

 SGL and SGK input files:

 line 1:  'SGL' in columns 1-3 to test SGGBAL, or 'SGK' in
          columns 1-3 to test SGGBAK.

 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+5)+1 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 SGG.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 1041 of file schkee.f.

Here is the call graph for this function:

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

SCHKGG

Purpose:
 SCHKGG  checks the nonsymmetric generalized eigenvalue problem
 routines.
                                T          T        T
 SGGHRD factors A and B as U H V  and U T V , where   means
 transpose, H is hessenberg, T is triangular and U and V are
 orthogonal.
                                 T          T
 SHGEQZ factors H and T as  Q S Z  and Q P Z , where P is upper
 triangular, S is in generalized Schur form (block upper triangular,
 with 1x1 and 2x2 blocks on the diagonal, the 2x2 blocks
 corresponding to complex conjugate pairs of generalized
 eigenvalues), and Q and Z are orthogonal.  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

 STGEVC 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 SCHKGG 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, 15
 tests will be performed.  The first twelve "test ratios" should be
 small -- O(1).  They will be compared with the threshhold THRESH:

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

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

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

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

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

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

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

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

 (9)   max over all left eigenvalue/-vector pairs (beta/alpha,l) of

    | l**H * (beta S - alpha P) | / ( ulp max( |beta S|, |alpha P| ) )

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

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

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

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

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

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

       where the eigenvectors r' are the result of passing Z to
       STGEVC and back transforming (HOWMNY='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 diag( 0, 1,..., N-1 ) (a diagonal
                       matrix with those diagonal entries.)
 (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 is diag( 0, 0, 1, ..., N-3, 0 ) and
                        D2 is diag( 0, N-3, N-4,..., 1, 0, 0 )
           t   t
 (16) U ( J , J ) V     where U and V are random orthogonal 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) =
                        ( 0, 0, 1, ..., N-3, 0 ) and diag(T2) =
                        ( 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) = ( 0, 0, 1, ..., N-3, 0 )
                                  diag(T2) = ( 0, 1, ..., 1, 0, 0 )

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

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

 (25) U ( big*T1, big*T2 ) V      diag(T1) = ( 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,
          SCHKGG 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, SCHKGG
          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 SCHKGG to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error is
          scaled to be O(1), so THRESH should be a reasonably small
          multiple of 1, e.g., 10 or 100.  In particular, it should
          not depend on the precision (single vs. double) or the size
          of the matrix.  It must be at least zero.
[in]TSTDIF
          TSTDIF is LOGICAL
          Specifies whether test ratios 13-15 will be computed and
          compared with THRESH.
          = .FALSE.: Only test ratios 1-12 will be computed and tested.
                     Ratios 13-15 will be set to zero.
          = .TRUE.:  All the test ratios 1-15 will be computed and
                     tested.
[in]THRSHN
          THRSHN is REAL
          Threshhold for reporting eigenvector normalization error.
          If the normalization of any eigenvector differs from 1 by
          more than THRSHN*ulp, then a special error message will be
          printed.  (This is handled separately from the other tests,
          since only a compiler or programming error should cause an
          error message, at least if THRSHN is at least 5--10.)
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL 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 REAL 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 REAL array, dimension (LDA, max(NN))
          The upper Hessenberg matrix computed from A by SGGHRD.
[out]T
          T is REAL array, dimension (LDA, max(NN))
          The upper triangular matrix computed from B by SGGHRD.
[out]S1
          S1 is REAL array, dimension (LDA, max(NN))
          The Schur (block upper triangular) matrix computed from H by
          SHGEQZ when Q and Z are also computed.
[out]S2
          S2 is REAL array, dimension (LDA, max(NN))
          The Schur (block upper triangular) matrix computed from H by
          SHGEQZ when Q and Z are not computed.
[out]P1
          P1 is REAL array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by SHGEQZ
          when Q and Z are also computed.
[out]P2
          P2 is REAL array, dimension (LDA, max(NN))
          The upper triangular matrix computed from T by SHGEQZ
          when Q and Z are not computed.
[out]U
          U is REAL array, dimension (LDU, max(NN))
          The (left) orthogonal matrix computed by SGGHRD.
[in]LDU
          LDU is INTEGER
          The leading dimension of U, V, Q, Z, EVECTL, and EVECTR.  It
          must be at least 1 and at least max( NN ).
[out]V
          V is REAL array, dimension (LDU, max(NN))
          The (right) orthogonal matrix computed by SGGHRD.
[out]Q
          Q is REAL array, dimension (LDU, max(NN))
          The (left) orthogonal matrix computed by SHGEQZ.
[out]Z
          Z is REAL array, dimension (LDU, max(NN))
          The (left) orthogonal matrix computed by SHGEQZ.
[out]ALPHR1
          ALPHR1 is REAL array, dimension (max(NN))
[out]ALPHI1
          ALPHI1 is REAL array, dimension (max(NN))
[out]BETA1
          BETA1 is REAL array, dimension (max(NN))

          The generalized eigenvalues of (A,B) computed by SHGEQZ
          when Q, Z, and the full Schur matrices are computed.
          On exit, ( ALPHR1(k)+ALPHI1(k)*i ) / BETA1(k) is the k-th
          generalized eigenvalue of the matrices in A and B.
[out]ALPHR3
          ALPHR3 is REAL array, dimension (max(NN))
[out]ALPHI3
          ALPHI3 is REAL array, dimension (max(NN))
[out]BETA3
          BETA3 is REAL array, dimension (max(NN))
[out]EVECTL
          EVECTL is REAL array, dimension (LDU, max(NN))
          The (block lower triangular) left eigenvector matrix for
          the matrices in S1 and P1.  (See STGEVC for the format.)
[out]EVECTR
          EVECTR is REAL array, dimension (LDU, max(NN))
          The (block upper triangular) right eigenvector matrix for
          the matrices in S1 and P1.  (See STGEVC for the format.)
[out]WORK
          WORK is REAL array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max( 2 * N**2, 6*N, 1 ), for all N=NN(j).
[out]LLWORK
          LLWORK is LOGICAL array, dimension (max(NN))
[out]RESULT
          RESULT is REAL array, dimension (15)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
          > 0:  A routine returned an error code.  INFO is the
                absolute value of the INFO value returned.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 513 of file schkgg.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkgk ( integer  NIN,
integer  NOUT 
)

SCHKGK

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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkgl ( integer  NIN,
integer  NOUT 
)

SCHKGL

Purpose:
 SCHKGL tests SGGBAL, 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 schkgl.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkhs ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
real  THRESH,
integer  NOUNIT,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( lda, * )  H,
real, dimension( lda, * )  T1,
real, dimension( lda, * )  T2,
real, dimension( ldu, * )  U,
integer  LDU,
real, dimension( ldu, * )  Z,
real, dimension( ldu, * )  UZ,
real, dimension( * )  WR1,
real, dimension( * )  WI1,
real, dimension( * )  WR2,
real, dimension( * )  WI2,
real, dimension( * )  WR3,
real, dimension( * )  WI3,
real, dimension( ldu, * )  EVECTL,
real, dimension( ldu, * )  EVECTR,
real, dimension( ldu, * )  EVECTY,
real, dimension( ldu, * )  EVECTX,
real, dimension( ldu, * )  UU,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
integer  NWORK,
integer, dimension( * )  IWORK,
logical, dimension( * )  SELECT,
real, dimension( 14 )  RESULT,
integer  INFO 
)

SCHKHS

Purpose:
    SCHKHS  checks the nonsymmetric eigenvalue problem routines.

            SGEHRD factors A as  U H U' , where ' means transpose,
            H is hessenberg, and U is an orthogonal matrix.

            SORGHR generates the orthogonal matrix U.

            SORMHR multiplies a matrix by the orthogonal matrix U.

            SHSEQR factors H as  Z T Z' , where Z is orthogonal and
            T is "quasi-triangular", and the eigenvalue vector W.

            STREVC computes the left and right eigenvector matrices
            L and R for T.

            SHSEIN computes the left and right eigenvector matrices
            Y and X for H, using inverse iteration.

    When SCHKHS 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**T | / ( |A| n ulp )

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

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

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

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

    (6)     | I - UZ (UZ)**T | / ( 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 signs.
         (ULP = (first number larger than 1) - 1 )
    (5)  A diagonal matrix with geometrically spaced entries
         1, ..., ULP  and random signs.
    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
         and random signs.

    (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 orthogonal and
         T has evenly spaced entries 1, ..., ULP with random signs
         on the diagonal and random O(1) entries in the upper
         triangle.

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

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

    (12) A matrix of the form  U' T U, where U is orthogonal and
         T has real or complex conjugate paired eigenvalues randomly
         chosen from ( ULP, 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 signs 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 signs 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 signs 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 real or complex conjugate paired
         eigenvalues randomly chosen from ( ULP, 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 (-1,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,
           SCHKHS 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, SCHKHS
           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 SCHKHS to continue the same random number
           sequence.
           Modified.

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

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

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

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

  T2     - REAL array, dimension (LDA,max(NN))
           The Schur matrix computed by SHSEQR 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      - REAL array, dimension (LDU,max(NN))
           The orthogonal matrix computed by SGEHRD.
           Modified.

  Z      - REAL array, dimension (LDU,max(NN))
           The orthogonal matrix computed by SHSEQR.
           Modified.

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

  WR1    - REAL array, dimension (max(NN))
  WI1    - REAL array, dimension (max(NN))
           The real and imaginary parts of the eigenvalues of A,
           as computed when Z is computed.
           On exit, WR1 + WI1*i are the eigenvalues of the matrix in A.
           Modified.

  WR2    - REAL array, dimension (max(NN))
  WI2    - REAL array, dimension (max(NN))
           The real and imaginary parts of the eigenvalues of A,
           as computed when T is computed but not Z.
           On exit, WR2 + WI2*i are the eigenvalues of the matrix in A.
           Modified.

  WR3    - REAL array, dimension (max(NN))
  WI3    - REAL array, dimension (max(NN))
           Like WR1, WI1, these arrays contain the eigenvalues of A,
           but those computed when SHSEQR only computes the
           eigenvalues, i.e., not the Schur vectors and no more of the
           Schur form than is necessary for computing the
           eigenvalues.
           Modified.

  EVECTL - REAL array, dimension (LDU,max(NN))
           The (upper triangular) left eigenvector matrix for the
           matrix in T1.  For complex conjugate pairs, the real part
           is stored in one row and the imaginary part in the next.
           Modified.

  EVECTR - REAL array, dimension (LDU,max(NN))
           The (upper triangular) right eigenvector matrix for the
           matrix in T1.  For complex conjugate pairs, the real part
           is stored in one column and the imaginary part in the next.
           Modified.

  EVECTY - REAL array, dimension (LDU,max(NN))
           The left eigenvector matrix for the
           matrix in H.  For complex conjugate pairs, the real part
           is stored in one row and the imaginary part in the next.
           Modified.

  EVECTX - REAL array, dimension (LDU,max(NN))
           The right eigenvector matrix for the
           matrix in H.  For complex conjugate pairs, the real part
           is stored in one column and the imaginary part in the next.
           Modified.

  UU     - REAL array, dimension (LDU,max(NN))
           Details of the orthogonal matrix computed by SGEHRD.
           Modified.

  TAU    - REAL array, dimension(max(NN))
           Further details of the orthogonal matrix computed by SGEHRD.
           Modified.

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

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

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

  SELECT - LOGICAL array, dimension (max(NN))
           Workspace.
           Modified.

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

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

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

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

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

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

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

Definition at line 414 of file schkhs.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

SCHKSB

Purpose:
 SCHKSB tests the reduction of a symmetric band matrix to tridiagonal
 form, used with the symmetric eigenvalue problem.

 SSBTRD factors a symmetric band matrix A as  U S U' , where ' means
 transpose, S is symmetric tridiagonal, and U is orthogonal.
 SSBTRD can use either just the lower or just the upper triangle
 of A; SCHKSB checks both cases.

 When SCHKSB 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 symmetric banded reduction routine.  For each
 matrix, a number of tests will be performed:

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

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

 (3)     | A - V S V' | / ( |A| n ulp )  computed by SSBTRD 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 orthogonal 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 orthogonal 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 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) Symmetric 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,
          SCHKSB 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,
          SCHKSB 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, SCHKSB
          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 SCHKSB to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL array, dimension
                            (LDA, max(NN))
          Used to hold the matrix whose eigenvalues are to be
          computed.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at least 2 (not 1!)
          and at least max( KK )+1.
[out]SD
          SD is REAL array, dimension (max(NN))
          Used to hold the diagonal of the tridiagonal matrix computed
          by SSBTRD.
[out]SE
          SE is REAL array, dimension (max(NN))
          Used to hold the off-diagonal of the tridiagonal matrix
          computed by SSBTRD.
[out]U
          U is REAL array, dimension (LDU, max(NN))
          Used to hold the orthogonal matrix computed by SSBTRD.
[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 REAL 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]RESULT
          RESULT is REAL array, dimension (4)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.

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

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

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

Definition at line 295 of file schksb.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

SCHKST

Purpose:
 SCHKST  checks the symmetric eigenvalue problem routines.

    SSYTRD factors A as  U S U' , where ' means transpose,
    S is symmetric tridiagonal, and U is orthogonal.
    SSYTRD can use either just the lower or just the upper triangle
    of A; SCHKST 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.

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

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

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

    SSTEQR factors S as  Z D1 Z' , where Z is the orthogonal
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal.  D2 is the matrix of
    eigenvalues computed when Z is not computed.

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

    SPTEQR factors S as  Z4 D4 Z4' , for a
    symmetric positive definite tridiagonal matrix.
    D5 is the matrix of eigenvalues computed when Z is not
    computed.

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

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

    SSTEDC factors S as Z D1 Z' , where Z is the orthogonal
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal ('I' option). It may also
    update an input orthogonal matrix, usually the output
    from SSYTRD/SORGTR or SSPTRD/SOPGTR ('V' option). It may
    also just compute eigenvalues ('N' option).

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

 When SCHKST 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 symmetric eigenroutines.  For each matrix, a number
 of tests will be performed:

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

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

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

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

 (5-8)   Same as 1-4, but for SSPTRD and SOPGTR.

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

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

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

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

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

 For S positive definite,

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

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

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

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

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

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

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

 (20)    | S - Y WA1 Y' | / ( |S| n ulp )  SSTEBZ, SSTEIN

 (21)    | I - Y Y' | / ( n ulp )          SSTEBZ, SSTEIN

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

 (23)    | I - ZZ' | / ( n ulp )           SSTEDC('I')

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 (37)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         SSTEMR('N', 'A') vs. SSTEMR('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 orthogonal 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 orthogonal 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 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) Symmetric 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,
          SCHKST 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, SCHKST
          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 SCHKST to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", computed as
          described above, exceeds THRESH.  Note that the error
          is scaled to be O(1), so THRESH should be a reasonably
          small multiple of 1, e.g., 10 or 100.  In particular,
          it should not depend on the precision (single vs. double)
          or the size of the matrix.  It must be at least zero.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL array 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 REAL array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix A stored in packed format.
[out]SD
          SD is REAL array of
                             dimension( max(NN) )
          The diagonal of the tridiagonal matrix computed by SSYTRD.
          On exit, SD and SE contain the tridiagonal form of the
          matrix in A.
[out]SE
          SE is REAL array of
                             dimension( max(NN) )
          The off-diagonal of the tridiagonal matrix computed by
          SSYTRD.  On exit, SD and SE contain the tridiagonal form of
          the matrix in A.
[out]D1
          D1 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTEQR simlutaneously
          with Z.  On exit, the eigenvalues in D1 correspond with the
          matrix in A.
[out]D2
          D2 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTEQR if Z is not
          computed.  On exit, the eigenvalues in D2 correspond with
          the matrix in A.
[out]D3
          D3 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTERF.  On exit, the
          eigenvalues in D3 correspond with the matrix in A.
[out]D4
          D4 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SPTEQR(V).
          ZPTEQR factors S as  Z4 D4 Z4*
          On exit, the eigenvalues in D4 correspond with the matrix in A.
[out]D5
          D5 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SPTEQR(N)
          when Z is not computed. On exit, the
          eigenvalues in D4 correspond with the matrix in A.
[out]WA1
          WA1 is REAL array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
[out]WA2
          WA2 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Choose random values for IL and IU, and ask for the
          IL-th through IU-th eigenvalues.
[out]WA3
          WA3 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Determine the values VL and VU of the IL-th and IU-th
          eigenvalues and ask for all eigenvalues in this range.
[out]WR
          WR is REAL array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different options.
          as computed by SSTEBZ.
[out]U
          U is REAL array of
                             dimension( LDU, max(NN) ).
          The orthogonal matrix computed by SSYTRD + SORGTR.
[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 REAL array of
                             dimension( LDU, max(NN) ).
          The Housholder vectors computed by SSYTRD 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 SSYTRD, 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 SORGTR, set those entries to
          1 before using them, and then restore them later.)
[out]VP
          VP is REAL array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix V stored in packed format.
[out]TAU
          TAU is REAL array of
                             dimension( max(NN) )
          The Householder factors computed by SSYTRD in reducing A
          to tridiagonal form.
[out]Z
          Z is REAL array of
                             dimension( LDU, max(NN) ).
          The orthogonal matrix of eigenvectors computed by SSTEQR,
          SPTEQR, and SSTEIN.
[out]WORK
          WORK is REAL 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]RESULT
          RESULT is REAL array, dimension (26)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.
           -1: NSIZES < 0
           -2: Some NN(j) < 0
           -3: NTYPES < 0
           -5: THRESH < 0
           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
          -23: LDU < 1 or LDU < NMAX.
          -29: LWORK too small.
          If  SLATMR, SLATMS, SSYTRD, SORGTR, SSTEQR, SSTERF,
              or SORMC2 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 593 of file schkst.f.

593 *
594 * -- LAPACK test routine (version 3.4.0) --
595 * -- LAPACK is a software package provided by Univ. of Tennessee, --
596 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
597 * November 2011
598 *
599 * .. Scalar Arguments ..
600  INTEGER info, lda, ldu, liwork, lwork, nounit, nsizes,
601  $ ntypes
602  REAL thresh
603 * ..
604 * .. Array Arguments ..
605  LOGICAL dotype( * )
606  INTEGER iseed( 4 ), iwork( * ), nn( * )
607  REAL a( lda, * ), ap( * ), d1( * ), d2( * ),
608  $ d3( * ), d4( * ), d5( * ), result( * ),
609  $ sd( * ), se( * ), tau( * ), u( ldu, * ),
610  $ v( ldu, * ), vp( * ), wa1( * ), wa2( * ),
611  $ wa3( * ), work( * ), wr( * ), z( ldu, * )
612 * ..
613 *
614 * =====================================================================
615 *
616 * .. Parameters ..
617  REAL zero, one, two, eight, ten, hun
618  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
619  $ eight = 8.0e0, ten = 10.0e0, hun = 100.0e0 )
620  REAL half
621  parameter( half = one / two )
622  INTEGER maxtyp
623  parameter( maxtyp = 21 )
624  LOGICAL srange
625  parameter( srange = .false. )
626  LOGICAL srel
627  parameter( srel = .false. )
628 * ..
629 * .. Local Scalars ..
630  LOGICAL badnn, tryrac
631  INTEGER i, iinfo, il, imode, itemp, itype, iu, j, jc,
632  $ jr, jsize, jtype, lgn, liwedc, log2ui, lwedc,
633  $ m, m2, m3, mtypes, n, nap, nblock, nerrs,
634  $ nmats, nmax, nsplit, ntest, ntestt
635  REAL abstol, aninv, anorm, cond, ovfl, rtovfl,
636  $ rtunfl, temp1, temp2, temp3, temp4, ulp,
637  $ ulpinv, unfl, vl, vu
638 * ..
639 * .. Local Arrays ..
640  INTEGER idumma( 1 ), ioldsd( 4 ), iseed2( 4 ),
641  $ kmagn( maxtyp ), kmode( maxtyp ),
642  $ ktype( maxtyp )
643  REAL dumma( 1 )
644 * ..
645 * .. External Functions ..
646  INTEGER ilaenv
647  REAL slamch, slarnd, ssxt1
648  EXTERNAL ilaenv, slamch, slarnd, ssxt1
649 * ..
650 * .. External Subroutines ..
651  EXTERNAL scopy, slabad, slacpy, slaset, slasum, slatmr,
655 * ..
656 * .. Intrinsic Functions ..
657  INTRINSIC abs, int, log, max, min, REAL, sqrt
658 * ..
659 * .. Data statements ..
660  DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
661  $ 8, 8, 9, 9, 9, 9, 9, 10 /
662  DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
663  $ 2, 3, 1, 1, 1, 2, 3, 1 /
664  DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
665  $ 0, 0, 4, 3, 1, 4, 4, 3 /
666 * ..
667 * .. Executable Statements ..
668 *
669 * Keep ftnchek happy
670  idumma( 1 ) = 1
671 *
672 * Check for errors
673 *
674  ntestt = 0
675  info = 0
676 *
677 * Important constants
678 *
679  badnn = .false.
680  tryrac = .true.
681  nmax = 1
682  DO 10 j = 1, nsizes
683  nmax = max( nmax, nn( j ) )
684  IF( nn( j ).LT.0 )
685  $