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

Functions

program schkaa
 SCHKAA More...
 
subroutine schkeq (THRESH, NOUT)
 SCHKEQ More...
 
subroutine schkgb (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKGB More...
 
subroutine schkge (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKGE More...
 
subroutine schkgt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKGT More...
 
subroutine schklq (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 SCHKLQ More...
 
subroutine schkpb (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKPB More...
 
subroutine schkpo (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKPO More...
 
subroutine schkpp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKPP More...
 
subroutine schkps (DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
 SCHKPS More...
 
subroutine schkpt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 SCHKPT More...
 
subroutine schkq3 (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
 SCHKQ3 More...
 
subroutine schkql (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 SCHKQL More...
 
subroutine schkqr (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
 SCHKQR More...
 
subroutine schkqrt (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 SCHKQRT More...
 
subroutine schkqrtp (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 SCHKQRTP More...
 
program schkrfp
 SCHKRFP More...
 
subroutine schkrq (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
 SCHKRQ More...
 
subroutine schksp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKSP More...
 
subroutine schksy (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKSY More...
 
subroutine schksy_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKSY_ROOK More...
 
subroutine schktb (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKTB More...
 
subroutine schktp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKTP More...
 
subroutine schktr (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SCHKTR More...
 
subroutine schktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
 SCHKTZ More...
 
subroutine sdrvgb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 SDRVGB More...
 
subroutine sdrvge (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 SDRVGE More...
 
subroutine sdrvgt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SDRVGT More...
 
subroutine sdrvls (DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, COPYB, C, S, COPYS, WORK, IWORK, NOUT)
 SDRVLS More...
 
subroutine sdrvpb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 SDRVPB More...
 
subroutine sdrvpo (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 SDRVPO More...
 
subroutine sdrvpp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 SDRVPP More...
 
subroutine sdrvpt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 SDRVPT More...
 
subroutine sdrvrf1 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
 SDRVRF1 More...
 
subroutine sdrvrf2 (NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
 SDRVRF2 More...
 
subroutine sdrvrf3 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_SLANGE, S_WORK_SGEQRF, TAU)
 SDRVRF3 More...
 
subroutine sdrvrf4 (NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_SLANGE)
 SDRVRF4 More...
 
subroutine sdrvrfp (NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, S_WORK_SPOT03)
 SDRVRFP More...
 
subroutine sdrvsp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SDRVSP More...
 
subroutine sdrvsy (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SDRVSY More...
 
subroutine sebchvxx (THRESH, PATH)
 SEBCHVXX More...
 
subroutine serrge (PATH, NUNIT)
 SERRGE More...
 
subroutine serrgt (PATH, NUNIT)
 SERRGT More...
 
subroutine serrlq (PATH, NUNIT)
 SERRLQ More...
 
subroutine serrls (PATH, NUNIT)
 SERRLS More...
 
subroutine serrpo (PATH, NUNIT)
 SERRPO More...
 
subroutine serrps (PATH, NUNIT)
 SERRPS More...
 
subroutine serrql (PATH, NUNIT)
 SERRQL More...
 
subroutine serrqp (PATH, NUNIT)
 SERRQP More...
 
subroutine serrqr (PATH, NUNIT)
 SERRQR More...
 
subroutine serrqrt (PATH, NUNIT)
 SERRQRT More...
 
subroutine serrqrtp (PATH, NUNIT)
 SERRQRTP More...
 
subroutine serrrfp (NUNIT)
 SERRRFP More...
 
subroutine serrrq (PATH, NUNIT)
 SERRRQ More...
 
subroutine serrsy (PATH, NUNIT)
 SERRSY More...
 
subroutine serrtr (PATH, NUNIT)
 SERRTR More...
 
subroutine serrtz (PATH, NUNIT)
 SERRTZ More...
 
subroutine serrvx (PATH, NUNIT)
 SERRVX More...
 
subroutine sgbt01 (M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
 SGBT01 More...
 
subroutine sgbt02 (TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
 SGBT02 More...
 
subroutine sgbt05 (TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SGBT05 More...
 
subroutine sgelqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 SGELQS More...
 
logical function sgennd (M, N, A, LDA)
 SGENND More...
 
subroutine sgeqls (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 SGEQLS More...
 
subroutine sgeqrs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 SGEQRS More...
 
subroutine sgerqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 SGERQS More...
 
subroutine sget01 (M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
 SGET01 More...
 
subroutine sget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 SGET02 More...
 
subroutine sget03 (N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 SGET03 More...
 
subroutine sget04 (N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
 SGET04 More...
 
real function sget06 (RCOND, RCONDC)
 SGET06 More...
 
subroutine sget07 (TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
 SGET07 More...
 
subroutine sgtt01 (N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
 SGTT01 More...
 
subroutine sgtt02 (TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
 SGTT02 More...
 
subroutine sgtt05 (TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SGTT05 More...
 
subroutine slahilb (N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
 SLAHILB More...
 
subroutine slaord (JOB, N, X, INCX)
 SLAORD More...
 
subroutine slaptm (N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
 SLAPTM More...
 
subroutine slarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 SLARHS More...
 
subroutine slatb4 (PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 SLATB4 More...
 
subroutine slatb5 (PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 SLATB5 More...
 
subroutine slattb (IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, INFO)
 SLATTB More...
 
subroutine slattp (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, INFO)
 SLATTP More...
 
subroutine slattr (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, INFO)
 SLATTR More...
 
subroutine slavsp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 SLAVSP More...
 
subroutine slavsy (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 SLAVSY More...
 
subroutine slavsy_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 SLAVSY_ROOK More...
 
subroutine slqt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SLQT01 More...
 
subroutine slqt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SLQT02 More...
 
subroutine slqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SLQT03 More...
 
subroutine spbt01 (UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 SPBT01 More...
 
subroutine spbt02 (UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 SPBT02 More...
 
subroutine spbt05 (UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SPBT05 More...
 
subroutine spot01 (UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 SPOT01 More...
 
subroutine spot02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 SPOT02 More...
 
subroutine spot03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 SPOT03 More...
 
subroutine spot05 (UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SPOT05 More...
 
subroutine sppt01 (UPLO, N, A, AFAC, RWORK, RESID)
 SPPT01 More...
 
subroutine sppt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 SPPT02 More...
 
subroutine sppt03 (UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
 SPPT03 More...
 
subroutine sppt05 (UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SPPT05 More...
 
subroutine spst01 (UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
 SPST01 More...
 
subroutine sptt01 (N, D, E, DF, EF, WORK, RESID)
 SPTT01 More...
 
subroutine sptt02 (N, NRHS, D, E, X, LDX, B, LDB, RESID)
 SPTT02 More...
 
subroutine sptt05 (N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 SPTT05 More...
 
subroutine sqlt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQLT01 More...
 
subroutine sqlt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQLT02 More...
 
subroutine sqlt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQLT03 More...
 
real function sqpt01 (M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
 SQPT01 More...
 
subroutine sqrt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQRT01 More...
 
subroutine sqrt01p (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQRT01P More...
 
subroutine sqrt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQRT02 More...
 
subroutine sqrt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SQRT03 More...
 
subroutine sqrt04 (M, N, NB, RESULT)
 SQRT04 More...
 
subroutine sqrt05 (M, N, L, NB, RESULT)
 SQRT05 More...
 
real function sqrt11 (M, K, A, LDA, TAU, WORK, LWORK)
 SQRT11 More...
 
real function sqrt12 (M, N, A, LDA, S, WORK, LWORK)
 SQRT12 More...
 
subroutine sqrt13 (SCALE, M, N, A, LDA, NORMA, ISEED)
 SQRT13 More...
 
real function sqrt14 (TRANS, M, N, NRHS, A, LDA, X, LDX, WORK, LWORK)
 SQRT14 More...
 
subroutine sqrt15 (SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, RANK, NORMA, NORMB, ISEED, WORK, LWORK)
 SQRT15 More...
 
subroutine sqrt16 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 SQRT16 More...
 
real function sqrt17 (TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
 SQRT17 More...
 
subroutine srqt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SRQT01 More...
 
subroutine srqt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SRQT02 More...
 
subroutine srqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 SRQT03 More...
 
real function srzt01 (M, N, A, AF, LDA, TAU, WORK, LWORK)
 SRZT01 More...
 
real function srzt02 (M, N, AF, LDA, TAU, WORK, LWORK)
 SRZT02 More...
 
subroutine sspt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 SSPT01 More...
 
subroutine ssyt01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 SSYT01 More...
 
subroutine ssyt01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 SSYT01_ROOK More...
 
subroutine stbt02 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RESID)
 STBT02 More...
 
subroutine stbt03 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 STBT03 More...
 
subroutine stbt05 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 STBT05 More...
 
subroutine stbt06 (RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, WORK, RAT)
 STBT06 More...
 
subroutine stpt01 (UPLO, DIAG, N, AP, AINVP, RCOND, WORK, RESID)
 STPT01 More...
 
subroutine stpt02 (UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RESID)
 STPT02 More...
 
subroutine stpt03 (UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 STPT03 More...
 
subroutine stpt05 (UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 STPT05 More...
 
subroutine stpt06 (RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT)
 STPT06 More...
 
subroutine strt01 (UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, WORK, RESID)
 STRT01 More...
 
subroutine strt02 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RESID)
 STRT02 More...
 
subroutine strt03 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 STRT03 More...
 
subroutine strt05 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 STRT05 More...
 
subroutine strt06 (RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, RAT)
 STRT06 More...
 

Detailed Description

This is the group of real LAPACK TESTING LIN routines.

Function Documentation

program schkaa ( )

SCHKAA

Purpose:
 SCHKAA is the main test program for the REAL LAPACK
 linear equation routines

 The program must be driven by a short data file. The first 15 records
 (not including the first comment  line) specify problem dimensions
 and program options using list-directed input. The remaining lines
 specify the LAPACK test paths and the number of matrix types to use
 in testing.  An annotated example of a data file can be obtained by
 deleting the first 3 characters from the following 40 lines:
 Data file for testing REAL LAPACK linear eqn. routines
 7                      Number of values of M
 0 1 2 3 5 10 16        Values of M (row dimension)
 7                      Number of values of N
 0 1 2 3 5 10 16        Values of N (column dimension)
 1                      Number of values of NRHS
 2                      Values of NRHS (number of right hand sides)
 5                      Number of values of NB
 1 3 3 3 20             Values of NB (the blocksize)
 1 0 5 9 1              Values of NX (crossover point)
 3                      Number of values of RANK
 30 50 90               Values of rank (as a % of N)
 20.0                   Threshold value of test ratio
 T                      Put T to test the LAPACK routines
 T                      Put T to test the driver routines
 T                      Put T to test the error exits
 SGE   11               List types on next line if 0 < NTYPES < 11
 SGB    8               List types on next line if 0 < NTYPES <  8
 SGT   12               List types on next line if 0 < NTYPES < 12
 SPO    9               List types on next line if 0 < NTYPES <  9
 SPS    9               List types on next line if 0 < NTYPES <  9
 SPP    9               List types on next line if 0 < NTYPES <  9
 SPB    8               List types on next line if 0 < NTYPES <  8
 SPT   12               List types on next line if 0 < NTYPES < 12
 SSY   10               List types on next line if 0 < NTYPES < 10
 SSR   10               List types on next line if 0 < NTYPES < 10
 SSP   10               List types on next line if 0 < NTYPES < 10
 STR   18               List types on next line if 0 < NTYPES < 18
 STP   18               List types on next line if 0 < NTYPES < 18
 STB   17               List types on next line if 0 < NTYPES < 17
 SQR    8               List types on next line if 0 < NTYPES <  8
 SRQ    8               List types on next line if 0 < NTYPES <  8
 SLQ    8               List types on next line if 0 < NTYPES <  8
 SQL    8               List types on next line if 0 < NTYPES <  8
 SQP    6               List types on next line if 0 < NTYPES <  6
 STZ    3               List types on next line if 0 < NTYPES <  3
 SLS    6               List types on next line if 0 < NTYPES <  6
 SEQ
 SQT
 SQX
  NMAX    INTEGER
          The maximum allowable value for M and N.

  MAXIN   INTEGER
          The number of different values that can be used for each of
          M, N, NRHS, NB, NX and RANK

  MAXRHS  INTEGER
          The maximum number of right hand sides

  MATMAX  INTEGER
          The maximum number of matrix types to use for testing

  NIN     INTEGER
          The unit number for input

  NOUT    INTEGER
          The unit number for output
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 107 of file schkaa.f.

Here is the call graph for this function:

subroutine schkeq ( real  THRESH,
integer  NOUT 
)

SCHKEQ

Purpose:
 SCHKEQ tests SGEEQU, SGBEQU, SPOEQU, SPPEQU and SPBEQU
Parameters
[in]THRESH
          THRESH is REAL
          Threshold for testing routines. Should be between 2 and 10.
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 56 of file schkeq.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 nout
64  REAL thresh
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  REAL zero, one, ten
71  parameter( zero = 0.0e0, one = 1.0e+0, ten = 1.0e1 )
72  INTEGER nsz, nszb
73  parameter( nsz = 5, nszb = 3*nsz-2 )
74  INTEGER nszp, npow
75  parameter( nszp = ( nsz*( nsz+1 ) ) / 2,
76  $ npow = 2*nsz+1 )
77 * ..
78 * .. Local Scalars ..
79  LOGICAL ok
80  CHARACTER*3 path
81  INTEGER i, info, j, kl, ku, m, n
82  REAL ccond, eps, norm, ratio, rcmax, rcmin, rcond
83 * ..
84 * .. Local Arrays ..
85  REAL a( nsz, nsz ), ab( nszb, nsz ), ap( nszp ),
86  $ c( nsz ), pow( npow ), r( nsz ), reslts( 5 ),
87  $ rpow( npow )
88 * ..
89 * .. External Functions ..
90  REAL slamch
91  EXTERNAL slamch
92 * ..
93 * .. External Subroutines ..
94  EXTERNAL sgbequ, sgeequ, spbequ, spoequ, sppequ
95 * ..
96 * .. Intrinsic Functions ..
97  INTRINSIC abs, max, min
98 * ..
99 * .. Executable Statements ..
100 *
101  path( 1:1 ) = 'Single precision'
102  path( 2:3 ) = 'EQ'
103 *
104  eps = slamch( 'P' )
105  DO 10 i = 1, 5
106  reslts( i ) = zero
107  10 CONTINUE
108  DO 20 i = 1, npow
109  pow( i ) = ten**( i-1 )
110  rpow( i ) = one / pow( i )
111  20 CONTINUE
112 *
113 * Test SGEEQU
114 *
115  DO 80 n = 0, nsz
116  DO 70 m = 0, nsz
117 *
118  DO 40 j = 1, nsz
119  DO 30 i = 1, nsz
120  IF( i.LE.m .AND. j.LE.n ) THEN
121  a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
122  ELSE
123  a( i, j ) = zero
124  END IF
125  30 CONTINUE
126  40 CONTINUE
127 *
128  CALL sgeequ( m, n, a, nsz, r, c, rcond, ccond, norm, info )
129 *
130  IF( info.NE.0 ) THEN
131  reslts( 1 ) = one
132  ELSE
133  IF( n.NE.0 .AND. m.NE.0 ) THEN
134  reslts( 1 ) = max( reslts( 1 ),
135  $ abs( ( rcond-rpow( m ) ) / rpow( m ) ) )
136  reslts( 1 ) = max( reslts( 1 ),
137  $ abs( ( ccond-rpow( n ) ) / rpow( n ) ) )
138  reslts( 1 ) = max( reslts( 1 ),
139  $ abs( ( norm-pow( n+m+1 ) ) / pow( n+m+
140  $ 1 ) ) )
141  DO 50 i = 1, m
142  reslts( 1 ) = max( reslts( 1 ),
143  $ abs( ( r( i )-rpow( i+n+1 ) ) /
144  $ rpow( i+n+1 ) ) )
145  50 CONTINUE
146  DO 60 j = 1, n
147  reslts( 1 ) = max( reslts( 1 ),
148  $ abs( ( c( j )-pow( n-j+1 ) ) /
149  $ pow( n-j+1 ) ) )
150  60 CONTINUE
151  END IF
152  END IF
153 *
154  70 CONTINUE
155  80 CONTINUE
156 *
157 * Test with zero rows and columns
158 *
159  DO 90 j = 1, nsz
160  a( max( nsz-1, 1 ), j ) = zero
161  90 CONTINUE
162  CALL sgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
163  IF( info.NE.max( nsz-1, 1 ) )
164  $ reslts( 1 ) = one
165 *
166  DO 100 j = 1, nsz
167  a( max( nsz-1, 1 ), j ) = one
168  100 CONTINUE
169  DO 110 i = 1, nsz
170  a( i, max( nsz-1, 1 ) ) = zero
171  110 CONTINUE
172  CALL sgeequ( nsz, nsz, a, nsz, r, c, rcond, ccond, norm, info )
173  IF( info.NE.nsz+max( nsz-1, 1 ) )
174  $ reslts( 1 ) = one
175  reslts( 1 ) = reslts( 1 ) / eps
176 *
177 * Test SGBEQU
178 *
179  DO 250 n = 0, nsz
180  DO 240 m = 0, nsz
181  DO 230 kl = 0, max( m-1, 0 )
182  DO 220 ku = 0, max( n-1, 0 )
183 *
184  DO 130 j = 1, nsz
185  DO 120 i = 1, nszb
186  ab( i, j ) = zero
187  120 CONTINUE
188  130 CONTINUE
189  DO 150 j = 1, n
190  DO 140 i = 1, m
191  IF( i.LE.min( m, j+kl ) .AND. i.GE.
192  $ max( 1, j-ku ) .AND. j.LE.n ) THEN
193  ab( ku+1+i-j, j ) = pow( i+j+1 )*
194  $ ( -1 )**( i+j )
195  END IF
196  140 CONTINUE
197  150 CONTINUE
198 *
199  CALL sgbequ( m, n, kl, ku, ab, nszb, r, c, rcond,
200  $ ccond, norm, info )
201 *
202  IF( info.NE.0 ) THEN
203  IF( .NOT.( ( n+kl.LT.m .AND. info.EQ.n+kl+1 ) .OR.
204  $ ( m+ku.LT.n .AND. info.EQ.2*m+ku+1 ) ) ) THEN
205  reslts( 2 ) = one
206  END IF
207  ELSE
208  IF( n.NE.0 .AND. m.NE.0 ) THEN
209 *
210  rcmin = r( 1 )
211  rcmax = r( 1 )
212  DO 160 i = 1, m
213  rcmin = min( rcmin, r( i ) )
214  rcmax = max( rcmax, r( i ) )
215  160 CONTINUE
216  ratio = rcmin / rcmax
217  reslts( 2 ) = max( reslts( 2 ),
218  $ abs( ( rcond-ratio ) / ratio ) )
219 *
220  rcmin = c( 1 )
221  rcmax = c( 1 )
222  DO 170 j = 1, n
223  rcmin = min( rcmin, c( j ) )
224  rcmax = max( rcmax, c( j ) )
225  170 CONTINUE
226  ratio = rcmin / rcmax
227  reslts( 2 ) = max( reslts( 2 ),
228  $ abs( ( ccond-ratio ) / ratio ) )
229 *
230  reslts( 2 ) = max( reslts( 2 ),
231  $ abs( ( norm-pow( n+m+1 ) ) /
232  $ pow( n+m+1 ) ) )
233  DO 190 i = 1, m
234  rcmax = zero
235  DO 180 j = 1, n
236  IF( i.LE.j+kl .AND. i.GE.j-ku ) THEN
237  ratio = abs( r( i )*pow( i+j+1 )*
238  $ c( j ) )
239  rcmax = max( rcmax, ratio )
240  END IF
241  180 CONTINUE
242  reslts( 2 ) = max( reslts( 2 ),
243  $ abs( one-rcmax ) )
244  190 CONTINUE
245 *
246  DO 210 j = 1, n
247  rcmax = zero
248  DO 200 i = 1, m
249  IF( i.LE.j+kl .AND. i.GE.j-ku ) THEN
250  ratio = abs( r( i )*pow( i+j+1 )*
251  $ c( j ) )
252  rcmax = max( rcmax, ratio )
253  END IF
254  200 CONTINUE
255  reslts( 2 ) = max( reslts( 2 ),
256  $ abs( one-rcmax ) )
257  210 CONTINUE
258  END IF
259  END IF
260 *
261  220 CONTINUE
262  230 CONTINUE
263  240 CONTINUE
264  250 CONTINUE
265  reslts( 2 ) = reslts( 2 ) / eps
266 *
267 * Test SPOEQU
268 *
269  DO 290 n = 0, nsz
270 *
271  DO 270 i = 1, nsz
272  DO 260 j = 1, nsz
273  IF( i.LE.n .AND. j.EQ.i ) THEN
274  a( i, j ) = pow( i+j+1 )*( -1 )**( i+j )
275  ELSE
276  a( i, j ) = zero
277  END IF
278  260 CONTINUE
279  270 CONTINUE
280 *
281  CALL spoequ( n, a, nsz, r, rcond, norm, info )
282 *
283  IF( info.NE.0 ) THEN
284  reslts( 3 ) = one
285  ELSE
286  IF( n.NE.0 ) THEN
287  reslts( 3 ) = max( reslts( 3 ),
288  $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
289  reslts( 3 ) = max( reslts( 3 ),
290  $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
291  $ 1 ) ) )
292  DO 280 i = 1, n
293  reslts( 3 ) = max( reslts( 3 ),
294  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
295  $ 1 ) ) )
296  280 CONTINUE
297  END IF
298  END IF
299  290 CONTINUE
300  a( max( nsz-1, 1 ), max( nsz-1, 1 ) ) = -one
301  CALL spoequ( nsz, a, nsz, r, rcond, norm, info )
302  IF( info.NE.max( nsz-1, 1 ) )
303  $ reslts( 3 ) = one
304  reslts( 3 ) = reslts( 3 ) / eps
305 *
306 * Test SPPEQU
307 *
308  DO 360 n = 0, nsz
309 *
310 * Upper triangular packed storage
311 *
312  DO 300 i = 1, ( n*( n+1 ) ) / 2
313  ap( i ) = zero
314  300 CONTINUE
315  DO 310 i = 1, n
316  ap( ( i*( i+1 ) ) / 2 ) = pow( 2*i+1 )
317  310 CONTINUE
318 *
319  CALL sppequ( 'U', n, ap, r, rcond, norm, info )
320 *
321  IF( info.NE.0 ) THEN
322  reslts( 4 ) = one
323  ELSE
324  IF( n.NE.0 ) THEN
325  reslts( 4 ) = max( reslts( 4 ),
326  $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
327  reslts( 4 ) = max( reslts( 4 ),
328  $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
329  $ 1 ) ) )
330  DO 320 i = 1, n
331  reslts( 4 ) = max( reslts( 4 ),
332  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
333  $ 1 ) ) )
334  320 CONTINUE
335  END IF
336  END IF
337 *
338 * Lower triangular packed storage
339 *
340  DO 330 i = 1, ( n*( n+1 ) ) / 2
341  ap( i ) = zero
342  330 CONTINUE
343  j = 1
344  DO 340 i = 1, n
345  ap( j ) = pow( 2*i+1 )
346  j = j + ( n-i+1 )
347  340 CONTINUE
348 *
349  CALL sppequ( 'L', n, ap, r, rcond, norm, info )
350 *
351  IF( info.NE.0 ) THEN
352  reslts( 4 ) = one
353  ELSE
354  IF( n.NE.0 ) THEN
355  reslts( 4 ) = max( reslts( 4 ),
356  $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
357  reslts( 4 ) = max( reslts( 4 ),
358  $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
359  $ 1 ) ) )
360  DO 350 i = 1, n
361  reslts( 4 ) = max( reslts( 4 ),
362  $ abs( ( r( i )-rpow( i+1 ) ) / rpow( i+
363  $ 1 ) ) )
364  350 CONTINUE
365  END IF
366  END IF
367 *
368  360 CONTINUE
369  i = ( nsz*( nsz+1 ) ) / 2 - 2
370  ap( i ) = -one
371  CALL sppequ( 'L', nsz, ap, r, rcond, norm, info )
372  IF( info.NE.max( nsz-1, 1 ) )
373  $ reslts( 4 ) = one
374  reslts( 4 ) = reslts( 4 ) / eps
375 *
376 * Test SPBEQU
377 *
378  DO 460 n = 0, nsz
379  DO 450 kl = 0, max( n-1, 0 )
380 *
381 * Test upper triangular storage
382 *
383  DO 380 j = 1, nsz
384  DO 370 i = 1, nszb
385  ab( i, j ) = zero
386  370 CONTINUE
387  380 CONTINUE
388  DO 390 j = 1, n
389  ab( kl+1, j ) = pow( 2*j+1 )
390  390 CONTINUE
391 *
392  CALL spbequ( 'U', n, kl, ab, nszb, r, rcond, norm, info )
393 *
394  IF( info.NE.0 ) THEN
395  reslts( 5 ) = one
396  ELSE
397  IF( n.NE.0 ) THEN
398  reslts( 5 ) = max( reslts( 5 ),
399  $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
400  reslts( 5 ) = max( reslts( 5 ),
401  $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
402  $ 1 ) ) )
403  DO 400 i = 1, n
404  reslts( 5 ) = max( reslts( 5 ),
405  $ abs( ( r( i )-rpow( i+1 ) ) /
406  $ rpow( i+1 ) ) )
407  400 CONTINUE
408  END IF
409  END IF
410  IF( n.NE.0 ) THEN
411  ab( kl+1, max( n-1, 1 ) ) = -one
412  CALL spbequ( 'U', n, kl, ab, nszb, r, rcond, norm, info )
413  IF( info.NE.max( n-1, 1 ) )
414  $ reslts( 5 ) = one
415  END IF
416 *
417 * Test lower triangular storage
418 *
419  DO 420 j = 1, nsz
420  DO 410 i = 1, nszb
421  ab( i, j ) = zero
422  410 CONTINUE
423  420 CONTINUE
424  DO 430 j = 1, n
425  ab( 1, j ) = pow( 2*j+1 )
426  430 CONTINUE
427 *
428  CALL spbequ( 'L', n, kl, ab, nszb, r, rcond, norm, info )
429 *
430  IF( info.NE.0 ) THEN
431  reslts( 5 ) = one
432  ELSE
433  IF( n.NE.0 ) THEN
434  reslts( 5 ) = max( reslts( 5 ),
435  $ abs( ( rcond-rpow( n ) ) / rpow( n ) ) )
436  reslts( 5 ) = max( reslts( 5 ),
437  $ abs( ( norm-pow( 2*n+1 ) ) / pow( 2*n+
438  $ 1 ) ) )
439  DO 440 i = 1, n
440  reslts( 5 ) = max( reslts( 5 ),
441  $ abs( ( r( i )-rpow( i+1 ) ) /
442  $ rpow( i+1 ) ) )
443  440 CONTINUE
444  END IF
445  END IF
446  IF( n.NE.0 ) THEN
447  ab( 1, max( n-1, 1 ) ) = -one
448  CALL spbequ( 'L', n, kl, ab, nszb, r, rcond, norm, info )
449  IF( info.NE.max( n-1, 1 ) )
450  $ reslts( 5 ) = one
451  END IF
452  450 CONTINUE
453  460 CONTINUE
454  reslts( 5 ) = reslts( 5 ) / eps
455  ok = ( reslts( 1 ).LE.thresh ) .AND.
456  $ ( reslts( 2 ).LE.thresh ) .AND.
457  $ ( reslts( 3 ).LE.thresh ) .AND.
458  $ ( reslts( 4 ).LE.thresh ) .AND. ( reslts( 5 ).LE.thresh )
459  WRITE( nout, fmt = * )
460  IF( ok ) THEN
461  WRITE( nout, fmt = 9999 )path
462  ELSE
463  IF( reslts( 1 ).GT.thresh )
464  $ WRITE( nout, fmt = 9998 )reslts( 1 ), thresh
465  IF( reslts( 2 ).GT.thresh )
466  $ WRITE( nout, fmt = 9997 )reslts( 2 ), thresh
467  IF( reslts( 3 ).GT.thresh )
468  $ WRITE( nout, fmt = 9996 )reslts( 3 ), thresh
469  IF( reslts( 4 ).GT.thresh )
470  $ WRITE( nout, fmt = 9995 )reslts( 4 ), thresh
471  IF( reslts( 5 ).GT.thresh )
472  $ WRITE( nout, fmt = 9994 )reslts( 5 ), thresh
473  END IF
474  9999 FORMAT( 1x, 'All tests for ', a3,
475  $ ' routines passed the threshold' )
476  9998 FORMAT( ' SGEEQU failed test with value ', e10.3, ' exceeding',
477  $ ' threshold ', e10.3 )
478  9997 FORMAT( ' SGBEQU failed test with value ', e10.3, ' exceeding',
479  $ ' threshold ', e10.3 )
480  9996 FORMAT( ' SPOEQU failed test with value ', e10.3, ' exceeding',
481  $ ' threshold ', e10.3 )
482  9995 FORMAT( ' SPPEQU failed test with value ', e10.3, ' exceeding',
483  $ ' threshold ', e10.3 )
484  9994 FORMAT( ' SPBEQU failed test with value ', e10.3, ' exceeding',
485  $ ' threshold ', e10.3 )
486  RETURN
487 *
488 * End of SCHKEQ
489 *
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
Definition: spbequ.f:131
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
Definition: sgeequ.f:141
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
Definition: spoequ.f:114
subroutine sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
Definition: sgbequ.f:155
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
Definition: sppequ.f:118

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkgb ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
real, dimension( * )  A,
integer  LA,
real, dimension( * )  AFAC,
integer  LAFAC,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKGB

Purpose:
 SCHKGB tests SGBTRF, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is REAL array, dimension (LA)
[in]LA
          LA is INTEGER
          The length of the array A.  LA >= (KLMAX+KUMAX+1)*NMAX
          where KLMAX is the largest entry in the local array KLVAL,
                KUMAX is the largest entry in the local array KUVAL and
                NMAX is the largest entry in the input array NVAL.
[out]AFAC
          AFAC is REAL array, dimension (LAFAC)
[in]LAFAC
          LAFAC is INTEGER
          The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
          where KLMAX is the largest entry in the local array KLVAL,
                KUMAX is the largest entry in the local array KUVAL and
                NMAX is the largest entry in the input array NVAL.
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX,NMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 193 of file schkgb.f.

193 *
194 * -- LAPACK test routine (version 3.4.0) --
195 * -- LAPACK is a software package provided by Univ. of Tennessee, --
196 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
197 * November 2011
198 *
199 * .. Scalar Arguments ..
200  LOGICAL tsterr
201  INTEGER la, lafac, nm, nn, nnb, nns, nout
202  REAL thresh
203 * ..
204 * .. Array Arguments ..
205  LOGICAL dotype( * )
206  INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
207  $ nval( * )
208  REAL a( * ), afac( * ), b( * ), rwork( * ),
209  $ work( * ), x( * ), xact( * )
210 * ..
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215  REAL one, zero
216  parameter( one = 1.0e+0, zero = 0.0e+0 )
217  INTEGER ntypes, ntests
218  parameter( ntypes = 8, ntests = 7 )
219  INTEGER nbw, ntran
220  parameter( nbw = 4, ntran = 3 )
221 * ..
222 * .. Local Scalars ..
223  LOGICAL trfcon, zerot
224  CHARACTER dist, norm, trans, TYPE, xtype
225  CHARACTER*3 path
226  INTEGER i, i1, i2, ikl, iku, im, imat, in, inb, info,
227  $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
228  $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
229  $ nimat, nkl, nku, nrhs, nrun
230  REAL ainvnm, anorm, anormi, anormo, cndnum, rcond,
231  $ rcondc, rcondi, rcondo
232 * ..
233 * .. Local Arrays ..
234  CHARACTER transs( ntran )
235  INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
236  $ kuval( nbw )
237  REAL result( ntests )
238 * ..
239 * .. External Functions ..
240  REAL sget06, slangb, slange
241  EXTERNAL sget06, slangb, slange
242 * ..
243 * .. External Subroutines ..
244  EXTERNAL alaerh, alahd, alasum, scopy, serrge, sgbcon,
247  $ xlaenv
248 * ..
249 * .. Intrinsic Functions ..
250  INTRINSIC max, min
251 * ..
252 * .. Scalars in Common ..
253  LOGICAL lerr, ok
254  CHARACTER*32 srnamt
255  INTEGER infot, nunit
256 * ..
257 * .. Common blocks ..
258  COMMON / infoc / infot, nunit, ok, lerr
259  COMMON / srnamc / srnamt
260 * ..
261 * .. Data statements ..
262  DATA iseedy / 1988, 1989, 1990, 1991 / ,
263  $ transs / 'N', 'T', 'C' /
264 * ..
265 * .. Executable Statements ..
266 *
267 * Initialize constants and the random number seed.
268 *
269  path( 1: 1 ) = 'Single precision'
270  path( 2: 3 ) = 'GB'
271  nrun = 0
272  nfail = 0
273  nerrs = 0
274  DO 10 i = 1, 4
275  iseed( i ) = iseedy( i )
276  10 CONTINUE
277 *
278 * Test the error exits
279 *
280  IF( tsterr )
281  $ CALL serrge( path, nout )
282  infot = 0
283  CALL xlaenv( 2, 2 )
284 *
285 * Initialize the first value for the lower and upper bandwidths.
286 *
287  klval( 1 ) = 0
288  kuval( 1 ) = 0
289 *
290 * Do for each value of M in MVAL
291 *
292  DO 160 im = 1, nm
293  m = mval( im )
294 *
295 * Set values to use for the lower bandwidth.
296 *
297  klval( 2 ) = m + ( m+1 ) / 4
298 *
299 * KLVAL( 2 ) = MAX( M-1, 0 )
300 *
301  klval( 3 ) = ( 3*m-1 ) / 4
302  klval( 4 ) = ( m+1 ) / 4
303 *
304 * Do for each value of N in NVAL
305 *
306  DO 150 in = 1, nn
307  n = nval( in )
308  xtype = 'N'
309 *
310 * Set values to use for the upper bandwidth.
311 *
312  kuval( 2 ) = n + ( n+1 ) / 4
313 *
314 * KUVAL( 2 ) = MAX( N-1, 0 )
315 *
316  kuval( 3 ) = ( 3*n-1 ) / 4
317  kuval( 4 ) = ( n+1 ) / 4
318 *
319 * Set limits on the number of loop iterations.
320 *
321  nkl = min( m+1, 4 )
322  IF( n.EQ.0 )
323  $ nkl = 2
324  nku = min( n+1, 4 )
325  IF( m.EQ.0 )
326  $ nku = 2
327  nimat = ntypes
328  IF( m.LE.0 .OR. n.LE.0 )
329  $ nimat = 1
330 *
331  DO 140 ikl = 1, nkl
332 *
333 * Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This
334 * order makes it easier to skip redundant values for small
335 * values of M.
336 *
337  kl = klval( ikl )
338  DO 130 iku = 1, nku
339 *
340 * Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This
341 * order makes it easier to skip redundant values for
342 * small values of N.
343 *
344  ku = kuval( iku )
345 *
346 * Check that A and AFAC are big enough to generate this
347 * matrix.
348 *
349  lda = kl + ku + 1
350  ldafac = 2*kl + ku + 1
351  IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac ) THEN
352  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
353  $ CALL alahd( nout, path )
354  IF( n*( kl+ku+1 ).GT.la ) THEN
355  WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
356  $ n*( kl+ku+1 )
357  nerrs = nerrs + 1
358  END IF
359  IF( n*( 2*kl+ku+1 ).GT.lafac ) THEN
360  WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
361  $ n*( 2*kl+ku+1 )
362  nerrs = nerrs + 1
363  END IF
364  GO TO 130
365  END IF
366 *
367  DO 120 imat = 1, nimat
368 *
369 * Do the tests only if DOTYPE( IMAT ) is true.
370 *
371  IF( .NOT.dotype( imat ) )
372  $ GO TO 120
373 *
374 * Skip types 2, 3, or 4 if the matrix size is too
375 * small.
376 *
377  zerot = imat.GE.2 .AND. imat.LE.4
378  IF( zerot .AND. n.LT.imat-1 )
379  $ GO TO 120
380 *
381  IF( .NOT.zerot .OR. .NOT.dotype( 1 ) ) THEN
382 *
383 * Set up parameters with SLATB4 and generate a
384 * test matrix with SLATMS.
385 *
386  CALL slatb4( path, imat, m, n, TYPE, kl, ku,
387  $ anorm, mode, cndnum, dist )
388 *
389  koff = max( 1, ku+2-n )
390  DO 20 i = 1, koff - 1
391  a( i ) = zero
392  20 CONTINUE
393  srnamt = 'SLATMS'
394  CALL slatms( m, n, dist, iseed, TYPE, rwork,
395  $ mode, cndnum, anorm, kl, ku, 'Z',
396  $ a( koff ), lda, work, info )
397 *
398 * Check the error code from SLATMS.
399 *
400  IF( info.NE.0 ) THEN
401  CALL alaerh( path, 'SLATMS', info, 0, ' ', m,
402  $ n, kl, ku, -1, imat, nfail,
403  $ nerrs, nout )
404  GO TO 120
405  END IF
406  ELSE IF( izero.GT.0 ) THEN
407 *
408 * Use the same matrix for types 3 and 4 as for
409 * type 2 by copying back the zeroed out column.
410 *
411  CALL scopy( i2-i1+1, b, 1, a( ioff+i1 ), 1 )
412  END IF
413 *
414 * For types 2, 3, and 4, zero one or more columns of
415 * the matrix to test that INFO is returned correctly.
416 *
417  izero = 0
418  IF( zerot ) THEN
419  IF( imat.EQ.2 ) THEN
420  izero = 1
421  ELSE IF( imat.EQ.3 ) THEN
422  izero = min( m, n )
423  ELSE
424  izero = min( m, n ) / 2 + 1
425  END IF
426  ioff = ( izero-1 )*lda
427  IF( imat.LT.4 ) THEN
428 *
429 * Store the column to be zeroed out in B.
430 *
431  i1 = max( 1, ku+2-izero )
432  i2 = min( kl+ku+1, ku+1+( m-izero ) )
433  CALL scopy( i2-i1+1, a( ioff+i1 ), 1, b, 1 )
434 *
435  DO 30 i = i1, i2
436  a( ioff+i ) = zero
437  30 CONTINUE
438  ELSE
439  DO 50 j = izero, n
440  DO 40 i = max( 1, ku+2-j ),
441  $ min( kl+ku+1, ku+1+( m-j ) )
442  a( ioff+i ) = zero
443  40 CONTINUE
444  ioff = ioff + lda
445  50 CONTINUE
446  END IF
447  END IF
448 *
449 * These lines, if used in place of the calls in the
450 * loop over INB, cause the code to bomb on a Sun
451 * SPARCstation.
452 *
453 * ANORMO = SLANGB( 'O', N, KL, KU, A, LDA, RWORK )
454 * ANORMI = SLANGB( 'I', N, KL, KU, A, LDA, RWORK )
455 *
456 * Do for each blocksize in NBVAL
457 *
458  DO 110 inb = 1, nnb
459  nb = nbval( inb )
460  CALL xlaenv( 1, nb )
461 *
462 * Compute the LU factorization of the band matrix.
463 *
464  IF( m.GT.0 .AND. n.GT.0 )
465  $ CALL slacpy( 'Full', kl+ku+1, n, a, lda,
466  $ afac( kl+1 ), ldafac )
467  srnamt = 'SGBTRF'
468  CALL sgbtrf( m, n, kl, ku, afac, ldafac, iwork,
469  $ info )
470 *
471 * Check error code from SGBTRF.
472 *
473  IF( info.NE.izero )
474  $ CALL alaerh( path, 'SGBTRF', info, izero,
475  $ ' ', m, n, kl, ku, nb, imat,
476  $ nfail, nerrs, nout )
477  trfcon = .false.
478 *
479 *+ TEST 1
480 * Reconstruct matrix from factors and compute
481 * residual.
482 *
483  CALL sgbt01( m, n, kl, ku, a, lda, afac, ldafac,
484  $ iwork, work, result( 1 ) )
485 *
486 * Print information about the tests so far that
487 * did not pass the threshold.
488 *
489  IF( result( 1 ).GE.thresh ) THEN
490  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491  $ CALL alahd( nout, path )
492  WRITE( nout, fmt = 9997 )m, n, kl, ku, nb,
493  $ imat, 1, result( 1 )
494  nfail = nfail + 1
495  END IF
496  nrun = nrun + 1
497 *
498 * Skip the remaining tests if this is not the
499 * first block size or if M .ne. N.
500 *
501  IF( inb.GT.1 .OR. m.NE.n )
502  $ GO TO 110
503 *
504  anormo = slangb( 'O', n, kl, ku, a, lda, rwork )
505  anormi = slangb( 'I', n, kl, ku, a, lda, rwork )
506 *
507  IF( info.EQ.0 ) THEN
508 *
509 * Form the inverse of A so we can get a good
510 * estimate of CNDNUM = norm(A) * norm(inv(A)).
511 *
512  ldb = max( 1, n )
513  CALL slaset( 'Full', n, n, zero, one, work,
514  $ ldb )
515  srnamt = 'SGBTRS'
516  CALL sgbtrs( 'No transpose', n, kl, ku, n,
517  $ afac, ldafac, iwork, work, ldb,
518  $ info )
519 *
520 * Compute the 1-norm condition number of A.
521 *
522  ainvnm = slange( 'O', n, n, work, ldb,
523  $ rwork )
524  IF( anormo.LE.zero .OR. ainvnm.LE.zero ) THEN
525  rcondo = one
526  ELSE
527  rcondo = ( one / anormo ) / ainvnm
528  END IF
529 *
530 * Compute the infinity-norm condition number of
531 * A.
532 *
533  ainvnm = slange( 'I', n, n, work, ldb,
534  $ rwork )
535  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
536  rcondi = one
537  ELSE
538  rcondi = ( one / anormi ) / ainvnm
539  END IF
540  ELSE
541 *
542 * Do only the condition estimate if INFO.NE.0.
543 *
544  trfcon = .true.
545  rcondo = zero
546  rcondi = zero
547  END IF
548 *
549 * Skip the solve tests if the matrix is singular.
550 *
551  IF( trfcon )
552  $ GO TO 90
553 *
554  DO 80 irhs = 1, nns
555  nrhs = nsval( irhs )
556  xtype = 'N'
557 *
558  DO 70 itran = 1, ntran
559  trans = transs( itran )
560  IF( itran.EQ.1 ) THEN
561  rcondc = rcondo
562  norm = 'O'
563  ELSE
564  rcondc = rcondi
565  norm = 'I'
566  END IF
567 *
568 *+ TEST 2:
569 * Solve and compute residual for A * X = B.
570 *
571  srnamt = 'SLARHS'
572  CALL slarhs( path, xtype, ' ', trans, n,
573  $ n, kl, ku, nrhs, a, lda,
574  $ xact, ldb, b, ldb, iseed,
575  $ info )
576  xtype = 'C'
577  CALL slacpy( 'Full', n, nrhs, b, ldb, x,
578  $ ldb )
579 *
580  srnamt = 'SGBTRS'
581  CALL sgbtrs( trans, n, kl, ku, nrhs, afac,
582  $ ldafac, iwork, x, ldb, info )
583 *
584 * Check error code from SGBTRS.
585 *
586  IF( info.NE.0 )
587  $ CALL alaerh( path, 'SGBTRS', info, 0,
588  $ trans, n, n, kl, ku, -1,
589  $ imat, nfail, nerrs, nout )
590 *
591  CALL slacpy( 'Full', n, nrhs, b, ldb,
592  $ work, ldb )
593  CALL sgbt02( trans, m, n, kl, ku, nrhs, a,
594  $ lda, x, ldb, work, ldb,
595  $ result( 2 ) )
596 *
597 *+ TEST 3:
598 * Check solution from generated exact
599 * solution.
600 *
601  CALL sget04( n, nrhs, x, ldb, xact, ldb,
602  $ rcondc, result( 3 ) )
603 *
604 *+ TESTS 4, 5, 6:
605 * Use iterative refinement to improve the
606 * solution.
607 *
608  srnamt = 'SGBRFS'
609  CALL sgbrfs( trans, n, kl, ku, nrhs, a,
610  $ lda, afac, ldafac, iwork, b,
611  $ ldb, x, ldb, rwork,
612  $ rwork( nrhs+1 ), work,
613  $ iwork( n+1 ), info )
614 *
615 * Check error code from SGBRFS.
616 *
617  IF( info.NE.0 )
618  $ CALL alaerh( path, 'SGBRFS', info, 0,
619  $ trans, n, n, kl, ku, nrhs,
620  $ imat, nfail, nerrs, nout )
621 *
622  CALL sget04( n, nrhs, x, ldb, xact, ldb,
623  $ rcondc, result( 4 ) )
624  CALL sgbt05( trans, n, kl, ku, nrhs, a,
625  $ lda, b, ldb, x, ldb, xact,
626  $ ldb, rwork, rwork( nrhs+1 ),
627  $ result( 5 ) )
628  DO 60 k = 2, 6
629  IF( result( k ).GE.thresh ) THEN
630  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
631  $ CALL alahd( nout, path )
632  WRITE( nout, fmt = 9996 )trans, n,
633  $ kl, ku, nrhs, imat, k,
634  $ result( k )
635  nfail = nfail + 1
636  END IF
637  60 CONTINUE
638  nrun = nrun + 5
639  70 CONTINUE
640  80 CONTINUE
641 *
642 *+ TEST 7:
643 * Get an estimate of RCOND = 1/CNDNUM.
644 *
645  90 CONTINUE
646  DO 100 itran = 1, 2
647  IF( itran.EQ.1 ) THEN
648  anorm = anormo
649  rcondc = rcondo
650  norm = 'O'
651  ELSE
652  anorm = anormi
653  rcondc = rcondi
654  norm = 'I'
655  END IF
656  srnamt = 'SGBCON'
657  CALL sgbcon( norm, n, kl, ku, afac, ldafac,
658  $ iwork, anorm, rcond, work,
659  $ iwork( n+1 ), info )
660 *
661 * Check error code from SGBCON.
662 *
663  IF( info.NE.0 )
664  $ CALL alaerh( path, 'SGBCON', info, 0,
665  $ norm, n, n, kl, ku, -1, imat,
666  $ nfail, nerrs, nout )
667 *
668  result( 7 ) = sget06( rcond, rcondc )
669 *
670 * Print information about the tests that did
671 * not pass the threshold.
672 *
673  IF( result( 7 ).GE.thresh ) THEN
674  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
675  $ CALL alahd( nout, path )
676  WRITE( nout, fmt = 9995 )norm, n, kl, ku,
677  $ imat, 7, result( 7 )
678  nfail = nfail + 1
679  END IF
680  nrun = nrun + 1
681  100 CONTINUE
682 *
683  110 CONTINUE
684  120 CONTINUE
685  130 CONTINUE
686  140 CONTINUE
687  150 CONTINUE
688  160 CONTINUE
689 *
690 * Print a summary of the results.
691 *
692  CALL alasum( path, nout, nfail, nrun, nerrs )
693 *
694  9999 FORMAT( ' *** In SCHKGB, LA=', i5, ' is too small for M=', i5,
695  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
696  $ / ' ==> Increase LA to at least ', i5 )
697  9998 FORMAT( ' *** In SCHKGB, LAFAC=', i5, ' is too small for M=', i5,
698  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
699  $ / ' ==> Increase LAFAC to at least ', i5 )
700  9997 FORMAT( ' M =', i5, ', N =', i5, ', KL=', i5, ', KU=', i5,
701  $ ', NB =', i4, ', type ', i1, ', test(', i1, ')=', g12.5 )
702  9996 FORMAT( ' TRANS=''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
703  $ ', NRHS=', i3, ', type ', i1, ', test(', i1, ')=', g12.5 )
704  9995 FORMAT( ' NORM =''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
705  $ ',', 10x, ' type ', i1, ', test(', i1, ')=', g12.5 )
706 *
707  RETURN
708 *
709 * End of SCHKGB
710 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
SGBT01
Definition: sgbt01.f:128
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
Definition: sgbtrf.f:146
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine sgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SGBT05
Definition: sgbt05.f:178
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
Definition: sgbtrs.f:140
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine serrge(PATH, NUNIT)
SERRGE
Definition: serrge.f:57
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
Definition: sgbrfs.f:207
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 sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
Definition: sgbcon.f:148
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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
real function slangb(NORM, N, KL, KU, AB, LDAB, WORK)
SLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slangb.f:126
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 sgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
SGBT02
Definition: sgbt02.f:141

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkge ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKGE

Purpose:
 SCHKGE tests SGETRF, -TRI, -TRS, -RFS, and -CON.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]AINV
          AINV is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(2*NMAX,2*NSMAX+NWORK))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 187 of file schkge.f.

187 *
188 * -- LAPACK test routine (version 3.4.1) --
189 * -- LAPACK is a software package provided by Univ. of Tennessee, --
190 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191 * April 2012
192 *
193 * .. Scalar Arguments ..
194  LOGICAL tsterr
195  INTEGER nm, nmax, nn, nnb, nns, nout
196  REAL thresh
197 * ..
198 * .. Array Arguments ..
199  LOGICAL dotype( * )
200  INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
201  $ nval( * )
202  REAL a( * ), afac( * ), ainv( * ), b( * ),
203  $ rwork( * ), work( * ), x( * ), xact( * )
204 * ..
205 *
206 * =====================================================================
207 *
208 * .. Parameters ..
209  REAL one, zero
210  parameter( one = 1.0e+0, zero = 0.0e+0 )
211  INTEGER ntypes
212  parameter( ntypes = 11 )
213  INTEGER ntests
214  parameter( ntests = 8 )
215  INTEGER ntran
216  parameter( ntran = 3 )
217 * ..
218 * .. Local Scalars ..
219  LOGICAL trfcon, zerot
220  CHARACTER dist, norm, trans, TYPE, xtype
221  CHARACTER*3 path
222  INTEGER i, im, imat, in, inb, info, ioff, irhs, itran,
223  $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
224  $ nerrs, nfail, nimat, nrhs, nrun, nt
225  REAL ainvnm, anorm, anormi, anormo, cndnum, dummy,
226  $ rcond, rcondc, rcondi, rcondo
227 * ..
228 * .. Local Arrays ..
229  CHARACTER transs( ntran )
230  INTEGER iseed( 4 ), iseedy( 4 )
231  REAL result( ntests )
232 * ..
233 * .. External Functions ..
234  REAL sget06, slange
235  EXTERNAL sget06, slange
236 * ..
237 * .. External Subroutines ..
238  EXTERNAL alaerh, alahd, alasum, serrge, sgecon, sgerfs,
241  $ slatms, xlaenv
242 * ..
243 * .. Intrinsic Functions ..
244  INTRINSIC max, min
245 * ..
246 * .. Scalars in Common ..
247  LOGICAL lerr, ok
248  CHARACTER*32 srnamt
249  INTEGER infot, nunit
250 * ..
251 * .. Common blocks ..
252  COMMON / infoc / infot, nunit, ok, lerr
253  COMMON / srnamc / srnamt
254 * ..
255 * .. Data statements ..
256  DATA iseedy / 1988, 1989, 1990, 1991 / ,
257  $ transs / 'N', 'T', 'C' /
258 * ..
259 * .. Executable Statements ..
260 *
261 * Initialize constants and the random number seed.
262 *
263  path( 1: 1 ) = 'Single precision'
264  path( 2: 3 ) = 'GE'
265  nrun = 0
266  nfail = 0
267  nerrs = 0
268  DO 10 i = 1, 4
269  iseed( i ) = iseedy( i )
270  10 CONTINUE
271 *
272 * Test the error exits
273 *
274  CALL xlaenv( 1, 1 )
275  IF( tsterr )
276  $ CALL serrge( path, nout )
277  infot = 0
278  CALL xlaenv( 2, 2 )
279 *
280 * Do for each value of M in MVAL
281 *
282  DO 120 im = 1, nm
283  m = mval( im )
284  lda = max( 1, m )
285 *
286 * Do for each value of N in NVAL
287 *
288  DO 110 in = 1, nn
289  n = nval( in )
290  xtype = 'N'
291  nimat = ntypes
292  IF( m.LE.0 .OR. n.LE.0 )
293  $ nimat = 1
294 *
295  DO 100 imat = 1, nimat
296 *
297 * Do the tests only if DOTYPE( IMAT ) is true.
298 *
299  IF( .NOT.dotype( imat ) )
300  $ GO TO 100
301 *
302 * Skip types 5, 6, or 7 if the matrix size is too small.
303 *
304  zerot = imat.GE.5 .AND. imat.LE.7
305  IF( zerot .AND. n.LT.imat-4 )
306  $ GO TO 100
307 *
308 * Set up parameters with SLATB4 and generate a test matrix
309 * with SLATMS.
310 *
311  CALL slatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
312  $ cndnum, dist )
313 *
314  srnamt = 'SLATMS'
315  CALL slatms( m, n, dist, iseed, TYPE, rwork, mode,
316  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
317  $ work, info )
318 *
319 * Check error code from SLATMS.
320 *
321  IF( info.NE.0 ) THEN
322  CALL alaerh( path, 'SLATMS', info, 0, ' ', m, n, -1,
323  $ -1, -1, imat, nfail, nerrs, nout )
324  GO TO 100
325  END IF
326 *
327 * For types 5-7, zero one or more columns of the matrix to
328 * test that INFO is returned correctly.
329 *
330  IF( zerot ) THEN
331  IF( imat.EQ.5 ) THEN
332  izero = 1
333  ELSE IF( imat.EQ.6 ) THEN
334  izero = min( m, n )
335  ELSE
336  izero = min( m, n ) / 2 + 1
337  END IF
338  ioff = ( izero-1 )*lda
339  IF( imat.LT.7 ) THEN
340  DO 20 i = 1, m
341  a( ioff+i ) = zero
342  20 CONTINUE
343  ELSE
344  CALL slaset( 'Full', m, n-izero+1, zero, zero,
345  $ a( ioff+1 ), lda )
346  END IF
347  ELSE
348  izero = 0
349  END IF
350 *
351 * These lines, if used in place of the calls in the DO 60
352 * loop, cause the code to bomb on a Sun SPARCstation.
353 *
354 * ANORMO = SLANGE( 'O', M, N, A, LDA, RWORK )
355 * ANORMI = SLANGE( 'I', M, N, A, LDA, RWORK )
356 *
357 * Do for each blocksize in NBVAL
358 *
359  DO 90 inb = 1, nnb
360  nb = nbval( inb )
361  CALL xlaenv( 1, nb )
362 *
363 * Compute the LU factorization of the matrix.
364 *
365  CALL slacpy( 'Full', m, n, a, lda, afac, lda )
366  srnamt = 'SGETRF'
367  CALL sgetrf( m, n, afac, lda, iwork, info )
368 *
369 * Check error code from SGETRF.
370 *
371  IF( info.NE.izero )
372  $ CALL alaerh( path, 'SGETRF', info, izero, ' ', m,
373  $ n, -1, -1, nb, imat, nfail, nerrs,
374  $ nout )
375  trfcon = .false.
376 *
377 *+ TEST 1
378 * Reconstruct matrix from factors and compute residual.
379 *
380  CALL slacpy( 'Full', m, n, afac, lda, ainv, lda )
381  CALL sget01( m, n, a, lda, ainv, lda, iwork, rwork,
382  $ result( 1 ) )
383  nt = 1
384 *
385 *+ TEST 2
386 * Form the inverse if the factorization was successful
387 * and compute the residual.
388 *
389  IF( m.EQ.n .AND. info.EQ.0 ) THEN
390  CALL slacpy( 'Full', n, n, afac, lda, ainv, lda )
391  srnamt = 'SGETRI'
392  nrhs = nsval( 1 )
393  lwork = nmax*max( 3, nrhs )
394  CALL sgetri( n, ainv, lda, iwork, work, lwork,
395  $ info )
396 *
397 * Check error code from SGETRI.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'SGETRI', info, 0, ' ', n, n,
401  $ -1, -1, nb, imat, nfail, nerrs,
402  $ nout )
403 *
404 * Compute the residual for the matrix times its
405 * inverse. Also compute the 1-norm condition number
406 * of A.
407 *
408  CALL sget03( n, a, lda, ainv, lda, work, lda,
409  $ rwork, rcondo, result( 2 ) )
410  anormo = slange( 'O', m, n, a, lda, rwork )
411 *
412 * Compute the infinity-norm condition number of A.
413 *
414  anormi = slange( 'I', m, n, a, lda, rwork )
415  ainvnm = slange( 'I', n, n, ainv, lda, rwork )
416  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
417  rcondi = one
418  ELSE
419  rcondi = ( one / anormi ) / ainvnm
420  END IF
421  nt = 2
422  ELSE
423 *
424 * Do only the condition estimate if INFO > 0.
425 *
426  trfcon = .true.
427  anormo = slange( 'O', m, n, a, lda, rwork )
428  anormi = slange( 'I', m, n, a, lda, rwork )
429  rcondo = zero
430  rcondi = zero
431  END IF
432 *
433 * Print information about the tests so far that did not
434 * pass the threshold.
435 *
436  DO 30 k = 1, nt
437  IF( result( k ).GE.thresh ) THEN
438  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
439  $ CALL alahd( nout, path )
440  WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
441  $ result( k )
442  nfail = nfail + 1
443  END IF
444  30 CONTINUE
445  nrun = nrun + nt
446 *
447 * Skip the remaining tests if this is not the first
448 * block size or if M .ne. N. Skip the solve tests if
449 * the matrix is singular.
450 *
451  IF( inb.GT.1 .OR. m.NE.n )
452  $ GO TO 90
453  IF( trfcon )
454  $ GO TO 70
455 *
456  DO 60 irhs = 1, nns
457  nrhs = nsval( irhs )
458  xtype = 'N'
459 *
460  DO 50 itran = 1, ntran
461  trans = transs( itran )
462  IF( itran.EQ.1 ) THEN
463  rcondc = rcondo
464  ELSE
465  rcondc = rcondi
466  END IF
467 *
468 *+ TEST 3
469 * Solve and compute residual for A * X = B.
470 *
471  srnamt = 'SLARHS'
472  CALL slarhs( path, xtype, ' ', trans, n, n, kl,
473  $ ku, nrhs, a, lda, xact, lda, b,
474  $ lda, iseed, info )
475  xtype = 'C'
476 *
477  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
478  srnamt = 'SGETRS'
479  CALL sgetrs( trans, n, nrhs, afac, lda, iwork,
480  $ x, lda, info )
481 *
482 * Check error code from SGETRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'SGETRS', info, 0, trans,
486  $ n, n, -1, -1, nrhs, imat, nfail,
487  $ nerrs, nout )
488 *
489  CALL slacpy( 'Full', n, nrhs, b, lda, work,
490  $ lda )
491  CALL sget02( trans, n, n, nrhs, a, lda, x, lda,
492  $ work, lda, rwork, result( 3 ) )
493 *
494 *+ TEST 4
495 * Check solution from generated exact solution.
496 *
497  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
498  $ result( 4 ) )
499 *
500 *+ TESTS 5, 6, and 7
501 * Use iterative refinement to improve the
502 * solution.
503 *
504  srnamt = 'SGERFS'
505  CALL sgerfs( trans, n, nrhs, a, lda, afac, lda,
506  $ iwork, b, lda, x, lda, rwork,
507  $ rwork( nrhs+1 ), work,
508  $ iwork( n+1 ), info )
509 *
510 * Check error code from SGERFS.
511 *
512  IF( info.NE.0 )
513  $ CALL alaerh( path, 'SGERFS', info, 0, trans,
514  $ n, n, -1, -1, nrhs, imat, nfail,
515  $ nerrs, nout )
516 *
517  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
518  $ result( 5 ) )
519  CALL sget07( trans, n, nrhs, a, lda, b, lda, x,
520  $ lda, xact, lda, rwork, .true.,
521  $ rwork( nrhs+1 ), result( 6 ) )
522 *
523 * Print information about the tests that did not
524 * pass the threshold.
525 *
526  DO 40 k = 3, 7
527  IF( result( k ).GE.thresh ) THEN
528  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
529  $ CALL alahd( nout, path )
530  WRITE( nout, fmt = 9998 )trans, n, nrhs,
531  $ imat, k, result( k )
532  nfail = nfail + 1
533  END IF
534  40 CONTINUE
535  nrun = nrun + 5
536  50 CONTINUE
537  60 CONTINUE
538 *
539 *+ TEST 8
540 * Get an estimate of RCOND = 1/CNDNUM.
541 *
542  70 CONTINUE
543  DO 80 itran = 1, 2
544  IF( itran.EQ.1 ) THEN
545  anorm = anormo
546  rcondc = rcondo
547  norm = 'O'
548  ELSE
549  anorm = anormi
550  rcondc = rcondi
551  norm = 'I'
552  END IF
553  srnamt = 'SGECON'
554  CALL sgecon( norm, n, afac, lda, anorm, rcond,
555  $ work, iwork( n+1 ), info )
556 *
557 * Check error code from SGECON.
558 *
559  IF( info.NE.0 )
560  $ CALL alaerh( path, 'SGECON', info, 0, norm, n,
561  $ n, -1, -1, -1, imat, nfail, nerrs,
562  $ nout )
563 *
564 * This line is needed on a Sun SPARCstation.
565 *
566  dummy = rcond
567 *
568  result( 8 ) = sget06( rcond, rcondc )
569 *
570 * Print information about the tests that did not pass
571 * the threshold.
572 *
573  IF( result( 8 ).GE.thresh ) THEN
574  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
575  $ CALL alahd( nout, path )
576  WRITE( nout, fmt = 9997 )norm, n, imat, 8,
577  $ result( 8 )
578  nfail = nfail + 1
579  END IF
580  nrun = nrun + 1
581  80 CONTINUE
582  90 CONTINUE
583  100 CONTINUE
584  110 CONTINUE
585  120 CONTINUE
586 *
587 * Print a summary of the results.
588 *
589  CALL alasum( path, nout, nfail, nrun, nerrs )
590 *
591  9999 FORMAT( ' M = ', i5, ', N =', i5, ', NB =', i4, ', type ', i2,
592  $ ', test(', i2, ') =', g12.5 )
593  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
594  $ i2, ', test(', i2, ') =', g12.5 )
595  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
596  $ ', test(', i2, ') =', g12.5 )
597  RETURN
598 *
599 * End of SCHKGE
600 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SGET02
Definition: sget02.f:135
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
Definition: sgetrs.f:123
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
Definition: sgerfs.f:187
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
Definition: sgetrf.f:110
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine sget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
SGET07
Definition: sget07.f:167
subroutine serrge(PATH, NUNIT)
SERRGE
Definition: serrge.f:57
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
Definition: sgetri.f:116
subroutine sget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SGET03
Definition: sget03.f:111
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
Definition: sgecon.f:126
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 sget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
SGET01
Definition: sget01.f:109
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkgt ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
real, dimension( * )  A,
real, dimension( * )  AF,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKGT

Purpose:
 SCHKGT tests SGTTRF, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is REAL array, dimension (NMAX*4)
[out]AF
          AF is REAL array, dimension (NMAX*4)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 148 of file schkgt.f.

148 *
149 * -- LAPACK test routine (version 3.4.0) --
150 * -- LAPACK is a software package provided by Univ. of Tennessee, --
151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
152 * November 2011
153 *
154 * .. Scalar Arguments ..
155  LOGICAL tsterr
156  INTEGER nn, nns, nout
157  REAL thresh
158 * ..
159 * .. Array Arguments ..
160  LOGICAL dotype( * )
161  INTEGER iwork( * ), nsval( * ), nval( * )
162  REAL a( * ), af( * ), b( * ), rwork( * ), work( * ),
163  $ x( * ), xact( * )
164 * ..
165 *
166 * =====================================================================
167 *
168 * .. Parameters ..
169  REAL one, zero
170  parameter( one = 1.0e+0, zero = 0.0e+0 )
171  INTEGER ntypes
172  parameter( ntypes = 12 )
173  INTEGER ntests
174  parameter( ntests = 7 )
175 * ..
176 * .. Local Scalars ..
177  LOGICAL trfcon, zerot
178  CHARACTER dist, norm, trans, type
179  CHARACTER*3 path
180  INTEGER i, imat, in, info, irhs, itran, ix, izero, j,
181  $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
182  $ nimat, nrhs, nrun
183  REAL ainvnm, anorm, cond, rcond, rcondc, rcondi,
184  $ rcondo
185 * ..
186 * .. Local Arrays ..
187  CHARACTER transs( 3 )
188  INTEGER iseed( 4 ), iseedy( 4 )
189  REAL result( ntests ), z( 3 )
190 * ..
191 * .. External Functions ..
192  REAL sasum, sget06, slangt
193  EXTERNAL sasum, sget06, slangt
194 * ..
195 * .. External Subroutines ..
196  EXTERNAL alaerh, alahd, alasum, scopy, serrge, sget04,
199  $ sscal
200 * ..
201 * .. Intrinsic Functions ..
202  INTRINSIC max
203 * ..
204 * .. Scalars in Common ..
205  LOGICAL lerr, ok
206  CHARACTER*32 srnamt
207  INTEGER infot, nunit
208 * ..
209 * .. Common blocks ..
210  COMMON / infoc / infot, nunit, ok, lerr
211  COMMON / srnamc / srnamt
212 * ..
213 * .. Data statements ..
214  DATA iseedy / 0, 0, 0, 1 / , transs / 'N', 'T',
215  $ 'C' /
216 * ..
217 * .. Executable Statements ..
218 *
219  path( 1: 1 ) = 'Single precision'
220  path( 2: 3 ) = 'GT'
221  nrun = 0
222  nfail = 0
223  nerrs = 0
224  DO 10 i = 1, 4
225  iseed( i ) = iseedy( i )
226  10 CONTINUE
227 *
228 * Test the error exits
229 *
230  IF( tsterr )
231  $ CALL serrge( path, nout )
232  infot = 0
233 *
234  DO 110 in = 1, nn
235 *
236 * Do for each value of N in NVAL.
237 *
238  n = nval( in )
239  m = max( n-1, 0 )
240  lda = max( 1, n )
241  nimat = ntypes
242  IF( n.LE.0 )
243  $ nimat = 1
244 *
245  DO 100 imat = 1, nimat
246 *
247 * Do the tests only if DOTYPE( IMAT ) is true.
248 *
249  IF( .NOT.dotype( imat ) )
250  $ GO TO 100
251 *
252 * Set up parameters with SLATB4.
253 *
254  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
255  $ cond, dist )
256 *
257  zerot = imat.GE.8 .AND. imat.LE.10
258  IF( imat.LE.6 ) THEN
259 *
260 * Types 1-6: generate matrices of known condition number.
261 *
262  koff = max( 2-ku, 3-max( 1, n ) )
263  srnamt = 'SLATMS'
264  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode, cond,
265  $ anorm, kl, ku, 'Z', af( koff ), 3, work,
266  $ info )
267 *
268 * Check the error code from SLATMS.
269 *
270  IF( info.NE.0 ) THEN
271  CALL alaerh( path, 'SLATMS', info, 0, ' ', n, n, kl,
272  $ ku, -1, imat, nfail, nerrs, nout )
273  GO TO 100
274  END IF
275  izero = 0
276 *
277  IF( n.GT.1 ) THEN
278  CALL scopy( n-1, af( 4 ), 3, a, 1 )
279  CALL scopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
280  END IF
281  CALL scopy( n, af( 2 ), 3, a( m+1 ), 1 )
282  ELSE
283 *
284 * Types 7-12: generate tridiagonal matrices with
285 * unknown condition numbers.
286 *
287  IF( .NOT.zerot .OR. .NOT.dotype( 7 ) ) THEN
288 *
289 * Generate a matrix with elements from [-1,1].
290 *
291  CALL slarnv( 2, iseed, n+2*m, a )
292  IF( anorm.NE.one )
293  $ CALL sscal( n+2*m, anorm, a, 1 )
294  ELSE IF( izero.GT.0 ) THEN
295 *
296 * Reuse the last matrix by copying back the zeroed out
297 * elements.
298 *
299  IF( izero.EQ.1 ) THEN
300  a( n ) = z( 2 )
301  IF( n.GT.1 )
302  $ a( 1 ) = z( 3 )
303  ELSE IF( izero.EQ.n ) THEN
304  a( 3*n-2 ) = z( 1 )
305  a( 2*n-1 ) = z( 2 )
306  ELSE
307  a( 2*n-2+izero ) = z( 1 )
308  a( n-1+izero ) = z( 2 )
309  a( izero ) = z( 3 )
310  END IF
311  END IF
312 *
313 * If IMAT > 7, set one column of the matrix to 0.
314 *
315  IF( .NOT.zerot ) THEN
316  izero = 0
317  ELSE IF( imat.EQ.8 ) THEN
318  izero = 1
319  z( 2 ) = a( n )
320  a( n ) = zero
321  IF( n.GT.1 ) THEN
322  z( 3 ) = a( 1 )
323  a( 1 ) = zero
324  END IF
325  ELSE IF( imat.EQ.9 ) THEN
326  izero = n
327  z( 1 ) = a( 3*n-2 )
328  z( 2 ) = a( 2*n-1 )
329  a( 3*n-2 ) = zero
330  a( 2*n-1 ) = zero
331  ELSE
332  izero = ( n+1 ) / 2
333  DO 20 i = izero, n - 1
334  a( 2*n-2+i ) = zero
335  a( n-1+i ) = zero
336  a( i ) = zero
337  20 CONTINUE
338  a( 3*n-2 ) = zero
339  a( 2*n-1 ) = zero
340  END IF
341  END IF
342 *
343 *+ TEST 1
344 * Factor A as L*U and compute the ratio
345 * norm(L*U - A) / (n * norm(A) * EPS )
346 *
347  CALL scopy( n+2*m, a, 1, af, 1 )
348  srnamt = 'SGTTRF'
349  CALL sgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
350  $ iwork, info )
351 *
352 * Check error code from SGTTRF.
353 *
354  IF( info.NE.izero )
355  $ CALL alaerh( path, 'SGTTRF', info, izero, ' ', n, n, 1,
356  $ 1, -1, imat, nfail, nerrs, nout )
357  trfcon = info.NE.0
358 *
359  CALL sgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
360  $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
361  $ rwork, result( 1 ) )
362 *
363 * Print the test ratio if it is .GE. THRESH.
364 *
365  IF( result( 1 ).GE.thresh ) THEN
366  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
367  $ CALL alahd( nout, path )
368  WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
369  nfail = nfail + 1
370  END IF
371  nrun = nrun + 1
372 *
373  DO 50 itran = 1, 2
374  trans = transs( itran )
375  IF( itran.EQ.1 ) THEN
376  norm = 'O'
377  ELSE
378  norm = 'I'
379  END IF
380  anorm = slangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
381 *
382  IF( .NOT.trfcon ) THEN
383 *
384 * Use SGTTRS to solve for one column at a time of inv(A)
385 * or inv(A^T), computing the maximum column sum as we
386 * go.
387 *
388  ainvnm = zero
389  DO 40 i = 1, n
390  DO 30 j = 1, n
391  x( j ) = zero
392  30 CONTINUE
393  x( i ) = one
394  CALL sgttrs( trans, n, 1, af, af( m+1 ),
395  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
396  $ lda, info )
397  ainvnm = max( ainvnm, sasum( n, x, 1 ) )
398  40 CONTINUE
399 *
400 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
401 *
402  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
403  rcondc = one
404  ELSE
405  rcondc = ( one / anorm ) / ainvnm
406  END IF
407  IF( itran.EQ.1 ) THEN
408  rcondo = rcondc
409  ELSE
410  rcondi = rcondc
411  END IF
412  ELSE
413  rcondc = zero
414  END IF
415 *
416 *+ TEST 7
417 * Estimate the reciprocal of the condition number of the
418 * matrix.
419 *
420  srnamt = 'SGTCON'
421  CALL sgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
422  $ af( n+2*m+1 ), iwork, anorm, rcond, work,
423  $ iwork( n+1 ), info )
424 *
425 * Check error code from SGTCON.
426 *
427  IF( info.NE.0 )
428  $ CALL alaerh( path, 'SGTCON', info, 0, norm, n, n, -1,
429  $ -1, -1, imat, nfail, nerrs, nout )
430 *
431  result( 7 ) = sget06( rcond, rcondc )
432 *
433 * Print the test ratio if it is .GE. THRESH.
434 *
435  IF( result( 7 ).GE.thresh ) THEN
436  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
437  $ CALL alahd( nout, path )
438  WRITE( nout, fmt = 9997 )norm, n, imat, 7,
439  $ result( 7 )
440  nfail = nfail + 1
441  END IF
442  nrun = nrun + 1
443  50 CONTINUE
444 *
445 * Skip the remaining tests if the matrix is singular.
446 *
447  IF( trfcon )
448  $ GO TO 100
449 *
450  DO 90 irhs = 1, nns
451  nrhs = nsval( irhs )
452 *
453 * Generate NRHS random solution vectors.
454 *
455  ix = 1
456  DO 60 j = 1, nrhs
457  CALL slarnv( 2, iseed, n, xact( ix ) )
458  ix = ix + lda
459  60 CONTINUE
460 *
461  DO 80 itran = 1, 3
462  trans = transs( itran )
463  IF( itran.EQ.1 ) THEN
464  rcondc = rcondo
465  ELSE
466  rcondc = rcondi
467  END IF
468 *
469 * Set the right hand side.
470 *
471  CALL slagtm( trans, n, nrhs, one, a, a( m+1 ),
472  $ a( n+m+1 ), xact, lda, zero, b, lda )
473 *
474 *+ TEST 2
475 * Solve op(A) * X = B and compute the residual.
476 *
477  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
478  srnamt = 'SGTTRS'
479  CALL sgttrs( trans, n, nrhs, af, af( m+1 ),
480  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
481  $ lda, info )
482 *
483 * Check error code from SGTTRS.
484 *
485  IF( info.NE.0 )
486  $ CALL alaerh( path, 'SGTTRS', info, 0, trans, n, n,
487  $ -1, -1, nrhs, imat, nfail, nerrs,
488  $ nout )
489 *
490  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
491  CALL sgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
492  $ x, lda, work, lda, result( 2 ) )
493 *
494 *+ TEST 3
495 * Check solution from generated exact solution.
496 *
497  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
498  $ result( 3 ) )
499 *
500 *+ TESTS 4, 5, and 6
501 * Use iterative refinement to improve the solution.
502 *
503  srnamt = 'SGTRFS'
504  CALL sgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
505  $ af, af( m+1 ), af( n+m+1 ),
506  $ af( n+2*m+1 ), iwork, b, lda, x, lda,
507  $ rwork, rwork( nrhs+1 ), work,
508  $ iwork( n+1 ), info )
509 *
510 * Check error code from SGTRFS.
511 *
512  IF( info.NE.0 )
513  $ CALL alaerh( path, 'SGTRFS', info, 0, trans, n, n,
514  $ -1, -1, nrhs, imat, nfail, nerrs,
515  $ nout )
516 *
517  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
518  $ result( 4 ) )
519  CALL sgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
520  $ b, lda, x, lda, xact, lda, rwork,
521  $ rwork( nrhs+1 ), result( 5 ) )
522 *
523 * Print information about the tests that did not pass
524 * the threshold.
525 *
526  DO 70 k = 2, 6
527  IF( result( k ).GE.thresh ) THEN
528  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
529  $ CALL alahd( nout, path )
530  WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
531  $ k, result( k )
532  nfail = nfail + 1
533  END IF
534  70 CONTINUE
535  nrun = nrun + 5
536  80 CONTINUE
537  90 CONTINUE
538 *
539  100 CONTINUE
540  110 CONTINUE
541 *
542 * Print a summary of the results.
543 *
544  CALL alasum( path, nout, nfail, nrun, nerrs )
545 *
546  9999 FORMAT( 12x, 'N =', i5, ',', 10x, ' type ', i2, ', test(', i2,
547  $ ') = ', g12.5 )
548  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
549  $ i2, ', test(', i2, ') = ', g12.5 )
550  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
551  $ ', test(', i2, ') = ', g12.5 )
552  RETURN
553 *
554 * End of SCHKGT
555 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine sgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
SGTT01
Definition: sgtt01.f:136
subroutine sgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGTRFS
Definition: sgtrfs.f:211
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine sgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SGTT05
Definition: sgtt05.f:167
real function slangt(NORM, N, DL, D, DU)
SLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slangt.f:108
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine serrge(PATH, NUNIT)
SERRGE
Definition: serrge.f:57
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:54
subroutine sgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
SGTT02
Definition: sgtt02.f:126
subroutine sgttrf(N, DL, D, DU, DU2, IPIV, INFO)
SGTTRF
Definition: sgttrf.f:126
subroutine sgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGTCON
Definition: sgtcon.f:148
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:55
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 sgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
SGTTRS
Definition: sgttrs.f:140
subroutine slagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
Definition: slagtm.f:147
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: slarnv.f:99

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schklq ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer, dimension( * )  NXVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AF,
real, dimension( * )  AQ,
real, dimension( * )  AL,
real, dimension( * )  AC,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

SCHKLQ

Purpose:
 SCHKLQ tests SGELQF, SORGLQ and SORMLQ.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB and NX contained in the
          vectors NBVAL and NXVAL.  The blocking parameters are used
          in pairs (NB,NX).
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NXVAL
          NXVAL is INTEGER array, dimension (NNB)
          The values of the crossover point NX.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AF
          AF is REAL array, dimension (NMAX*NMAX)
[out]AQ
          AQ is REAL array, dimension (NMAX*NMAX)
[out]AL
          AL is REAL array, dimension (NMAX*NMAX)
[out]AC
          AC is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NRHS)
[out]X
          X is REAL array, dimension (NMAX*NRHS)
[out]XACT
          XACT is REAL array, dimension (NMAX*NRHS)
[out]TAU
          TAU is REAL array, dimension (NMAX)
[out]WORK
          WORK is REAL array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is REAL array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 198 of file schklq.f.

198 *
199 * -- LAPACK test routine (version 3.6.0) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * November 2015
203 *
204 * .. Scalar Arguments ..
205  LOGICAL tsterr
206  INTEGER nm, nmax, nn, nnb, nout, nrhs
207  REAL thresh
208 * ..
209 * .. Array Arguments ..
210  LOGICAL dotype( * )
211  INTEGER mval( * ), nbval( * ), nval( * ),
212  $ nxval( * )
213  REAL a( * ), ac( * ), af( * ), al( * ), aq( * ),
214  $ b( * ), rwork( * ), tau( * ), work( * ),
215  $ x( * ), xact( * )
216 * ..
217 *
218 * =====================================================================
219 *
220 * .. Parameters ..
221  INTEGER ntests
222  parameter( ntests = 7 )
223  INTEGER ntypes
224  parameter( ntypes = 8 )
225  REAL zero
226  parameter( zero = 0.0e0 )
227 * ..
228 * .. Local Scalars ..
229  CHARACTER dist, type
230  CHARACTER*3 path
231  INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
232  $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
233  $ nrun, nt, nx
234  REAL anorm, cndnum
235 * ..
236 * .. Local Arrays ..
237  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
238  REAL result( ntests )
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL alaerh, alahd, alasum, serrlq, sgelqs, sget02,
243  $ slqt03, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC max, min
247 * ..
248 * .. Scalars in Common ..
249  LOGICAL lerr, ok
250  CHARACTER*32 srnamt
251  INTEGER infot, nunit
252 * ..
253 * .. Common blocks ..
254  COMMON / infoc / infot, nunit, ok, lerr
255  COMMON / srnamc / srnamt
256 * ..
257 * .. Data statements ..
258  DATA iseedy / 1988, 1989, 1990, 1991 /
259 * ..
260 * .. Executable Statements ..
261 *
262 * Initialize constants and the random number seed.
263 *
264  path( 1: 1 ) = 'Single precision'
265  path( 2: 3 ) = 'LQ'
266  nrun = 0
267  nfail = 0
268  nerrs = 0
269  DO 10 i = 1, 4
270  iseed( i ) = iseedy( i )
271  10 CONTINUE
272 *
273 * Test the error exits
274 *
275  IF( tsterr )
276  $ CALL serrlq( path, nout )
277  infot = 0
278  CALL xlaenv( 2, 2 )
279 *
280  lda = nmax
281  lwork = nmax*max( nmax, nrhs )
282 *
283 * Do for each value of M in MVAL.
284 *
285  DO 70 im = 1, nm
286  m = mval( im )
287 *
288 * Do for each value of N in NVAL.
289 *
290  DO 60 in = 1, nn
291  n = nval( in )
292  minmn = min( m, n )
293  DO 50 imat = 1, ntypes
294 *
295 * Do the tests only if DOTYPE( IMAT ) is true.
296 *
297  IF( .NOT.dotype( imat ) )
298  $ GO TO 50
299 *
300 * Set up parameters with SLATB4 and generate a test matrix
301 * with SLATMS.
302 *
303  CALL slatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'SLATMS'
307  CALL slatms( m, n, dist, iseed, TYPE, rwork, mode,
308  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
309  $ work, info )
310 *
311 * Check error code from SLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'SLATMS', info, 0, ' ', m, n, -1,
315  $ -1, -1, imat, nfail, nerrs, nout )
316  GO TO 50
317  END IF
318 *
319 * Set some values for K: the first value must be MINMN,
320 * corresponding to the call of SLQT01; other values are
321 * used in the calls of SLQT02, and must not exceed MINMN.
322 *
323  kval( 1 ) = minmn
324  kval( 2 ) = 0
325  kval( 3 ) = 1
326  kval( 4 ) = minmn / 2
327  IF( minmn.EQ.0 ) THEN
328  nk = 1
329  ELSE IF( minmn.EQ.1 ) THEN
330  nk = 2
331  ELSE IF( minmn.LE.3 ) THEN
332  nk = 3
333  ELSE
334  nk = 4
335  END IF
336 *
337 * Do for each value of K in KVAL
338 *
339  DO 40 ik = 1, nk
340  k = kval( ik )
341 *
342 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
343 *
344  DO 30 inb = 1, nnb
345  nb = nbval( inb )
346  CALL xlaenv( 1, nb )
347  nx = nxval( inb )
348  CALL xlaenv( 3, nx )
349  DO i = 1, ntests
350  result( i ) = zero
351  END DO
352  nt = 2
353  IF( ik.EQ.1 ) THEN
354 *
355 * Test SGELQF
356 *
357  CALL slqt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.LE.n ) THEN
360 *
361 * Test SORGLQ, using factorization
362 * returned by SLQT01
363 *
364  CALL slqt02( m, n, k, a, af, aq, al, lda, tau,
365  $ work, lwork, rwork, result( 1 ) )
366  END IF
367  IF( m.GE.k ) THEN
368 *
369 * Test SORMLQ, using factorization returned
370 * by SLQT01
371 *
372  CALL slqt03( m, n, k, af, ac, al, aq, lda, tau,
373  $ work, lwork, rwork, result( 3 ) )
374  nt = nt + 4
375 *
376 * If M>=N and K=N, call SGELQS to solve a system
377 * with NRHS right hand sides and compute the
378 * residual.
379 *
380  IF( k.EQ.m .AND. inb.EQ.1 ) THEN
381 *
382 * Generate a solution and set the right
383 * hand side.
384 *
385  srnamt = 'SLARHS'
386  CALL slarhs( path, 'New', 'Full',
387  $ 'No transpose', m, n, 0, 0,
388  $ nrhs, a, lda, xact, lda, b, lda,
389  $ iseed, info )
390 *
391  CALL slacpy( 'Full', m, nrhs, b, lda, x,
392  $ lda )
393  srnamt = 'SGELQS'
394  CALL sgelqs( m, n, nrhs, af, lda, tau, x,
395  $ lda, work, lwork, info )
396 *
397 * Check error code from SGELQS.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'SGELQS', info, 0, ' ',
401  $ m, n, nrhs, -1, nb, imat,
402  $ nfail, nerrs, nout )
403 *
404  CALL sget02( 'No transpose', m, n, nrhs, a,
405  $ lda, x, lda, b, lda, rwork,
406  $ result( 7 ) )
407  nt = nt + 1
408  END IF
409  END IF
410 *
411 * Print information about the tests that did not
412 * pass the threshold.
413 *
414  DO 20 i = 1, nt
415  IF( result( i ).GE.thresh ) THEN
416  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417  $ CALL alahd( nout, path )
418  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419  $ imat, i, result( i )
420  nfail = nfail + 1
421  END IF
422  20 CONTINUE
423  nrun = nrun + nt
424  30 CONTINUE
425  40 CONTINUE
426  50 CONTINUE
427  60 CONTINUE
428  70 CONTINUE
429 *
430 * Print a summary of the results.
431 *
432  CALL alasum( path, nout, nfail, nrun, nerrs )
433 *
434  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
435  $ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
436  RETURN
437 *
438 * End of SCHKLQ
439 *
subroutine slqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT01
Definition: slqt01.f:128
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SGET02
Definition: sget02.f:135
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine slqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT03
Definition: slqt03.f:138
subroutine sgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGELQS
Definition: sgelqs.f:123
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine slqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT02
Definition: slqt02.f:137
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 serrlq(PATH, NUNIT)
SERRLQ
Definition: serrlq.f:57
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkpb ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKPB

Purpose:
 SCHKPB tests SPBTRF, -TRS, -RFS, and -CON.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]AINV
          AINV is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 174 of file schkpb.f.

174 *
175 * -- LAPACK test routine (version 3.4.0) --
176 * -- LAPACK is a software package provided by Univ. of Tennessee, --
177 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178 * November 2011
179 *
180 * .. Scalar Arguments ..
181  LOGICAL tsterr
182  INTEGER nmax, nn, nnb, nns, nout
183  REAL thresh
184 * ..
185 * .. Array Arguments ..
186  LOGICAL dotype( * )
187  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188  REAL a( * ), afac( * ), ainv( * ), b( * ),
189  $ rwork( * ), work( * ), x( * ), xact( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL one, zero
196  parameter( one = 1.0e+0, zero = 0.0e+0 )
197  INTEGER ntypes, ntests
198  parameter( ntypes = 8, ntests = 7 )
199  INTEGER nbw
200  parameter( nbw = 4 )
201 * ..
202 * .. Local Scalars ..
203  LOGICAL zerot
204  CHARACTER dist, packit, TYPE, uplo, xtype
205  CHARACTER*3 path
206  INTEGER i, i1, i2, ikd, imat, in, inb, info, ioff,
207  $ irhs, iuplo, iw, izero, k, kd, kl, koff, ku,
208  $ lda, ldab, mode, n, nb, nerrs, nfail, nimat,
209  $ nkd, nrhs, nrun
210  REAL ainvnm, anorm, cndnum, rcond, rcondc
211 * ..
212 * .. Local Arrays ..
213  INTEGER iseed( 4 ), iseedy( 4 ), kdval( nbw )
214  REAL result( ntests )
215 * ..
216 * .. External Functions ..
217  REAL sget06, slange, slansb
218  EXTERNAL sget06, slange, slansb
219 * ..
220 * .. External Subroutines ..
221  EXTERNAL alaerh, alahd, alasum, scopy, serrpo, sget04,
224  $ sswap, xlaenv
225 * ..
226 * .. Intrinsic Functions ..
227  INTRINSIC max, min
228 * ..
229 * .. Scalars in Common ..
230  LOGICAL lerr, ok
231  CHARACTER*32 srnamt
232  INTEGER infot, nunit
233 * ..
234 * .. Common blocks ..
235  COMMON / infoc / infot, nunit, ok, lerr
236  COMMON / srnamc / srnamt
237 * ..
238 * .. Data statements ..
239  DATA iseedy / 1988, 1989, 1990, 1991 /
240 * ..
241 * .. Executable Statements ..
242 *
243 * Initialize constants and the random number seed.
244 *
245  path( 1: 1 ) = 'Single precision'
246  path( 2: 3 ) = 'PB'
247  nrun = 0
248  nfail = 0
249  nerrs = 0
250  DO 10 i = 1, 4
251  iseed( i ) = iseedy( i )
252  10 CONTINUE
253 *
254 * Test the error exits
255 *
256  IF( tsterr )
257  $ CALL serrpo( path, nout )
258  infot = 0
259  CALL xlaenv( 2, 2 )
260  kdval( 1 ) = 0
261 *
262 * Do for each value of N in NVAL
263 *
264  DO 90 in = 1, nn
265  n = nval( in )
266  lda = max( n, 1 )
267  xtype = 'N'
268 *
269 * Set limits on the number of loop iterations.
270 *
271  nkd = max( 1, min( n, 4 ) )
272  nimat = ntypes
273  IF( n.EQ.0 )
274  $ nimat = 1
275 *
276  kdval( 2 ) = n + ( n+1 ) / 4
277  kdval( 3 ) = ( 3*n-1 ) / 4
278  kdval( 4 ) = ( n+1 ) / 4
279 *
280  DO 80 ikd = 1, nkd
281 *
282 * Do for KD = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This order
283 * makes it easier to skip redundant values for small values
284 * of N.
285 *
286  kd = kdval( ikd )
287  ldab = kd + 1
288 *
289 * Do first for UPLO = 'U', then for UPLO = 'L'
290 *
291  DO 70 iuplo = 1, 2
292  koff = 1
293  IF( iuplo.EQ.1 ) THEN
294  uplo = 'U'
295  koff = max( 1, kd+2-n )
296  packit = 'Q'
297  ELSE
298  uplo = 'L'
299  packit = 'B'
300  END IF
301 *
302  DO 60 imat = 1, nimat
303 *
304 * Do the tests only if DOTYPE( IMAT ) is true.
305 *
306  IF( .NOT.dotype( imat ) )
307  $ GO TO 60
308 *
309 * Skip types 2, 3, or 4 if the matrix size is too small.
310 *
311  zerot = imat.GE.2 .AND. imat.LE.4
312  IF( zerot .AND. n.LT.imat-1 )
313  $ GO TO 60
314 *
315  IF( .NOT.zerot .OR. .NOT.dotype( 1 ) ) THEN
316 *
317 * Set up parameters with SLATB4 and generate a test
318 * matrix with SLATMS.
319 *
320  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm,
321  $ mode, cndnum, dist )
322 *
323  srnamt = 'SLATMS'
324  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode,
325  $ cndnum, anorm, kd, kd, packit,
326  $ a( koff ), ldab, work, info )
327 *
328 * Check error code from SLATMS.
329 *
330  IF( info.NE.0 ) THEN
331  CALL alaerh( path, 'SLATMS', info, 0, uplo, n,
332  $ n, kd, kd, -1, imat, nfail, nerrs,
333  $ nout )
334  GO TO 60
335  END IF
336  ELSE IF( izero.GT.0 ) THEN
337 *
338 * Use the same matrix for types 3 and 4 as for type
339 * 2 by copying back the zeroed out column,
340 *
341  iw = 2*lda + 1
342  IF( iuplo.EQ.1 ) THEN
343  ioff = ( izero-1 )*ldab + kd + 1
344  CALL scopy( izero-i1, work( iw ), 1,
345  $ a( ioff-izero+i1 ), 1 )
346  iw = iw + izero - i1
347  CALL scopy( i2-izero+1, work( iw ), 1,
348  $ a( ioff ), max( ldab-1, 1 ) )
349  ELSE
350  ioff = ( i1-1 )*ldab + 1
351  CALL scopy( izero-i1, work( iw ), 1,
352  $ a( ioff+izero-i1 ),
353  $ max( ldab-1, 1 ) )
354  ioff = ( izero-1 )*ldab + 1
355  iw = iw + izero - i1
356  CALL scopy( i2-izero+1, work( iw ), 1,
357  $ a( ioff ), 1 )
358  END IF
359  END IF
360 *
361 * For types 2-4, zero one row and column of the matrix
362 * to test that INFO is returned correctly.
363 *
364  izero = 0
365  IF( zerot ) THEN
366  IF( imat.EQ.2 ) THEN
367  izero = 1
368  ELSE IF( imat.EQ.3 ) THEN
369  izero = n
370  ELSE
371  izero = n / 2 + 1
372  END IF
373 *
374 * Save the zeroed out row and column in WORK(*,3)
375 *
376  iw = 2*lda
377  DO 20 i = 1, min( 2*kd+1, n )
378  work( iw+i ) = zero
379  20 CONTINUE
380  iw = iw + 1
381  i1 = max( izero-kd, 1 )
382  i2 = min( izero+kd, n )
383 *
384  IF( iuplo.EQ.1 ) THEN
385  ioff = ( izero-1 )*ldab + kd + 1
386  CALL sswap( izero-i1, a( ioff-izero+i1 ), 1,
387  $ work( iw ), 1 )
388  iw = iw + izero - i1
389  CALL sswap( i2-izero+1, a( ioff ),
390  $ max( ldab-1, 1 ), work( iw ), 1 )
391  ELSE
392  ioff = ( i1-1 )*ldab + 1
393  CALL sswap( izero-i1, a( ioff+izero-i1 ),
394  $ max( ldab-1, 1 ), work( iw ), 1 )
395  ioff = ( izero-1 )*ldab + 1
396  iw = iw + izero - i1
397  CALL sswap( i2-izero+1, a( ioff ), 1,
398  $ work( iw ), 1 )
399  END IF
400  END IF
401 *
402 * Do for each value of NB in NBVAL
403 *
404  DO 50 inb = 1, nnb
405  nb = nbval( inb )
406  CALL xlaenv( 1, nb )
407 *
408 * Compute the L*L' or U'*U factorization of the band
409 * matrix.
410 *
411  CALL slacpy( 'Full', kd+1, n, a, ldab, afac, ldab )
412  srnamt = 'SPBTRF'
413  CALL spbtrf( uplo, n, kd, afac, ldab, info )
414 *
415 * Check error code from SPBTRF.
416 *
417  IF( info.NE.izero ) THEN
418  CALL alaerh( path, 'SPBTRF', info, izero, uplo,
419  $ n, n, kd, kd, nb, imat, nfail,
420  $ nerrs, nout )
421  GO TO 50
422  END IF
423 *
424 * Skip the tests if INFO is not 0.
425 *
426  IF( info.NE.0 )
427  $ GO TO 50
428 *
429 *+ TEST 1
430 * Reconstruct matrix from factors and compute
431 * residual.
432 *
433  CALL slacpy( 'Full', kd+1, n, afac, ldab, ainv,
434  $ ldab )
435  CALL spbt01( uplo, n, kd, a, ldab, ainv, ldab,
436  $ rwork, result( 1 ) )
437 *
438 * Print the test ratio if it is .GE. THRESH.
439 *
440  IF( result( 1 ).GE.thresh ) THEN
441  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
442  $ CALL alahd( nout, path )
443  WRITE( nout, fmt = 9999 )uplo, n, kd, nb, imat,
444  $ 1, result( 1 )
445  nfail = nfail + 1
446  END IF
447  nrun = nrun + 1
448 *
449 * Only do other tests if this is the first blocksize.
450 *
451  IF( inb.GT.1 )
452  $ GO TO 50
453 *
454 * Form the inverse of A so we can get a good estimate
455 * of RCONDC = 1/(norm(A) * norm(inv(A))).
456 *
457  CALL slaset( 'Full', n, n, zero, one, ainv, lda )
458  srnamt = 'SPBTRS'
459  CALL spbtrs( uplo, n, kd, n, afac, ldab, ainv, lda,
460  $ info )
461 *
462 * Compute RCONDC = 1/(norm(A) * norm(inv(A))).
463 *
464  anorm = slansb( '1', uplo, n, kd, a, ldab, rwork )
465  ainvnm = slange( '1', n, n, ainv, lda, rwork )
466  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
467  rcondc = one
468  ELSE
469  rcondc = ( one / anorm ) / ainvnm
470  END IF
471 *
472  DO 40 irhs = 1, nns
473  nrhs = nsval( irhs )
474 *
475 *+ TEST 2
476 * Solve and compute residual for A * X = B.
477 *
478  srnamt = 'SLARHS'
479  CALL slarhs( path, xtype, uplo, ' ', n, n, kd,
480  $ kd, nrhs, a, ldab, xact, lda, b,
481  $ lda, iseed, info )
482  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
483 *
484  srnamt = 'SPBTRS'
485  CALL spbtrs( uplo, n, kd, nrhs, afac, ldab, x,
486  $ lda, info )
487 *
488 * Check error code from SPBTRS.
489 *
490  IF( info.NE.0 )
491  $ CALL alaerh( path, 'SPBTRS', info, 0, uplo,
492  $ n, n, kd, kd, nrhs, imat, nfail,
493  $ nerrs, nout )
494 *
495  CALL slacpy( 'Full', n, nrhs, b, lda, work,
496  $ lda )
497  CALL spbt02( uplo, n, kd, nrhs, a, ldab, x, lda,
498  $ work, lda, rwork, result( 2 ) )
499 *
500 *+ TEST 3
501 * Check solution from generated exact solution.
502 *
503  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
504  $ result( 3 ) )
505 *
506 *+ TESTS 4, 5, and 6
507 * Use iterative refinement to improve the solution.
508 *
509  srnamt = 'SPBRFS'
510  CALL spbrfs( uplo, n, kd, nrhs, a, ldab, afac,
511  $ ldab, b, lda, x, lda, rwork,
512  $ rwork( nrhs+1 ), work, iwork,
513  $ info )
514 *
515 * Check error code from SPBRFS.
516 *
517  IF( info.NE.0 )
518  $ CALL alaerh( path, 'SPBRFS', info, 0, uplo,
519  $ n, n, kd, kd, nrhs, imat, nfail,
520  $ nerrs, nout )
521 *
522  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
523  $ result( 4 ) )
524  CALL spbt05( uplo, n, kd, nrhs, a, ldab, b, lda,
525  $ x, lda, xact, lda, rwork,
526  $ rwork( nrhs+1 ), result( 5 ) )
527 *
528 * Print information about the tests that did not
529 * pass the threshold.
530 *
531  DO 30 k = 2, 6
532  IF( result( k ).GE.thresh ) THEN
533  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
534  $ CALL alahd( nout, path )
535  WRITE( nout, fmt = 9998 )uplo, n, kd,
536  $ nrhs, imat, k, result( k )
537  nfail = nfail + 1
538  END IF
539  30 CONTINUE
540  nrun = nrun + 5
541  40 CONTINUE
542 *
543 *+ TEST 7
544 * Get an estimate of RCOND = 1/CNDNUM.
545 *
546  srnamt = 'SPBCON'
547  CALL spbcon( uplo, n, kd, afac, ldab, anorm, rcond,
548  $ work, iwork, info )
549 *
550 * Check error code from SPBCON.
551 *
552  IF( info.NE.0 )
553  $ CALL alaerh( path, 'SPBCON', info, 0, uplo, n,
554  $ n, kd, kd, -1, imat, nfail, nerrs,
555  $ nout )
556 *
557  result( 7 ) = sget06( rcond, rcondc )
558 *
559 * Print the test ratio if it is .GE. THRESH.
560 *
561  IF( result( 7 ).GE.thresh ) THEN
562  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
563  $ CALL alahd( nout, path )
564  WRITE( nout, fmt = 9997 )uplo, n, kd, imat, 7,
565  $ result( 7 )
566  nfail = nfail + 1
567  END IF
568  nrun = nrun + 1
569  50 CONTINUE
570  60 CONTINUE
571  70 CONTINUE
572  80 CONTINUE
573  90 CONTINUE
574 *
575 * Print a summary of the results.
576 *
577  CALL alasum( path, nout, nfail, nrun, nerrs )
578 *
579  9999 FORMAT( ' UPLO=''', a1, ''', N=', i5, ', KD=', i5, ', NB=', i4,
580  $ ', type ', i2, ', test ', i2, ', ratio= ', g12.5 )
581  9998 FORMAT( ' UPLO=''', a1, ''', N=', i5, ', KD=', i5, ', NRHS=', i3,
582  $ ', type ', i2, ', test(', i2, ') = ', g12.5 )
583  9997 FORMAT( ' UPLO=''', a1, ''', N=', i5, ', KD=', i5, ',', 10x,
584  $ ' type ', i2, ', test(', i2, ') = ', g12.5 )
585  RETURN
586 *
587 * End of SCHKPB
588 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
Definition: spbcon.f:134
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine serrpo(PATH, NUNIT)
SERRPO
Definition: serrpo.f:57
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
real function slansb(NORM, UPLO, N, K, AB, LDAB, WORK)
SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
Definition: slansb.f:131
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine spbt05(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPBT05
Definition: spbt05.f:173
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:53
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
Definition: spbtrf.f:144
subroutine spbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPBT01
Definition: spbt01.f:121
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 spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
Definition: spbtrs.f:123
subroutine spbt02(UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPBT02
Definition: spbt02.f:138
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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 spbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPBRFS
Definition: spbrfs.f:191
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 schkpo ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKPO

Purpose:
 SCHKPO tests SPOTRF, -TRI, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]AINV
          AINV is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 174 of file schkpo.f.

174 *
175 * -- LAPACK test routine (version 3.4.0) --
176 * -- LAPACK is a software package provided by Univ. of Tennessee, --
177 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178 * November 2011
179 *
180 * .. Scalar Arguments ..
181  LOGICAL tsterr
182  INTEGER nmax, nn, nnb, nns, nout
183  REAL thresh
184 * ..
185 * .. Array Arguments ..
186  LOGICAL dotype( * )
187  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188  REAL a( * ), afac( * ), ainv( * ), b( * ),
189  $ rwork( * ), work( * ), x( * ), xact( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL zero
196  parameter( zero = 0.0e+0 )
197  INTEGER ntypes
198  parameter( ntypes = 9 )
199  INTEGER ntests
200  parameter( ntests = 8 )
201 * ..
202 * .. Local Scalars ..
203  LOGICAL zerot
204  CHARACTER dist, TYPE, uplo, xtype
205  CHARACTER*3 path
206  INTEGER i, imat, in, inb, info, ioff, irhs, iuplo,
207  $ izero, k, kl, ku, lda, mode, n, nb, nerrs,
208  $ nfail, nimat, nrhs, nrun
209  REAL anorm, cndnum, rcond, rcondc
210 * ..
211 * .. Local Arrays ..
212  CHARACTER uplos( 2 )
213  INTEGER iseed( 4 ), iseedy( 4 )
214  REAL result( ntests )
215 * ..
216 * .. External Functions ..
217  REAL sget06, slansy
218  EXTERNAL sget06, slansy
219 * ..
220 * .. External Subroutines ..
221  EXTERNAL alaerh, alahd, alasum, serrpo, sget04, slacpy,
224  $ xlaenv
225 * ..
226 * .. Scalars in Common ..
227  LOGICAL lerr, ok
228  CHARACTER*32 srnamt
229  INTEGER infot, nunit
230 * ..
231 * .. Common blocks ..
232  COMMON / infoc / infot, nunit, ok, lerr
233  COMMON / srnamc / srnamt
234 * ..
235 * .. Intrinsic Functions ..
236  INTRINSIC max
237 * ..
238 * .. Data statements ..
239  DATA iseedy / 1988, 1989, 1990, 1991 /
240  DATA uplos / 'U', 'L' /
241 * ..
242 * .. Executable Statements ..
243 *
244 * Initialize constants and the random number seed.
245 *
246  path( 1: 1 ) = 'Single precision'
247  path( 2: 3 ) = 'PO'
248  nrun = 0
249  nfail = 0
250  nerrs = 0
251  DO 10 i = 1, 4
252  iseed( i ) = iseedy( i )
253  10 CONTINUE
254 *
255 * Test the error exits
256 *
257  IF( tsterr )
258  $ CALL serrpo( path, nout )
259  infot = 0
260  CALL xlaenv( 2, 2 )
261 *
262 * Do for each value of N in NVAL
263 *
264  DO 120 in = 1, nn
265  n = nval( in )
266  lda = max( n, 1 )
267  xtype = 'N'
268  nimat = ntypes
269  IF( n.LE.0 )
270  $ nimat = 1
271 *
272  izero = 0
273  DO 110 imat = 1, nimat
274 *
275 * Do the tests only if DOTYPE( IMAT ) is true.
276 *
277  IF( .NOT.dotype( imat ) )
278  $ GO TO 110
279 *
280 * Skip types 3, 4, or 5 if the matrix size is too small.
281 *
282  zerot = imat.GE.3 .AND. imat.LE.5
283  IF( zerot .AND. n.LT.imat-2 )
284  $ GO TO 110
285 *
286 * Do first for UPLO = 'U', then for UPLO = 'L'
287 *
288  DO 100 iuplo = 1, 2
289  uplo = uplos( iuplo )
290 *
291 * Set up parameters with SLATB4 and generate a test matrix
292 * with SLATMS.
293 *
294  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
295  $ cndnum, dist )
296 *
297  srnamt = 'SLATMS'
298  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode,
299  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
300  $ info )
301 *
302 * Check error code from SLATMS.
303 *
304  IF( info.NE.0 ) THEN
305  CALL alaerh( path, 'SLATMS', info, 0, uplo, n, n, -1,
306  $ -1, -1, imat, nfail, nerrs, nout )
307  GO TO 100
308  END IF
309 *
310 * For types 3-5, zero one row and column of the matrix to
311 * test that INFO is returned correctly.
312 *
313  IF( zerot ) THEN
314  IF( imat.EQ.3 ) THEN
315  izero = 1
316  ELSE IF( imat.EQ.4 ) THEN
317  izero = n
318  ELSE
319  izero = n / 2 + 1
320  END IF
321  ioff = ( izero-1 )*lda
322 *
323 * Set row and column IZERO of A to 0.
324 *
325  IF( iuplo.EQ.1 ) THEN
326  DO 20 i = 1, izero - 1
327  a( ioff+i ) = zero
328  20 CONTINUE
329  ioff = ioff + izero
330  DO 30 i = izero, n
331  a( ioff ) = zero
332  ioff = ioff + lda
333  30 CONTINUE
334  ELSE
335  ioff = izero
336  DO 40 i = 1, izero - 1
337  a( ioff ) = zero
338  ioff = ioff + lda
339  40 CONTINUE
340  ioff = ioff - izero
341  DO 50 i = izero, n
342  a( ioff+i ) = zero
343  50 CONTINUE
344  END IF
345  ELSE
346  izero = 0
347  END IF
348 *
349 * Do for each value of NB in NBVAL
350 *
351  DO 90 inb = 1, nnb
352  nb = nbval( inb )
353  CALL xlaenv( 1, nb )
354 *
355 * Compute the L*L' or U'*U factorization of the matrix.
356 *
357  CALL slacpy( uplo, n, n, a, lda, afac, lda )
358  srnamt = 'SPOTRF'
359  CALL spotrf( uplo, n, afac, lda, info )
360 *
361 * Check error code from SPOTRF.
362 *
363  IF( info.NE.izero ) THEN
364  CALL alaerh( path, 'SPOTRF', info, izero, uplo, n,
365  $ n, -1, -1, nb, imat, nfail, nerrs,
366  $ nout )
367  GO TO 90
368  END IF
369 *
370 * Skip the tests if INFO is not 0.
371 *
372  IF( info.NE.0 )
373  $ GO TO 90
374 *
375 *+ TEST 1
376 * Reconstruct matrix from factors and compute residual.
377 *
378  CALL slacpy( uplo, n, n, afac, lda, ainv, lda )
379  CALL spot01( uplo, n, a, lda, ainv, lda, rwork,
380  $ result( 1 ) )
381 *
382 *+ TEST 2
383 * Form the inverse and compute the residual.
384 *
385  CALL slacpy( uplo, n, n, afac, lda, ainv, lda )
386  srnamt = 'SPOTRI'
387  CALL spotri( uplo, n, ainv, lda, info )
388 *
389 * Check error code from SPOTRI.
390 *
391  IF( info.NE.0 )
392  $ CALL alaerh( path, 'SPOTRI', info, 0, uplo, n, n,
393  $ -1, -1, -1, imat, nfail, nerrs, nout )
394 *
395  CALL spot03( uplo, n, a, lda, ainv, lda, work, lda,
396  $ rwork, rcondc, result( 2 ) )
397 *
398 * Print information about the tests that did not pass
399 * the threshold.
400 *
401  DO 60 k = 1, 2
402  IF( result( k ).GE.thresh ) THEN
403  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
404  $ CALL alahd( nout, path )
405  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
406  $ result( k )
407  nfail = nfail + 1
408  END IF
409  60 CONTINUE
410  nrun = nrun + 2
411 *
412 * Skip the rest of the tests unless this is the first
413 * blocksize.
414 *
415  IF( inb.NE.1 )
416  $ GO TO 90
417 *
418  DO 80 irhs = 1, nns
419  nrhs = nsval( irhs )
420 *
421 *+ TEST 3
422 * Solve and compute residual for A * X = B .
423 *
424  srnamt = 'SLARHS'
425  CALL slarhs( path, xtype, uplo, ' ', n, n, kl, ku,
426  $ nrhs, a, lda, xact, lda, b, lda,
427  $ iseed, info )
428  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
429 *
430  srnamt = 'SPOTRS'
431  CALL spotrs( uplo, n, nrhs, afac, lda, x, lda,
432  $ info )
433 *
434 * Check error code from SPOTRS.
435 *
436  IF( info.NE.0 )
437  $ CALL alaerh( path, 'SPOTRS', info, 0, uplo, n,
438  $ n, -1, -1, nrhs, imat, nfail,
439  $ nerrs, nout )
440 *
441  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
442  CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
443  $ lda, rwork, result( 3 ) )
444 *
445 *+ TEST 4
446 * Check solution from generated exact solution.
447 *
448  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
449  $ result( 4 ) )
450 *
451 *+ TESTS 5, 6, and 7
452 * Use iterative refinement to improve the solution.
453 *
454  srnamt = 'SPORFS'
455  CALL sporfs( uplo, n, nrhs, a, lda, afac, lda, b,
456  $ lda, x, lda, rwork, rwork( nrhs+1 ),
457  $ work, iwork, info )
458 *
459 * Check error code from SPORFS.
460 *
461  IF( info.NE.0 )
462  $ CALL alaerh( path, 'SPORFS', info, 0, uplo, n,
463  $ n, -1, -1, nrhs, imat, nfail,
464  $ nerrs, nout )
465 *
466  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
467  $ result( 5 ) )
468  CALL spot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
469  $ xact, lda, rwork, rwork( nrhs+1 ),
470  $ result( 6 ) )
471 *
472 * Print information about the tests that did not pass
473 * the threshold.
474 *
475  DO 70 k = 3, 7
476  IF( result( k ).GE.thresh ) THEN
477  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
478  $ CALL alahd( nout, path )
479  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
480  $ imat, k, result( k )
481  nfail = nfail + 1
482  END IF
483  70 CONTINUE
484  nrun = nrun + 5
485  80 CONTINUE
486 *
487 *+ TEST 8
488 * Get an estimate of RCOND = 1/CNDNUM.
489 *
490  anorm = slansy( '1', uplo, n, a, lda, rwork )
491  srnamt = 'SPOCON'
492  CALL spocon( uplo, n, afac, lda, anorm, rcond, work,
493  $ iwork, info )
494 *
495 * Check error code from SPOCON.
496 *
497  IF( info.NE.0 )
498  $ CALL alaerh( path, 'SPOCON', info, 0, uplo, n, n,
499  $ -1, -1, -1, imat, nfail, nerrs, nout )
500 *
501  result( 8 ) = sget06( rcond, rcondc )
502 *
503 * Print the test ratio if it is .GE. THRESH.
504 *
505  IF( result( 8 ).GE.thresh ) THEN
506  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507  $ CALL alahd( nout, path )
508  WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
509  $ result( 8 )
510  nfail = nfail + 1
511  END IF
512  nrun = nrun + 1
513  90 CONTINUE
514  100 CONTINUE
515  110 CONTINUE
516  120 CONTINUE
517 *
518 * Print a summary of the results.
519 *
520  CALL alasum( path, nout, nfail, nrun, nerrs )
521 *
522  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
523  $ i2, ', test ', i2, ', ratio =', g12.5 )
524  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
525  $ i2, ', test(', i2, ') =', g12.5 )
526  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
527  $ ', test(', i2, ') =', g12.5 )
528  RETURN
529 *
530 * End of SCHKPO
531 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
Definition: spotrs.f:112
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
Definition: spotri.f:97
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Definition: spotrf.f:109
subroutine spot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPOT01
Definition: spot01.f:106
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
Definition: spot02.f:129
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine spot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPOT05
Definition: spot05.f:166
subroutine serrpo(PATH, NUNIT)
SERRPO
Definition: serrpo.f:57
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
Definition: spocon.f:123
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine spot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPOT03
Definition: spot03.f:127
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
Definition: sporfs.f:185
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 slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
Definition: slansy.f:124
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkpp ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKPP

Purpose:
 SCHKPP tests SPPTRF, -TRI, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is REAL array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is REAL array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is REAL array, dimension
                      (NMAX*(NMAX+1)/2)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 165 of file schkpp.f.

165 *
166 * -- LAPACK test routine (version 3.4.0) --
167 * -- LAPACK is a software package provided by Univ. of Tennessee, --
168 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
169 * November 2011
170 *
171 * .. Scalar Arguments ..
172  LOGICAL tsterr
173  INTEGER nmax, nn, nns, nout
174  REAL thresh
175 * ..
176 * .. Array Arguments ..
177  LOGICAL dotype( * )
178  INTEGER iwork( * ), nsval( * ), nval( * )
179  REAL a( * ), afac( * ), ainv( * ), b( * ),
180  $ rwork( * ), work( * ), x( * ), xact( * )
181 * ..
182 *
183 * =====================================================================
184 *
185 * .. Parameters ..
186  REAL zero
187  parameter( zero = 0.0e+0 )
188  INTEGER ntypes
189  parameter( ntypes = 9 )
190  INTEGER ntests
191  parameter( ntests = 8 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL zerot
195  CHARACTER dist, packit, TYPE, uplo, xtype
196  CHARACTER*3 path
197  INTEGER i, imat, in, info, ioff, irhs, iuplo, izero, k,
198  $ kl, ku, lda, mode, n, nerrs, nfail, nimat, npp,
199  $ nrhs, nrun
200  REAL anorm, cndnum, rcond, rcondc
201 * ..
202 * .. Local Arrays ..
203  CHARACTER packs( 2 ), uplos( 2 )
204  INTEGER iseed( 4 ), iseedy( 4 )
205  REAL result( ntests )
206 * ..
207 * .. External Functions ..
208  REAL sget06, slansp
209  EXTERNAL sget06, slansp
210 * ..
211 * .. External Subroutines ..
212  EXTERNAL alaerh, alahd, alasum, scopy, serrpo, sget04,
215  $ spptrs
216 * ..
217 * .. Scalars in Common ..
218  LOGICAL lerr, ok
219  CHARACTER*32 srnamt
220  INTEGER infot, nunit
221 * ..
222 * .. Common blocks ..
223  COMMON / infoc / infot, nunit, ok, lerr
224  COMMON / srnamc / srnamt
225 * ..
226 * .. Intrinsic Functions ..
227  INTRINSIC max
228 * ..
229 * .. Data statements ..
230  DATA iseedy / 1988, 1989, 1990, 1991 /
231  DATA uplos / 'U', 'L' / , packs / 'C', 'R' /
232 * ..
233 * .. Executable Statements ..
234 *
235 * Initialize constants and the random number seed.
236 *
237  path( 1: 1 ) = 'Single precision'
238  path( 2: 3 ) = 'PP'
239  nrun = 0
240  nfail = 0
241  nerrs = 0
242  DO 10 i = 1, 4
243  iseed( i ) = iseedy( i )
244  10 CONTINUE
245 *
246 * Test the error exits
247 *
248  IF( tsterr )
249  $ CALL serrpo( path, nout )
250  infot = 0
251 *
252 * Do for each value of N in NVAL
253 *
254  DO 110 in = 1, nn
255  n = nval( in )
256  lda = max( n, 1 )
257  xtype = 'N'
258  nimat = ntypes
259  IF( n.LE.0 )
260  $ nimat = 1
261 *
262  DO 100 imat = 1, nimat
263 *
264 * Do the tests only if DOTYPE( IMAT ) is true.
265 *
266  IF( .NOT.dotype( imat ) )
267  $ GO TO 100
268 *
269 * Skip types 3, 4, or 5 if the matrix size is too small.
270 *
271  zerot = imat.GE.3 .AND. imat.LE.5
272  IF( zerot .AND. n.LT.imat-2 )
273  $ GO TO 100
274 *
275 * Do first for UPLO = 'U', then for UPLO = 'L'
276 *
277  DO 90 iuplo = 1, 2
278  uplo = uplos( iuplo )
279  packit = packs( iuplo )
280 *
281 * Set up parameters with SLATB4 and generate a test matrix
282 * with SLATMS.
283 *
284  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
285  $ cndnum, dist )
286 *
287  srnamt = 'SLATMS'
288  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode,
289  $ cndnum, anorm, kl, ku, packit, a, lda, work,
290  $ info )
291 *
292 * Check error code from SLATMS.
293 *
294  IF( info.NE.0 ) THEN
295  CALL alaerh( path, 'SLATMS', info, 0, uplo, n, n, -1,
296  $ -1, -1, imat, nfail, nerrs, nout )
297  GO TO 90
298  END IF
299 *
300 * For types 3-5, zero one row and column of the matrix to
301 * test that INFO is returned correctly.
302 *
303  IF( zerot ) THEN
304  IF( imat.EQ.3 ) THEN
305  izero = 1
306  ELSE IF( imat.EQ.4 ) THEN
307  izero = n
308  ELSE
309  izero = n / 2 + 1
310  END IF
311 *
312 * Set row and column IZERO of A to 0.
313 *
314  IF( iuplo.EQ.1 ) THEN
315  ioff = ( izero-1 )*izero / 2
316  DO 20 i = 1, izero - 1
317  a( ioff+i ) = zero
318  20 CONTINUE
319  ioff = ioff + izero
320  DO 30 i = izero, n
321  a( ioff ) = zero
322  ioff = ioff + i
323  30 CONTINUE
324  ELSE
325  ioff = izero
326  DO 40 i = 1, izero - 1
327  a( ioff ) = zero
328  ioff = ioff + n - i
329  40 CONTINUE
330  ioff = ioff - izero
331  DO 50 i = izero, n
332  a( ioff+i ) = zero
333  50 CONTINUE
334  END IF
335  ELSE
336  izero = 0
337  END IF
338 *
339 * Compute the L*L' or U'*U factorization of the matrix.
340 *
341  npp = n*( n+1 ) / 2
342  CALL scopy( npp, a, 1, afac, 1 )
343  srnamt = 'SPPTRF'
344  CALL spptrf( uplo, n, afac, info )
345 *
346 * Check error code from SPPTRF.
347 *
348  IF( info.NE.izero ) THEN
349  CALL alaerh( path, 'SPPTRF', info, izero, uplo, n, n,
350  $ -1, -1, -1, imat, nfail, nerrs, nout )
351  GO TO 90
352  END IF
353 *
354 * Skip the tests if INFO is not 0.
355 *
356  IF( info.NE.0 )
357  $ GO TO 90
358 *
359 *+ TEST 1
360 * Reconstruct matrix from factors and compute residual.
361 *
362  CALL scopy( npp, afac, 1, ainv, 1 )
363  CALL sppt01( uplo, n, a, ainv, rwork, result( 1 ) )
364 *
365 *+ TEST 2
366 * Form the inverse and compute the residual.
367 *
368  CALL scopy( npp, afac, 1, ainv, 1 )
369  srnamt = 'SPPTRI'
370  CALL spptri( uplo, n, ainv, info )
371 *
372 * Check error code from SPPTRI.
373 *
374  IF( info.NE.0 )
375  $ CALL alaerh( path, 'SPPTRI', info, 0, uplo, n, n, -1,
376  $ -1, -1, imat, nfail, nerrs, nout )
377 *
378  CALL sppt03( uplo, n, a, ainv, work, lda, rwork, rcondc,
379  $ result( 2 ) )
380 *
381 * Print information about the tests that did not pass
382 * the threshold.
383 *
384  DO 60 k = 1, 2
385  IF( result( k ).GE.thresh ) THEN
386  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
387  $ CALL alahd( nout, path )
388  WRITE( nout, fmt = 9999 )uplo, n, imat, k,
389  $ result( k )
390  nfail = nfail + 1
391  END IF
392  60 CONTINUE
393  nrun = nrun + 2
394 *
395  DO 80 irhs = 1, nns
396  nrhs = nsval( irhs )
397 *
398 *+ TEST 3
399 * Solve and compute residual for A * X = B.
400 *
401  srnamt = 'SLARHS'
402  CALL slarhs( path, xtype, uplo, ' ', n, n, kl, ku,
403  $ nrhs, a, lda, xact, lda, b, lda, iseed,
404  $ info )
405  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
406 *
407  srnamt = 'SPPTRS'
408  CALL spptrs( uplo, n, nrhs, afac, x, lda, info )
409 *
410 * Check error code from SPPTRS.
411 *
412  IF( info.NE.0 )
413  $ CALL alaerh( path, 'SPPTRS', info, 0, uplo, n, n,
414  $ -1, -1, nrhs, imat, nfail, nerrs,
415  $ nout )
416 *
417  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
418  CALL sppt02( uplo, n, nrhs, a, x, lda, work, lda,
419  $ rwork, result( 3 ) )
420 *
421 *+ TEST 4
422 * Check solution from generated exact solution.
423 *
424  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
425  $ result( 4 ) )
426 *
427 *+ TESTS 5, 6, and 7
428 * Use iterative refinement to improve the solution.
429 *
430  srnamt = 'SPPRFS'
431  CALL spprfs( uplo, n, nrhs, a, afac, b, lda, x, lda,
432  $ rwork, rwork( nrhs+1 ), work, iwork,
433  $ info )
434 *
435 * Check error code from SPPRFS.
436 *
437  IF( info.NE.0 )
438  $ CALL alaerh( path, 'SPPRFS', info, 0, uplo, n, n,
439  $ -1, -1, nrhs, imat, nfail, nerrs,
440  $ nout )
441 *
442  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
443  $ result( 5 ) )
444  CALL sppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
445  $ lda, rwork, rwork( nrhs+1 ),
446  $ result( 6 ) )
447 *
448 * Print information about the tests that did not pass
449 * the threshold.
450 *
451  DO 70 k = 3, 7
452  IF( result( k ).GE.thresh ) THEN
453  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
454  $ CALL alahd( nout, path )
455  WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
456  $ k, result( k )
457  nfail = nfail + 1
458  END IF
459  70 CONTINUE
460  nrun = nrun + 5
461  80 CONTINUE
462 *
463 *+ TEST 8
464 * Get an estimate of RCOND = 1/CNDNUM.
465 *
466  anorm = slansp( '1', uplo, n, a, rwork )
467  srnamt = 'SPPCON'
468  CALL sppcon( uplo, n, afac, anorm, rcond, work, iwork,
469  $ info )
470 *
471 * Check error code from SPPCON.
472 *
473  IF( info.NE.0 )
474  $ CALL alaerh( path, 'SPPCON', info, 0, uplo, n, n, -1,
475  $ -1, -1, imat, nfail, nerrs, nout )
476 *
477  result( 8 ) = sget06( rcond, rcondc )
478 *
479 * Print the test ratio if greater than or equal to THRESH.
480 *
481  IF( result( 8 ).GE.thresh ) THEN
482  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
483  $ CALL alahd( nout, path )
484  WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
485  $ result( 8 )
486  nfail = nfail + 1
487  END IF
488  nrun = nrun + 1
489  90 CONTINUE
490  100 CONTINUE
491  110 CONTINUE
492 *
493 * Print a summary of the results.
494 *
495  CALL alasum( path, nout, nfail, nrun, nerrs )
496 *
497  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', type ', i2, ', test ',
498  $ i2, ', ratio =', g12.5 )
499  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
500  $ i2, ', test(', i2, ') =', g12.5 )
501  RETURN
502 *
503 * End of SCHKPP
504 *
real function slansp(NORM, UPLO, N, AP, WORK)
SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
Definition: slansp.f:116
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine sppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
SPPT02
Definition: sppt02.f:124
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine sppt01(UPLO, N, A, AFAC, RWORK, RESID)
SPPT01
Definition: sppt01.f:95
subroutine serrpo(PATH, NUNIT)
SERRPO
Definition: serrpo.f:57
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
Definition: spprfs.f:173
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
Definition: sppcon.f:120
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
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 sppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPPT05
Definition: sppt05.f:158
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
Definition: spptrf.f:121
subroutine spptri(UPLO, N, AP, INFO)
SPPTRI
Definition: spptri.f:95
subroutine spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS
Definition: spptrs.f:110
subroutine sppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPPT03
Definition: sppt03.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkps ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NRANK,
integer, dimension( * )  RANKVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  PERM,
integer, dimension( * )  PIV,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

SCHKPS

Purpose:
 SCHKPS tests SPSTRF.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the block size NB.
[in]NRANK
          NRANK is INTEGER
          The number of values of RANK contained in the vector RANKVAL.
[in]RANKVAL
          RANKVAL is INTEGER array, dimension (NBVAL)
          The values of the block size NB.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]PERM
          PERM is REAL array, dimension (NMAX*NMAX)
[out]PIV
          PIV is INTEGER array, dimension (NMAX)
[out]WORK
          WORK is REAL array, dimension (NMAX*3)
[out]RWORK
          RWORK is REAL array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 156 of file schkps.f.

156 *
157 * -- LAPACK test routine (version 3.4.0) --
158 * -- LAPACK is a software package provided by Univ. of Tennessee, --
159 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
160 * November 2011
161 *
162 * .. Scalar Arguments ..
163  REAL thresh
164  INTEGER nmax, nn, nnb, nout, nrank
165  LOGICAL tsterr
166 * ..
167 * .. Array Arguments ..
168  REAL a( * ), afac( * ), perm( * ), rwork( * ),
169  $ work( * )
170  INTEGER nbval( * ), nval( * ), piv( * ), rankval( * )
171  LOGICAL dotype( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  REAL one
178  parameter( one = 1.0e+0 )
179  INTEGER ntypes
180  parameter( ntypes = 9 )
181 * ..
182 * .. Local Scalars ..
183  REAL anorm, cndnum, result, tol
184  INTEGER comprank, i, imat, in, inb, info, irank, iuplo,
185  $ izero, kl, ku, lda, mode, n, nb, nerrs, nfail,
186  $ nimat, nrun, rank, rankdiff
187  CHARACTER dist, TYPE, uplo
188  CHARACTER*3 path
189 * ..
190 * .. Local Arrays ..
191  INTEGER iseed( 4 ), iseedy( 4 )
192  CHARACTER uplos( 2 )
193 * ..
194 * .. External Subroutines ..
195  EXTERNAL alaerh, alahd, alasum, serrps, slacpy, slatb5,
197 * ..
198 * .. Scalars in Common ..
199  INTEGER infot, nunit
200  LOGICAL lerr, ok
201  CHARACTER*32 srnamt
202 * ..
203 * .. Common blocks ..
204  COMMON / infoc / infot, nunit, ok, lerr
205  COMMON / srnamc / srnamt
206 * ..
207 * .. Intrinsic Functions ..
208  INTRINSIC max, REAL, ceiling
209 * ..
210 * .. Data statements ..
211  DATA iseedy / 1988, 1989, 1990, 1991 /
212  DATA uplos / 'U', 'L' /
213 * ..
214 * .. Executable Statements ..
215 *
216 * Initialize constants and the random number seed.
217 *
218  path( 1: 1 ) = 'Single Precision'
219  path( 2: 3 ) = 'PS'
220  nrun = 0
221  nfail = 0
222  nerrs = 0
223  DO 100 i = 1, 4
224  iseed( i ) = iseedy( i )
225  100 CONTINUE
226 *
227 * Test the error exits
228 *
229  IF( tsterr )
230  $ CALL serrps( path, nout )
231  infot = 0
232  CALL xlaenv( 2, 2 )
233 *
234 * Do for each value of N in NVAL
235 *
236  DO 150 in = 1, nn
237  n = nval( in )
238  lda = max( n, 1 )
239  nimat = ntypes
240  IF( n.LE.0 )
241  $ nimat = 1
242 *
243  izero = 0
244  DO 140 imat = 1, nimat
245 *
246 * Do the tests only if DOTYPE( IMAT ) is true.
247 *
248  IF( .NOT.dotype( imat ) )
249  $ GO TO 140
250 *
251 * Do for each value of RANK in RANKVAL
252 *
253  DO 130 irank = 1, nrank
254 *
255 * Only repeat test 3 to 5 for different ranks
256 * Other tests use full rank
257 *
258  IF( ( imat.LT.3 .OR. imat.GT.5 ) .AND. irank.GT.1 )
259  $ GO TO 130
260 *
261  rank = ceiling( ( n * REAL( RANKVAL( IRANK ) ) )
262  $ / 100.e+0 )
263 *
264 *
265 * Do first for UPLO = 'U', then for UPLO = 'L'
266 *
267  DO 120 iuplo = 1, 2
268  uplo = uplos( iuplo )
269 *
270 * Set up parameters with SLATB5 and generate a test matrix
271 * with SLATMT.
272 *
273  CALL slatb5( path, imat, n, TYPE, kl, ku, anorm,
274  $ mode, cndnum, dist )
275 *
276  srnamt = 'SLATMT'
277  CALL slatmt( n, n, dist, iseed, TYPE, rwork, mode,
278  $ cndnum, anorm, rank, kl, ku, uplo, a,
279  $ lda, work, info )
280 *
281 * Check error code from SLATMT.
282 *
283  IF( info.NE.0 ) THEN
284  CALL alaerh( path, 'SLATMT', info, 0, uplo, n,
285  $ n, -1, -1, -1, imat, nfail, nerrs,
286  $ nout )
287  GO TO 120
288  END IF
289 *
290 * Do for each value of NB in NBVAL
291 *
292  DO 110 inb = 1, nnb
293  nb = nbval( inb )
294  CALL xlaenv( 1, nb )
295 *
296 * Compute the pivoted L*L' or U'*U factorization
297 * of the matrix.
298 *
299  CALL slacpy( uplo, n, n, a, lda, afac, lda )
300  srnamt = 'SPSTRF'
301 *
302 * Use default tolerance
303 *
304  tol = -one
305  CALL spstrf( uplo, n, afac, lda, piv, comprank,
306  $ tol, work, info )
307 *
308 * Check error code from SPSTRF.
309 *
310  IF( (info.LT.izero)
311  $ .OR.(info.NE.izero.AND.rank.EQ.n)
312  $ .OR.(info.LE.izero.AND.rank.LT.n) ) THEN
313  CALL alaerh( path, 'SPSTRF', info, izero,
314  $ uplo, n, n, -1, -1, nb, imat,
315  $ nfail, nerrs, nout )
316  GO TO 110
317  END IF
318 *
319 * Skip the test if INFO is not 0.
320 *
321  IF( info.NE.0 )
322  $ GO TO 110
323 *
324 * Reconstruct matrix from factors and compute residual.
325 *
326 * PERM holds permuted L*L^T or U^T*U
327 *
328  CALL spst01( uplo, n, a, lda, afac, lda, perm, lda,
329  $ piv, rwork, result, comprank )
330 *
331 * Print information about the tests that did not pass
332 * the threshold or where computed rank was not RANK.
333 *
334  IF( n.EQ.0 )
335  $ comprank = 0
336  rankdiff = rank - comprank
337  IF( result.GE.thresh ) THEN
338  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
339  $ CALL alahd( nout, path )
340  WRITE( nout, fmt = 9999 )uplo, n, rank,
341  $ rankdiff, nb, imat, result
342  nfail = nfail + 1
343  END IF
344  nrun = nrun + 1
345  110 CONTINUE
346 *
347  120 CONTINUE
348  130 CONTINUE
349  140 CONTINUE
350  150 CONTINUE
351 *
352 * Print a summary of the results.
353 *
354  CALL alasum( path, nout, nfail, nrun, nerrs )
355 *
356  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', RANK =', i3,
357  $ ', Diff =', i5, ', NB =', i4, ', type ', i2, ', Ratio =',
358  $ g12.5 )
359  RETURN
360 *
361 * End of SCHKPS
362 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine spstrf(UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO)
SPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semide...
Definition: spstrf.f:143
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine slatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB5
Definition: slatb5.f:116
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 serrps(PATH, NUNIT)
SERRPS
Definition: serrps.f:57
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine slatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMT
Definition: slatmt.f:333
subroutine spst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
SPST01
Definition: spst01.f:136

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkpt ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
real, dimension( * )  A,
real, dimension( * )  D,
real, dimension( * )  E,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

SCHKPT

Purpose:
 SCHKPT tests SPTTRF, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is REAL array, dimension (NMAX*2)
[out]D
          D is REAL array, dimension (NMAX*2)
[out]E
          E is REAL array, dimension (NMAX*2)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(NMAX,2*NSMAX))
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 148 of file schkpt.f.

148 *
149 * -- LAPACK test routine (version 3.4.0) --
150 * -- LAPACK is a software package provided by Univ. of Tennessee, --
151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
152 * November 2011
153 *
154 * .. Scalar Arguments ..
155  LOGICAL tsterr
156  INTEGER nn, nns, nout
157  REAL thresh
158 * ..
159 * .. Array Arguments ..
160  LOGICAL dotype( * )
161  INTEGER nsval( * ), nval( * )
162  REAL a( * ), b( * ), d( * ), e( * ), rwork( * ),
163  $ work( * ), x( * ), xact( * )
164 * ..
165 *
166 * =====================================================================
167 *
168 * .. Parameters ..
169  REAL one, zero
170  parameter( one = 1.0e+0, zero = 0.0e+0 )
171  INTEGER ntypes
172  parameter( ntypes = 12 )
173  INTEGER ntests
174  parameter( ntests = 7 )
175 * ..
176 * .. Local Scalars ..
177  LOGICAL zerot
178  CHARACTER dist, type
179  CHARACTER*3 path
180  INTEGER i, ia, imat, in, info, irhs, ix, izero, j, k,
181  $ kl, ku, lda, mode, n, nerrs, nfail, nimat,
182  $ nrhs, nrun
183  REAL ainvnm, anorm, cond, dmax, rcond, rcondc
184 * ..
185 * .. Local Arrays ..
186  INTEGER iseed( 4 ), iseedy( 4 )
187  REAL result( ntests ), z( 3 )
188 * ..
189 * .. External Functions ..
190  INTEGER isamax
191  REAL sasum, sget06, slanst
192  EXTERNAL isamax, sasum, sget06, slanst
193 * ..
194 * .. External Subroutines ..
195  EXTERNAL alaerh, alahd, alasum, scopy, serrgt, sget04,
198  $ sscal
199 * ..
200 * .. Intrinsic Functions ..
201  INTRINSIC abs, max
202 * ..
203 * .. Scalars in Common ..
204  LOGICAL lerr, ok
205  CHARACTER*32 srnamt
206  INTEGER infot, nunit
207 * ..
208 * .. Common blocks ..
209  COMMON / infoc / infot, nunit, ok, lerr
210  COMMON / srnamc / srnamt
211 * ..
212 * .. Data statements ..
213  DATA iseedy / 0, 0, 0, 1 /
214 * ..
215 * .. Executable Statements ..
216 *
217  path( 1: 1 ) = 'Single precision'
218  path( 2: 3 ) = 'PT'
219  nrun = 0
220  nfail = 0
221  nerrs = 0
222  DO 10 i = 1, 4
223  iseed( i ) = iseedy( i )
224  10 CONTINUE
225 *
226 * Test the error exits
227 *
228  IF( tsterr )
229  $ CALL serrgt( path, nout )
230  infot = 0
231 *
232  DO 110 in = 1, nn
233 *
234 * Do for each value of N in NVAL.
235 *
236  n = nval( in )
237  lda = max( 1, n )
238  nimat = ntypes
239  IF( n.LE.0 )
240  $ nimat = 1
241 *
242  DO 100 imat = 1, nimat
243 *
244 * Do the tests only if DOTYPE( IMAT ) is true.
245 *
246  IF( n.GT.0 .AND. .NOT.dotype( imat ) )
247  $ GO TO 100
248 *
249 * Set up parameters with SLATB4.
250 *
251  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
252  $ cond, dist )
253 *
254  zerot = imat.GE.8 .AND. imat.LE.10
255  IF( imat.LE.6 ) THEN
256 *
257 * Type 1-6: generate a symmetric tridiagonal matrix of
258 * known condition number in lower triangular band storage.
259 *
260  srnamt = 'SLATMS'
261  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode, cond,
262  $ anorm, kl, ku, 'B', a, 2, work, info )
263 *
264 * Check the error code from SLATMS.
265 *
266  IF( info.NE.0 ) THEN
267  CALL alaerh( path, 'SLATMS', info, 0, ' ', n, n, kl,
268  $ ku, -1, imat, nfail, nerrs, nout )
269  GO TO 100
270  END IF
271  izero = 0
272 *
273 * Copy the matrix to D and E.
274 *
275  ia = 1
276  DO 20 i = 1, n - 1
277  d( i ) = a( ia )
278  e( i ) = a( ia+1 )
279  ia = ia + 2
280  20 CONTINUE
281  IF( n.GT.0 )
282  $ d( n ) = a( ia )
283  ELSE
284 *
285 * Type 7-12: generate a diagonally dominant matrix with
286 * unknown condition number in the vectors D and E.
287 *
288  IF( .NOT.zerot .OR. .NOT.dotype( 7 ) ) THEN
289 *
290 * Let D and E have values from [-1,1].
291 *
292  CALL slarnv( 2, iseed, n, d )
293  CALL slarnv( 2, iseed, n-1, e )
294 *
295 * Make the tridiagonal matrix diagonally dominant.
296 *
297  IF( n.EQ.1 ) THEN
298  d( 1 ) = abs( d( 1 ) )
299  ELSE
300  d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
301  d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
302  DO 30 i = 2, n - 1
303  d( i ) = abs( d( i ) ) + abs( e( i ) ) +
304  $ abs( e( i-1 ) )
305  30 CONTINUE
306  END IF
307 *
308 * Scale D and E so the maximum element is ANORM.
309 *
310  ix = isamax( n, d, 1 )
311  dmax = d( ix )
312  CALL sscal( n, anorm / dmax, d, 1 )
313  CALL sscal( n-1, anorm / dmax, e, 1 )
314 *
315  ELSE IF( izero.GT.0 ) THEN
316 *
317 * Reuse the last matrix by copying back the zeroed out
318 * elements.
319 *
320  IF( izero.EQ.1 ) THEN
321  d( 1 ) = z( 2 )
322  IF( n.GT.1 )
323  $ e( 1 ) = z( 3 )
324  ELSE IF( izero.EQ.n ) THEN
325  e( n-1 ) = z( 1 )
326  d( n ) = z( 2 )
327  ELSE
328  e( izero-1 ) = z( 1 )
329  d( izero ) = z( 2 )
330  e( izero ) = z( 3 )
331  END IF
332  END IF
333 *
334 * For types 8-10, set one row and column of the matrix to
335 * zero.
336 *
337  izero = 0
338  IF( imat.EQ.8 ) THEN
339  izero = 1
340  z( 2 ) = d( 1 )
341  d( 1 ) = zero
342  IF( n.GT.1 ) THEN
343  z( 3 ) = e( 1 )
344  e( 1 ) = zero
345  END IF
346  ELSE IF( imat.EQ.9 ) THEN
347  izero = n
348  IF( n.GT.1 ) THEN
349  z( 1 ) = e( n-1 )
350  e( n-1 ) = zero
351  END IF
352  z( 2 ) = d( n )
353  d( n ) = zero
354  ELSE IF( imat.EQ.10 ) THEN
355  izero = ( n+1 ) / 2
356  IF( izero.GT.1 ) THEN
357  z( 1 ) = e( izero-1 )
358  e( izero-1 ) = zero
359  z( 3 ) = e( izero )
360  e( izero ) = zero
361  END IF
362  z( 2 ) = d( izero )
363  d( izero ) = zero
364  END IF
365  END IF
366 *
367  CALL scopy( n, d, 1, d( n+1 ), 1 )
368  IF( n.GT.1 )
369  $ CALL scopy( n-1, e, 1, e( n+1 ), 1 )
370 *
371 *+ TEST 1
372 * Factor A as L*D*L' and compute the ratio
373 * norm(L*D*L' - A) / (n * norm(A) * EPS )
374 *
375  CALL spttrf( n, d( n+1 ), e( n+1 ), info )
376 *
377 * Check error code from SPTTRF.
378 *
379  IF( info.NE.izero ) THEN
380  CALL alaerh( path, 'SPTTRF', info, izero, ' ', n, n, -1,
381  $ -1, -1, imat, nfail, nerrs, nout )
382  GO TO 100
383  END IF
384 *
385  IF( info.GT.0 ) THEN
386  rcondc = zero
387  GO TO 90
388  END IF
389 *
390  CALL sptt01( n, d, e, d( n+1 ), e( n+1 ), work,
391  $ result( 1 ) )
392 *
393 * Print the test ratio if greater than or equal to THRESH.
394 *
395  IF( result( 1 ).GE.thresh ) THEN
396  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
397  $ CALL alahd( nout, path )
398  WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
399  nfail = nfail + 1
400  END IF
401  nrun = nrun + 1
402 *
403 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
404 *
405 * Compute norm(A).
406 *
407  anorm = slanst( '1', n, d, e )
408 *
409 * Use SPTTRS to solve for one column at a time of inv(A),
410 * computing the maximum column sum as we go.
411 *
412  ainvnm = zero
413  DO 50 i = 1, n
414  DO 40 j = 1, n
415  x( j ) = zero
416  40 CONTINUE
417  x( i ) = one
418  CALL spttrs( n, 1, d( n+1 ), e( n+1 ), x, lda, info )
419  ainvnm = max( ainvnm, sasum( n, x, 1 ) )
420  50 CONTINUE
421  rcondc = one / max( one, anorm*ainvnm )
422 *
423  DO 80 irhs = 1, nns
424  nrhs = nsval( irhs )
425 *
426 * Generate NRHS random solution vectors.
427 *
428  ix = 1
429  DO 60 j = 1, nrhs
430  CALL slarnv( 2, iseed, n, xact( ix ) )
431  ix = ix + lda
432  60 CONTINUE
433 *
434 * Set the right hand side.
435 *
436  CALL slaptm( n, nrhs, one, d, e, xact, lda, zero, b,
437  $ lda )
438 *
439 *+ TEST 2
440 * Solve A*x = b and compute the residual.
441 *
442  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
443  CALL spttrs( n, nrhs, d( n+1 ), e( n+1 ), x, lda, info )
444 *
445 * Check error code from SPTTRS.
446 *
447  IF( info.NE.0 )
448  $ CALL alaerh( path, 'SPTTRS', info, 0, ' ', n, n, -1,
449  $ -1, nrhs, imat, nfail, nerrs, nout )
450 *
451  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
452  CALL sptt02( n, nrhs, d, e, x, lda, work, lda,
453  $ result( 2 ) )
454 *
455 *+ TEST 3
456 * Check solution from generated exact solution.
457 *
458  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
459  $ result( 3 ) )
460 *
461 *+ TESTS 4, 5, and 6
462 * Use iterative refinement to improve the solution.
463 *
464  srnamt = 'SPTRFS'
465  CALL sptrfs( n, nrhs, d, e, d( n+1 ), e( n+1 ), b, lda,
466  $ x, lda, rwork, rwork( nrhs+1 ), work, info )
467 *
468 * Check error code from SPTRFS.
469 *
470  IF( info.NE.0 )
471  $ CALL alaerh( path, 'SPTRFS', info, 0, ' ', n, n, -1,
472  $ -1, nrhs, imat, nfail, nerrs, nout )
473 *
474  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
475  $ result( 4 ) )
476  CALL sptt05( n, nrhs, d, e, b, lda, x, lda, xact, lda,
477  $ rwork, rwork( nrhs+1 ), result( 5 ) )
478 *
479 * Print information about the tests that did not pass the
480 * threshold.
481 *
482  DO 70 k = 2, 6
483  IF( result( k ).GE.thresh ) THEN
484  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
485  $ CALL alahd( nout, path )
486  WRITE( nout, fmt = 9998 )n, nrhs, imat, k,
487  $ result( k )
488  nfail = nfail + 1
489  END IF
490  70 CONTINUE
491  nrun = nrun + 5
492  80 CONTINUE
493 *
494 *+ TEST 7
495 * Estimate the reciprocal of the condition number of the
496 * matrix.
497 *
498  90 CONTINUE
499  srnamt = 'SPTCON'
500  CALL sptcon( n, d( n+1 ), e( n+1 ), anorm, rcond, rwork,
501  $ info )
502 *
503 * Check error code from SPTCON.
504 *
505  IF( info.NE.0 )
506  $ CALL alaerh( path, 'SPTCON', info, 0, ' ', n, n, -1, -1,
507  $ -1, imat, nfail, nerrs, nout )
508 *
509  result( 7 ) = sget06( rcond, rcondc )
510 *
511 * Print the test ratio if greater than or equal to THRESH.
512 *
513  IF( result( 7 ).GE.thresh ) THEN
514  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
515  $ CALL alahd( nout, path )
516  WRITE( nout, fmt = 9999 )n, imat, 7, result( 7 )
517  nfail = nfail + 1
518  END IF
519  nrun = nrun + 1
520  100 CONTINUE
521  110 CONTINUE
522 *
523 * Print a summary of the results.
524 *
525  CALL alasum( path, nout, nfail, nrun, nerrs )
526 *
527  9999 FORMAT( ' N =', i5, ', type ', i2, ', test ', i2, ', ratio = ',
528  $ g12.5 )
529  9998 FORMAT( ' N =', i5, ', NRHS=', i3, ', type ', i2, ', test(', i2,
530  $ ') = ', g12.5 )
531  RETURN
532 *
533 * End of SCHKPT
534 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine serrgt(PATH, NUNIT)
SERRGT
Definition: serrgt.f:57
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine slaptm(N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
SLAPTM
Definition: slaptm.f:118
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine sptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
SPTRFS
Definition: sptrfs.f:165
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine sptt01(N, D, E, DF, EF, WORK, RESID)
SPTT01
Definition: sptt01.f:93
real function slanst(NORM, N, D, E)
SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
Definition: slanst.f:102
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:54
subroutine sptcon(N, D, E, ANORM, RCOND, WORK, INFO)
SPTCON
Definition: sptcon.f:120
subroutine spttrf(N, D, E, INFO)
SPTTRF
Definition: spttrf.f:93
subroutine sptt02(N, NRHS, D, E, X, LDX, B, LDB, RESID)
SPTT02
Definition: sptt02.f:106
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:55
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 spttrs(N, NRHS, D, E, B, LDB, INFO)
SPTTRS
Definition: spttrs.f:111
subroutine sptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPTT05
Definition: sptt05.f:152
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: slarnv.f:99

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkq3 ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer, dimension( * )  NXVAL,
real  THRESH,
real, dimension( * )  A,
real, dimension( * )  COPYA,
real, dimension( * )  S,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKQ3

Purpose:
 SCHKQ3 tests SGEQP3.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB and NX contained in the
          vectors NBVAL and NXVAL.  The blocking parameters are used
          in pairs (NB,NX).
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NXVAL
          NXVAL is INTEGER array, dimension (NNB)
          The values of the crossover point NX.
[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.
[out]A
          A is REAL array, dimension (MMAX*NMAX)
          where MMAX is the maximum value of M in MVAL and NMAX is the
          maximum value of N in NVAL.
[out]COPYA
          COPYA is REAL array, dimension (MMAX*NMAX)
[out]S
          S is REAL array, dimension
                      (min(MMAX,NMAX))
[out]TAU
          TAU is REAL array, dimension (MMAX)
[out]WORK
          WORK is REAL array, dimension
                      (MMAX*NMAX + 4*NMAX + MMAX)
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 155 of file schkq3.f.

155 *
156 * -- LAPACK test routine (version 3.4.0) --
157 * -- LAPACK is a software package provided by Univ. of Tennessee, --
158 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159 * November 2011
160 *
161 * .. Scalar Arguments ..
162  INTEGER nm, nn, nnb, nout
163  REAL thresh
164 * ..
165 * .. Array Arguments ..
166  LOGICAL dotype( * )
167  INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
168  $ nxval( * )
169  REAL a( * ), copya( * ), s( * ),
170  $ tau( * ), work( * )
171 * ..
172 *
173 * =====================================================================
174 *
175 * .. Parameters ..
176  INTEGER ntypes
177  parameter( ntypes = 6 )
178  INTEGER ntests
179  parameter( ntests = 3 )
180  REAL one, zero
181  parameter( one = 1.0e0, zero = 0.0e0 )
182 * ..
183 * .. Local Scalars ..
184  CHARACTER*3 path
185  INTEGER i, ihigh, ilow, im, imode, in, inb, info,
186  $ istep, k, lda, lw, lwork, m, mnmin, mode, n,
187  $ nb, nerrs, nfail, nrun, nx
188  REAL eps
189 * ..
190 * .. Local Arrays ..
191  INTEGER iseed( 4 ), iseedy( 4 )
192  REAL result( ntests )
193 * ..
194 * .. External Functions ..
195  REAL slamch, sqpt01, sqrt11, sqrt12
196  EXTERNAL slamch, sqpt01, sqrt11, sqrt12
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL alahd, alasum, icopy, sgeqp3, slacpy, slaord,
200  $ slaset, slatms, xlaenv
201 * ..
202 * .. Intrinsic Functions ..
203  INTRINSIC max, min
204 * ..
205 * .. Scalars in Common ..
206  LOGICAL lerr, ok
207  CHARACTER*32 srnamt
208  INTEGER infot, iounit
209 * ..
210 * .. Common blocks ..
211  COMMON / infoc / infot, iounit, ok, lerr
212  COMMON / srnamc / srnamt
213 * ..
214 * .. Data statements ..
215  DATA iseedy / 1988, 1989, 1990, 1991 /
216 * ..
217 * .. Executable Statements ..
218 *
219 * Initialize constants and the random number seed.
220 *
221  path( 1: 1 ) = 'Single precision'
222  path( 2: 3 ) = 'Q3'
223  nrun = 0
224  nfail = 0
225  nerrs = 0
226  DO 10 i = 1, 4
227  iseed( i ) = iseedy( i )
228  10 CONTINUE
229  eps = slamch( 'Epsilon' )
230  infot = 0
231 *
232  DO 90 im = 1, nm
233 *
234 * Do for each value of M in MVAL.
235 *
236  m = mval( im )
237  lda = max( 1, m )
238 *
239  DO 80 in = 1, nn
240 *
241 * Do for each value of N in NVAL.
242 *
243  n = nval( in )
244  mnmin = min( m, n )
245  lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ),
246  $ m*n + 2*mnmin + 4*n )
247 *
248  DO 70 imode = 1, ntypes
249  IF( .NOT.dotype( imode ) )
250  $ GO TO 70
251 *
252 * Do for each type of matrix
253 * 1: zero matrix
254 * 2: one small singular value
255 * 3: geometric distribution of singular values
256 * 4: first n/2 columns fixed
257 * 5: last n/2 columns fixed
258 * 6: every second column fixed
259 *
260  mode = imode
261  IF( imode.GT.3 )
262  $ mode = 1
263 *
264 * Generate test matrix of size m by n using
265 * singular value distribution indicated by `mode'.
266 *
267  DO 20 i = 1, n
268  iwork( i ) = 0
269  20 CONTINUE
270  IF( imode.EQ.1 ) THEN
271  CALL slaset( 'Full', m, n, zero, zero, copya, lda )
272  DO 30 i = 1, mnmin
273  s( i ) = zero
274  30 CONTINUE
275  ELSE
276  CALL slatms( m, n, 'Uniform', iseed, 'Nonsymm', s,
277  $ mode, one / eps, one, m, n, 'No packing',
278  $ copya, lda, work, info )
279  IF( imode.GE.4 ) THEN
280  IF( imode.EQ.4 ) THEN
281  ilow = 1
282  istep = 1
283  ihigh = max( 1, n / 2 )
284  ELSE IF( imode.EQ.5 ) THEN
285  ilow = max( 1, n / 2 )
286  istep = 1
287  ihigh = n
288  ELSE IF( imode.EQ.6 ) THEN
289  ilow = 1
290  istep = 2
291  ihigh = n
292  END IF
293  DO 40 i = ilow, ihigh, istep
294  iwork( i ) = 1
295  40 CONTINUE
296  END IF
297  CALL slaord( 'Decreasing', mnmin, s, 1 )
298  END IF
299 *
300  DO 60 inb = 1, nnb
301 *
302 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
303 *
304  nb = nbval( inb )
305  CALL xlaenv( 1, nb )
306  nx = nxval( inb )
307  CALL xlaenv( 3, nx )
308 *
309 * Get a working copy of COPYA into A and a copy of
310 * vector IWORK.
311 *
312  CALL slacpy( 'All', m, n, copya, lda, a, lda )
313  CALL icopy( n, iwork( 1 ), 1, iwork( n+1 ), 1 )
314 *
315 * Compute the QR factorization with pivoting of A
316 *
317  lw = max( 1, 2*n+nb*( n+1 ) )
318 *
319 * Compute the QP3 factorization of A
320 *
321  srnamt = 'SGEQP3'
322  CALL sgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
323  $ lw, info )
324 *
325 * Compute norm(svd(a) - svd(r))
326 *
327  result( 1 ) = sqrt12( m, n, a, lda, s, work,
328  $ lwork )
329 *
330 * Compute norm( A*P - Q*R )
331 *
332  result( 2 ) = sqpt01( m, n, mnmin, copya, a, lda, tau,
333  $ iwork( n+1 ), work, lwork )
334 *
335 * Compute Q'*Q
336 *
337  result( 3 ) = sqrt11( m, mnmin, a, lda, tau, work,
338  $ lwork )
339 *
340 * Print information about the tests that did not pass
341 * the threshold.
342 *
343  DO 50 k = 1, ntests
344  IF( result( k ).GE.thresh ) THEN
345  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
346  $ CALL alahd( nout, path )
347  WRITE( nout, fmt = 9999 )'SGEQP3', m, n, nb,
348  $ imode, k, result( k )
349  nfail = nfail + 1
350  END IF
351  50 CONTINUE
352  nrun = nrun + ntests
353 *
354  60 CONTINUE
355  70 CONTINUE
356  80 CONTINUE
357  90 CONTINUE
358 *
359 * Print a summary of the results.
360 *
361  CALL alasum( path, nout, nfail, nrun, nerrs )
362 *
363  9999 FORMAT( 1x, a, ' M =', i5, ', N =', i5, ', NB =', i4, ', type ',
364  $ i2, ', test ', i2, ', ratio =', g12.5 )
365 *
366 * End of SCHKQ3
367 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
real function sqrt11(M, K, A, LDA, TAU, WORK, LWORK)
SQRT11
Definition: sqrt11.f:100
subroutine slaord(JOB, N, X, INCX)
SLAORD
Definition: slaord.f:75
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
Definition: icopy.f:77
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
Definition: sqrt12.f:91
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 sgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
SGEQP3
Definition: sgeqp3.f:153
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
real function sqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
SQPT01
Definition: sqpt01.f:122
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 schkql ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer, dimension( * )  NXVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AF,
real, dimension( * )  AQ,
real, dimension( * )  AL,
real, dimension( * )  AC,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

SCHKQL

Purpose:
 SCHKQL tests SGEQLF, SORGQL and SORMQL.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB and NX contained in the
          vectors NBVAL and NXVAL.  The blocking parameters are used
          in pairs (NB,NX).
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NXVAL
          NXVAL is INTEGER array, dimension (NNB)
          The values of the crossover point NX.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AF
          AF is REAL array, dimension (NMAX*NMAX)
[out]AQ
          AQ is REAL array, dimension (NMAX*NMAX)
[out]AL
          AL is REAL array, dimension (NMAX*NMAX)
[out]AC
          AC is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NRHS)
[out]X
          X is REAL array, dimension (NMAX*NRHS)
[out]XACT
          XACT is REAL array, dimension (NMAX*NRHS)
[out]TAU
          TAU is REAL array, dimension (NMAX)
[out]WORK
          WORK is REAL array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is REAL array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 198 of file schkql.f.

198 *
199 * -- LAPACK test routine (version 3.4.0) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * November 2011
203 *
204 * .. Scalar Arguments ..
205  LOGICAL tsterr
206  INTEGER nm, nmax, nn, nnb, nout, nrhs
207  REAL thresh
208 * ..
209 * .. Array Arguments ..
210  LOGICAL dotype( * )
211  INTEGER mval( * ), nbval( * ), nval( * ),
212  $ nxval( * )
213  REAL a( * ), ac( * ), af( * ), al( * ), aq( * ),
214  $ b( * ), rwork( * ), tau( * ), work( * ),
215  $ x( * ), xact( * )
216 * ..
217 *
218 * =====================================================================
219 *
220 * .. Parameters ..
221  INTEGER ntests
222  parameter( ntests = 7 )
223  INTEGER ntypes
224  parameter( ntypes = 8 )
225  REAL zero
226  parameter( zero = 0.0e0 )
227 * ..
228 * .. Local Scalars ..
229  CHARACTER dist, type
230  CHARACTER*3 path
231  INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
232  $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
233  $ nrun, nt, nx
234  REAL anorm, cndnum
235 * ..
236 * .. Local Arrays ..
237  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
238  REAL result( ntests )
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL alaerh, alahd, alasum, serrql, sgeqls, sget02,
243  $ sqlt03, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC max, min
247 * ..
248 * .. Scalars in Common ..
249  LOGICAL lerr, ok
250  CHARACTER*32 srnamt
251  INTEGER infot, nunit
252 * ..
253 * .. Common blocks ..
254  COMMON / infoc / infot, nunit, ok, lerr
255  COMMON / srnamc / srnamt
256 * ..
257 * .. Data statements ..
258  DATA iseedy / 1988, 1989, 1990, 1991 /
259 * ..
260 * .. Executable Statements ..
261 *
262 * Initialize constants and the random number seed.
263 *
264  path( 1: 1 ) = 'Single precision'
265  path( 2: 3 ) = 'QL'
266  nrun = 0
267  nfail = 0
268  nerrs = 0
269  DO 10 i = 1, 4
270  iseed( i ) = iseedy( i )
271  10 CONTINUE
272 *
273 * Test the error exits
274 *
275  IF( tsterr )
276  $ CALL serrql( path, nout )
277  infot = 0
278  CALL xlaenv( 2, 2 )
279 *
280  lda = nmax
281  lwork = nmax*max( nmax, nrhs )
282 *
283 * Do for each value of M in MVAL.
284 *
285  DO 70 im = 1, nm
286  m = mval( im )
287 *
288 * Do for each value of N in NVAL.
289 *
290  DO 60 in = 1, nn
291  n = nval( in )
292  minmn = min( m, n )
293  DO 50 imat = 1, ntypes
294 *
295 * Do the tests only if DOTYPE( IMAT ) is true.
296 *
297  IF( .NOT.dotype( imat ) )
298  $ GO TO 50
299 *
300 * Set up parameters with SLATB4 and generate a test matrix
301 * with SLATMS.
302 *
303  CALL slatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'SLATMS'
307  CALL slatms( m, n, dist, iseed, TYPE, rwork, mode,
308  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
309  $ work, info )
310 *
311 * Check error code from SLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'SLATMS', info, 0, ' ', m, n, -1,
315  $ -1, -1, imat, nfail, nerrs, nout )
316  GO TO 50
317  END IF
318 *
319 * Set some values for K: the first value must be MINMN,
320 * corresponding to the call of SQLT01; other values are
321 * used in the calls of SQLT02, and must not exceed MINMN.
322 *
323  kval( 1 ) = minmn
324  kval( 2 ) = 0
325  kval( 3 ) = 1
326  kval( 4 ) = minmn / 2
327  IF( minmn.EQ.0 ) THEN
328  nk = 1
329  ELSE IF( minmn.EQ.1 ) THEN
330  nk = 2
331  ELSE IF( minmn.LE.3 ) THEN
332  nk = 3
333  ELSE
334  nk = 4
335  END IF
336 *
337 * Do for each value of K in KVAL
338 *
339  DO 40 ik = 1, nk
340  k = kval( ik )
341 *
342 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
343 *
344  DO 30 inb = 1, nnb
345  nb = nbval( inb )
346  CALL xlaenv( 1, nb )
347  nx = nxval( inb )
348  CALL xlaenv( 3, nx )
349  DO i = 1, ntests
350  result( i ) = zero
351  END DO
352  nt = 2
353  IF( ik.EQ.1 ) THEN
354 *
355 * Test SGEQLF
356 *
357  CALL sqlt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.GE.n ) THEN
360 *
361 * Test SORGQL, using factorization
362 * returned by SQLT01
363 *
364  CALL sqlt02( m, n, k, a, af, aq, al, lda, tau,
365  $ work, lwork, rwork, result( 1 ) )
366  END IF
367  IF( m.GE.k ) THEN
368 *
369 * Test SORMQL, using factorization returned
370 * by SQLT01
371 *
372  CALL sqlt03( m, n, k, af, ac, al, aq, lda, tau,
373  $ work, lwork, rwork, result( 3 ) )
374  nt = nt + 4
375 *
376 * If M>=N and K=N, call SGEQLS to solve a system
377 * with NRHS right hand sides and compute the
378 * residual.
379 *
380  IF( k.EQ.n .AND. inb.EQ.1 ) THEN
381 *
382 * Generate a solution and set the right
383 * hand side.
384 *
385  srnamt = 'SLARHS'
386  CALL slarhs( path, 'New', 'Full',
387  $ 'No transpose', m, n, 0, 0,
388  $ nrhs, a, lda, xact, lda, b, lda,
389  $ iseed, info )
390 *
391  CALL slacpy( 'Full', m, nrhs, b, lda, x,
392  $ lda )
393  srnamt = 'SGEQLS'
394  CALL sgeqls( m, n, nrhs, af, lda, tau, x,
395  $ lda, work, lwork, info )
396 *
397 * Check error code from SGEQLS.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'SGEQLS', info, 0, ' ',
401  $ m, n, nrhs, -1, nb, imat,
402  $ nfail, nerrs, nout )
403 *
404  CALL sget02( 'No transpose', m, n, nrhs, a,
405  $ lda, x( m-n+1 ), lda, b, lda,
406  $ rwork, result( 7 ) )
407  nt = nt + 1
408  END IF
409  END IF
410 *
411 * Print information about the tests that did not
412 * pass the threshold.
413 *
414  DO 20 i = 1, nt
415  IF( result( i ).GE.thresh ) THEN
416  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417  $ CALL alahd( nout, path )
418  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419  $ imat, i, result( i )
420  nfail = nfail + 1
421  END IF
422  20 CONTINUE
423  nrun = nrun + nt
424  30 CONTINUE
425  40 CONTINUE
426  50 CONTINUE
427  60 CONTINUE
428  70 CONTINUE
429 *
430 * Print a summary of the results.
431 *
432  CALL alasum( path, nout, nfail, nrun, nerrs )
433 *
434  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
435  $ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
436  RETURN
437 *
438 * End of SCHKQL
439 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine sget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SGET02
Definition: sget02.f:135
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
subroutine sqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQLT01
Definition: sqlt01.f:128
subroutine serrql(PATH, NUNIT)
SERRQL
Definition: serrql.f:57
subroutine sqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQLT03
Definition: sqlt03.f:138
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine sgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGEQLS
Definition: sgeqls.f:124
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 xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine sqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQLT02
Definition: sqlt02.f:138

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine schkqr ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer, dimension( * )  NXVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AF,
real, dimension( * )  AQ,
real, dimension( * )  AR,
real, dimension( * )  AC,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKQR

Purpose:
 SCHKQR tests SGEQRF, SORGQR and SORMQR.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB and NX contained in the
          vectors NBVAL and NXVAL.  The blocking parameters are used
          in pairs (NB,NX).
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NXVAL
          NXVAL is INTEGER array, dimension (NNB)
          The values of the crossover point NX.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[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.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AF
          AF is REAL array, dimension (NMAX*NMAX)
[out]AQ
          AQ is REAL array, dimension (NMAX*NMAX)
[out]AR
          AR is REAL array, dimension (NMAX*NMAX)
[out]AC
          AC is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NRHS)
[out]X
          X is REAL array, dimension (NMAX*NRHS)
[out]XACT
          XACT is REAL array, dimension (NMAX*NRHS)
[out]TAU
          TAU is REAL array, dimension (NMAX)
[out]WORK
          WORK is REAL array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is REAL array, dimension (NMAX)
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 203 of file schkqr.f.

203 *
204 * -- LAPACK test routine (version 3.6.0) --
205 * -- LAPACK is a software package provided by Univ. of Tennessee, --
206 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
207 * November 2015
208 *
209 * .. Scalar Arguments ..
210  LOGICAL tsterr
211  INTEGER nm, nmax, nn, nnb, nout, nrhs
212  REAL thresh
213 * ..
214 * .. Array Arguments ..
215  LOGICAL dotype( * )
216  INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
217  $ nxval( * )
218  REAL a( * ), ac( * ), af( * ), aq( * ), ar( * ),
219  $ b( * ), rwork( * ), tau( * ), work( * ),
220  $ x( * ), xact( * )
221 * ..
222 *
223 * =====================================================================
224 *
225 * .. Parameters ..
226  INTEGER ntests
227  parameter( ntests = 9 )
228  INTEGER ntypes
229  parameter( ntypes = 8 )
230  REAL zero
231  parameter( zero = 0.0e0 )
232 * ..
233 * .. Local Scalars ..
234  CHARACTER dist, type
235  CHARACTER*3 path
236  INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
237  $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
238  $ nrun, nt, nx
239  REAL anorm, cndnum
240 * ..
241 * .. Local Arrays ..
242  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
243  REAL result( ntests )
244 * ..
245 * .. External Functions ..
246  LOGICAL sgennd
247  EXTERNAL sgennd
248 * ..
249 * .. External Subroutines ..
250  EXTERNAL alaerh, alahd, alasum, serrqr, sgeqrs, sget02,
253 * ..
254 * .. Intrinsic Functions ..
255  INTRINSIC max, min
256 * ..
257 * .. Scalars in Common ..
258  LOGICAL lerr, ok
259  CHARACTER*32 srnamt
260  INTEGER infot, nunit
261 * ..
262 * .. Common blocks ..
263  COMMON / infoc / infot, nunit, ok, lerr
264  COMMON / srnamc / srnamt
265 * ..
266 * .. Data statements ..
267  DATA iseedy / 1988, 1989, 1990, 1991 /
268 * ..
269 * .. Executable Statements ..
270 *
271 * Initialize constants and the random number seed.
272 *
273  path( 1: 1 ) = 'Single precision'
274  path( 2: 3 ) = 'QR'
275  nrun = 0
276  nfail = 0
277  nerrs = 0
278  DO 10 i = 1, 4
279  iseed( i ) = iseedy( i )
280  10 CONTINUE
281 *
282 * Test the error exits
283 *
284  IF( tsterr )
285  $ CALL serrqr( path, nout )
286  infot = 0
287  CALL xlaenv( 2, 2 )
288 *
289  lda = nmax
290  lwork = nmax*max( nmax, nrhs )
291 *
292 * Do for each value of M in MVAL.
293 *
294  DO 70 im = 1, nm
295  m = mval( im )
296 *
297 * Do for each value of N in NVAL.
298 *
299  DO 60 in = 1, nn
300  n = nval( in )
301  minmn = min( m, n )
302  DO 50 imat = 1, ntypes
303 *
304 * Do the tests only if DOTYPE( IMAT ) is true.
305 *
306  IF( .NOT.dotype( imat ) )
307  $ GO TO 50
308 *
309 * Set up parameters with SLATB4 and generate a test matrix
310 * with SLATMS.
311 *
312  CALL slatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
313  $ cndnum, dist )
314 *
315  srnamt = 'SLATMS'
316  CALL slatms( m, n, dist, iseed, TYPE, rwork, mode,
317  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
318  $ work, info )
319 *
320 * Check error code from SLATMS.
321 *
322  IF( info.NE.0 ) THEN
323  CALL alaerh( path, 'SLATMS', info, 0, ' ', m, n, -1,
324  $ -1, -1, imat, nfail, nerrs, nout )
325  GO TO 50
326  END IF
327 *
328 * Set some values for K: the first value must be MINMN,
329 * corresponding to the call of SQRT01; other values are
330 * used in the calls of SQRT02, and must not exceed MINMN.
331 *
332  kval( 1 ) = minmn
333  kval( 2 ) = 0
334  kval( 3 ) = 1
335  kval( 4 ) = minmn / 2
336  IF( minmn.EQ.0 ) THEN
337  nk = 1
338  ELSE IF( minmn.EQ.1 ) THEN
339  nk = 2
340  ELSE IF( minmn.LE.3 ) THEN
341  nk = 3
342  ELSE
343  nk = 4
344  END IF
345 *
346 * Do for each value of K in KVAL
347 *
348  DO 40 ik = 1, nk
349  k = kval( ik )
350 *
351 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
352 *
353  DO 30 inb = 1, nnb
354  nb = nbval( inb )
355  CALL xlaenv( 1, nb )
356  nx = nxval( inb )
357  CALL xlaenv( 3, nx )
358  DO i = 1, ntests
359  result( i ) = zero
360  END DO
361  nt = 2
362  IF( ik.EQ.1 ) THEN
363 *
364 * Test SGEQRF
365 *
366  CALL sqrt01( m, n, a, af, aq, ar, lda, tau,
367  $ work, lwork, rwork, result( 1 ) )
368 *
369 * Test SGEQRFP
370 *
371  CALL sqrt01p( m, n, a, af, aq, ar, lda, tau,
372  $ work, lwork, rwork, result( 8 ) )
373 
374  IF( .NOT. sgennd( m, n, af, lda ) )
375  $ result( 9 ) = 2*thresh
376  nt = nt + 1
377  ELSE IF( m.GE.n ) THEN
378 *
379 * Test SORGQR, using factorization
380 * returned by SQRT01
381 *
382  CALL sqrt02( m, n, k, a, af, aq, ar, lda, tau,
383  $ work, lwork, rwork, result( 1 ) )
384  END IF
385  IF( m.GE.k ) THEN
386 *
387 * Test SORMQR, using factorization returned
388 * by SQRT01
389 *
390  CALL sqrt03( m, n, k, af, ac, ar, aq, lda, tau,
391  $ work, lwork, rwork, result( 3 ) )
392  nt = nt + 4
393 *
394 * If M>=N and K=N, call SGEQRS to solve a system
395 * with NRHS right hand sides and compute the
396 * residual.
397 *
398  IF( k.EQ.n .AND. inb.EQ.1 ) THEN
399 *
400 * Generate a solution and set the right
401 * hand side.
402 *
403  srnamt = 'SLARHS'
404  CALL slarhs( path, 'New', 'Full',
405  $ 'No transpose', m, n, 0, 0,
406  $ nrhs, a, lda, xact, lda, b, lda,
407  $ iseed, info )
408 *
409  CALL slacpy( 'Full', m, nrhs, b, lda, x,
410  $ lda )
411  srnamt = 'SGEQRS'
412  CALL sgeqrs( m, n, nrhs, af, lda, tau, x,
413  $ lda, work, lwork, info )
414 *
415 * Check error code from SGEQRS.
416 *
417  IF( info.NE.0 )
418  $ CALL alaerh( path, 'SGEQRS', info, 0, ' ',
419  $ m, n, nrhs, -1, nb, imat,
420  $ nfail, nerrs, nout )
421